pax_global_header00006660000000000000000000000064145514343250014520gustar00rootroot0000000000000052 comment=3be9be8754e7b442545109dd22f53ea48d12226f coquelicot-coquelicot-3.4.1/000077500000000000000000000000001455143432500160415ustar00rootroot00000000000000coquelicot-coquelicot-3.4.1/COPYING000066400000000000000000000167431455143432500171070ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. This version of the GNU Lesser General Public License incorporates the terms and conditions of version 3 of the GNU General Public License, supplemented by the additional permissions listed below. 0. Additional Definitions. As used herein, "this License" refers to version 3 of the GNU Lesser General Public License, and the "GNU GPL" refers to version 3 of the GNU General Public License. "The Library" refers to a covered work governed by this License, other than an Application or a Combined Work as defined below. An "Application" is any work that makes use of an interface provided by the Library, but which is not otherwise based on the Library. Defining a subclass of a class defined by the Library is deemed a mode of using an interface provided by the Library. A "Combined Work" is a work produced by combining or linking an Application with the Library. The particular version of the Library with which the Combined Work was made is also called the "Linked Version". The "Minimal Corresponding Source" for a Combined Work means the Corresponding Source for the Combined Work, excluding any source code for portions of the Combined Work that, considered in isolation, are based on the Application, and not on the Linked Version. The "Corresponding Application Code" for a Combined Work means the object code and/or source code for the Application, including any data and utility programs needed for reproducing the Combined Work from the Application, but excluding the System Libraries of the Combined Work. 1. Exception to Section 3 of the GNU GPL. You may convey a covered work under sections 3 and 4 of this License without being bound by section 3 of the GNU GPL. 2. Conveying Modified Versions. If you modify a copy of the Library, and, in your modifications, a facility refers to a function or data to be supplied by an Application that uses the facility (other than as an argument passed when the facility is invoked), then you may convey a copy of the modified version: a) under this License, provided that you make a good faith effort to ensure that, in the event an Application does not supply the function or data, the facility still operates, and performs whatever part of its purpose remains meaningful, or b) under the GNU GPL, with none of the additional permissions of this License applicable to that copy. 3. Object Code Incorporating Material from Library Header Files. The object code form of an Application may incorporate material from a header file that is part of the Library. You may convey such object code under terms of your choice, provided that, if the incorporated material is not limited to numerical parameters, data structure layouts and accessors, or small macros, inline functions and templates (ten or fewer lines in length), you do both of the following: a) Give prominent notice with each copy of the object code that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the object code with a copy of the GNU GPL and this license document. 4. Combined Works. You may convey a Combined Work under terms of your choice that, taken together, effectively do not restrict modification of the portions of the Library contained in the Combined Work and reverse engineering for debugging such modifications, if you also do each of the following: a) Give prominent notice with each copy of the Combined Work that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the Combined Work with a copy of the GNU GPL and this license document. c) For a Combined Work that displays copyright notices during execution, include the copyright notice for the Library among these notices, as well as a reference directing the user to the copies of the GNU GPL and this license document. d) Do one of the following: 0) Convey the Minimal Corresponding Source under the terms of this License, and the Corresponding Application Code in a form suitable for, and under terms that permit, the user to recombine or relink the Application with a modified version of the Linked Version to produce a modified Combined Work, in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source. 1) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (a) uses at run time a copy of the Library already present on the user's computer system, and (b) will operate properly with a modified version of the Library that is interface-compatible with the Linked Version. e) Provide Installation Information, but only if you would otherwise be required to provide such information under section 6 of the GNU GPL, and only to the extent that such information is necessary to install and execute a modified version of the Combined Work produced by recombining or relinking the Application with a modified version of the Linked Version. (If you use option 4d0, the Installation Information must accompany the Minimal Corresponding Source and Corresponding Application Code. If you use option 4d1, you must provide the Installation Information in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source.) 5. Combined Libraries. You may place library facilities that are a work based on the Library side by side in a single library together with other library facilities that are not Applications and are not covered by this License, and convey such a combined library under terms of your choice, if you do both of the following: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities, conveyed under the terms of this License. b) Give prominent notice with the combined library that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 6. Revised Versions of the GNU Lesser General Public License. The Free Software Foundation may publish revised and/or new versions of the GNU Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library as you received it specifies that a certain numbered version of the GNU Lesser General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that published version or of any later version published by the Free Software Foundation. If the Library as you received it does not specify a version number of the GNU Lesser General Public License, you may choose any version of the GNU Lesser General Public License ever published by the Free Software Foundation. If the Library as you received it specifies that a proxy can decide whether future versions of the GNU Lesser General Public License shall apply, that proxy's public statement of acceptance of any version is permanent authorization for you to choose that version for the Library. coquelicot-coquelicot-3.4.1/INSTALL.md000066400000000000000000000023021455143432500174660ustar00rootroot00000000000000Installation instructions ========================= Prerequisites ------------- You will need the Coq proof assistant (>= 8.12). You will need the [MathComp](http://math-comp.github.io/math-comp/) library to be installed too. The `.tar.gz` file is distributed with a working set of configure files. They are not in the git repository though. Consequently, if you are building from git, you will need `autoconf` (>= 2.59). Configuring, compiling and installing ------------------------------------- Ideally, you should just have to type: ./configure && ./remake && ./remake install The environment variable `COQC` can be passed to the configure script in order to set the Coq compiler command. The configure script defaults to `coqc`. Similarly, `COQDEP` can be used to specify the location of `coqdep`. The `COQBIN` environment variable can be used to set both variables at once. The library files are compiled at the logical location `Coquelicot`. The `COQUSERCONTRIB` environment variable can be used to override the physical location where the `Coquelicot` directory containing these files will be installed by `./remake install`. By default, the target directory is `` `$COQC -where`/user-contrib ``. coquelicot-coquelicot-3.4.1/NEWS.md000066400000000000000000000047661455143432500171540ustar00rootroot00000000000000Version 3.4.1 ------------- * ensured compatibility from Coq 8.12 to 8.19 Version 3.4.0 ------------- * added an `AbelianMonoid` structure at the bottom of the hierarchy Version 3.3.1 ------------- * fixed compilation with ssreflect 1.17 and 2.0 Version 3.3.0 ------------- * improved support for complex arithmetic * minimal version of Coq is now 8.12 Version 3.2.0 ------------- * added `closely` to filter over pairs of close values in place of `cauchy` Version 3.1.0 ------------- * ensured compatibility from Coq 8.8 to Coq 8.13 * added some theorems about continuity and differentiability of elementary functions Version 3.0.3 ------------- * ensured compatibility from Coq 8.8 to Coq 8.10 Version 3.0.2 ------------- * ensured compatibility from Coq 8.5 to Coq 8.9 Version 3.0.1 ------------- * ensured compatibility from Coq 8.5 to Coq 8.7 Version 3.0.0 ------------- * generalized `RInt` to `CompleteNormedModule` * added `filterlimi` to express limits of implicitly-defined functions * made `is_RInt_gen` similar to other limits and defined `RInt_gen` Version 2.1.2 ------------- * fixed compilation with Coq 8.6; minimal version is now 8.5 Version 2.1.1 ------------- * fixed compilation with ssreflect 1.6 Version 2.1.0 ------------- * added `continuous` for expressing continuity * modified definitions for `sum_n` and `sum_n_m` * strengthened axioms for `AbsRing` and `NormedModule` * added `closed` for characterizing closed sets * added `iota` for Hilbert's operator on `CompleteSpace` * added notation `[ _ , _ , ...]` for vectors of type `Tn` * renamed `Markov*` lemmas to `LPO*` * proved Abel's theorem on power series * generalized continuity and differentiability of `RInt` in `RInt_analysis` * added support for improper integrals in `RInt_gen` * renamed `Limit` into `Lim_seq` * added example `BacS2013_bonus` about matrices Version 2.0.1 ------------- * fixed compilation with ssreflect 1.5 Version 2.0.0 ------------- * removed `is_derive` as a notation for `derivable_pt_lim` * renamed some compatibility theorems from `_equiv` to `_Reals` * introduced a hierarchy of number structures and topological spaces * added complex numbers * generalized `is_RInt`, `is_derive`, `is_domin`, etc, from reals to arbitrary left-modules Version 1.1.0 ------------- * expressed `locally`, `Rbar_locally`, etc, as filters * defined limits using `filterlim` and modified predicates such as `is_lim` accordingly * simplified definitions of `Rbar` operators Version 1.0.0 ------------- * initial release coquelicot-coquelicot-3.4.1/README.md000066400000000000000000000014151455143432500173210ustar00rootroot00000000000000COQUELICOT ========== This library provides vernacular files containing a formalization of real analysis for the [Coq proof assistant](https://coq.inria.fr/). It is a conservative extension of the standard library `Reals` with a focus on usability. PROJECT HOME ------------ Homepage: http://coquelicot.saclay.inria.fr/ Repository: https://gitlab.inria.fr/coquelicot/coquelicot Bug tracker: https://gitlab.inria.fr/coquelicot/coquelicot/issues COPYRIGHT --------- This package is free software; you can redistribute it and/or modify it under the terms of GNU Lesser General Public License (see the [COPYING](COPYING) file). Authors are Sylvie Boldo , Catherine Lelay , and Guillaume Melquiond . coquelicot-coquelicot-3.4.1/Remakefile.in000066400000000000000000000052711455143432500204420ustar00rootroot00000000000000FILES = \ AutoDerive.v \ Compactness.v \ Complex.v \ Continuity.v \ Coquelicot.v \ Derive.v \ Derive_2d.v \ Equiv.v \ ElemFct.v \ Hierarchy.v \ Iter.v \ KHInt.v \ Lim_seq.v \ Lub.v \ Markov.v \ PSeries.v \ Rbar.v \ Rcomplements.v \ RInt.v \ RInt_analysis.v \ RInt_gen.v \ Seq_fct.v \ Series.v \ SF_seq.v OBJS = $(addprefix theories/,$(addsuffix o,$(FILES))) .PHONY: all check dist doc install .PHONY: clean theories/clean examples/clean all: $(OBJS) clean: theories/clean examples/clean Remakefile: Remakefile.in config.status ./config.status Remakefile configure config.status: configure.in autoconf ./config.status --recheck %.vo: %.v @COQDEP@ -R theories Coquelicot $< | @REMAKE@ -r $@ @COQC@ @TIMING@ @COQEXTRAFLAGS@ -q -R theories Coquelicot $< @TIMING_EXTRA@ theories/clean: rm -f $(OBJS) theories/*.glob html/full-index.html: $(OBJS) rm -rf html mkdir -p html @COQDOC@ -toc -interpolate -utf8 -html -g -R theories Coquelicot -d html \ --coqlib_url https://coq.inria.fr/distrib/current/stdlib \ --external https://math-comp.github.io/htmldoc mathcomp \ $(addprefix theories/,$(FILES)) mv html/index.html html/full-index.html for f in html/*.html; do sed -e 's;Index;Go back to the Main page or Index.;' -i $f done doc: html/full-index.html deps.dot dot -Tcmapx -odeps.map -Tpng -ohtml/deps.png deps.dot sed -e '/img src="deps.png"/ r deps.map' -i html/Coquelicot.Coquelicot.html cp html/Coquelicot.Coquelicot.html html/index.html rm -f deps.map public: doc rm -rf public cp -r html public deps.dot: $(addprefix theories/,$(FILES)) (echo "digraph coquelicot_deps {" ; echo "node [shape = ellipse, style=filled, URL=\"Coquelicot.\N.html\", color=black, fillcolor=lightskyblue];"; (cd theories ; @COQDEP@ -R . Coquelicot $(FILES)) | sed -n -e 's/[.]vo.*: [^ ]*[.]v//p' | while read src dst; do for d in $dst; do echo $src "->" ${d%.vo} ";" done done ; echo "}") | tred > $@ EXAMPLES = \ BacS2013.v \ BacS2013_bonus.v \ Bessel.v \ DAlembert.v EXOBJS = $(addprefix examples/,$(addsuffix o,$(EXAMPLES))) check: $(EXOBJS) examples/clean: rm -f $(EXOBJS) examples/*.glob install: dir="${DESTDIR}@COQUSERCONTRIB@/Coquelicot" mkdir -p $dir cp $(OBJS) $dir ( cd theories && find . -type d -name ".coq-native" -exec cp -RT "{}" "$dir/{}" \; ) EXTRA_DIST = \ configure dist: $(EXTRA_DIST) PACK=@PACKAGE_TARNAME@-@PACKAGE_VERSION@ rm -f $PACK.tar.gz git archive --format=tar --prefix=$PACK/ -o $PACK.tar HEAD tar rf $PACK.tar --transform="s,^,$PACK/," --mtime="`git show -s --format=%ci`" --owner=0 --group=0 $(EXTRA_DIST) gzip -n -f --best $PACK.tar coquelicot-coquelicot-3.4.1/_CoqProject000066400000000000000000000000271455143432500201730ustar00rootroot00000000000000-R theories Coquelicot coquelicot-coquelicot-3.4.1/configure.in000066400000000000000000000040011455143432500203450ustar00rootroot00000000000000AC_INIT([Coquelicot], [3.4.1], [Guillaume Melquiond ], [coquelicot]) m4_divert_push(99) if test "$ac_init_help" = "long"; then ac_init_help=short fi m4_divert_pop(99) AC_ARG_VAR(COQBIN, [path to Coq executables [empty]]) if test ${COQBIN##*/}; then COQBIN=$COQBIN/; fi AC_ARG_VAR(COQC, [Coq compiler command [coqc]]) AC_MSG_CHECKING([for coqc]) if test ! "$COQC"; then COQC=`which ${COQBIN}coqc`; fi AC_MSG_RESULT([$COQC]) AC_ARG_VAR(COQDEP, [Coq dependency analyzer command [coqdep]]) AC_MSG_CHECKING([for coqdep]) if test ! "$COQDEP"; then COQDEP=`which ${COQBIN}coqdep`; fi AC_MSG_RESULT([$COQDEP]) AC_ARG_VAR(COQDOC, [Coq documentation generator command [coqdoc]]) AC_MSG_CHECKING([for coqdoc]) if test ! "$COQDOC"; then COQDOC=`which ${COQBIN}coqdoc`; fi AC_MSG_RESULT([$COQDOC]) AC_ARG_VAR(COQEXTRAFLAGS, [extra flags passed to Coq compiler [empty]]) AC_ARG_VAR(TIMING) if test -n "$TIMING"; then TIMING_EXTRA="> $<.timing" TIMING="-time" fi AC_SUBST(TIMING_EXTRA) AC_MSG_CHECKING([for SSReflect]) AS_IF( [ echo "Require Import mathcomp.ssreflect.ssreflect." > conftest.v $COQC conftest.v > conftest.err ], [ AC_MSG_RESULT([yes]) ], [ AC_MSG_RESULT([no]) AC_MSG_ERROR([ *** Unable to find library mathcomp.ssreflect (http://math-comp.github.io/math-comp/)])]) rm -f conftest.v conftest.vo conftest.err AC_ARG_VAR(COQUSERCONTRIB, [installation directory [`$COQC -where`/user-contrib]]) if test -z "$COQUSERCONTRIB"; then COQUSERCONTRIB="`$COQC -where | tr -d '\r' | tr '\\\\' '/'`/user-contrib" fi AC_ARG_VAR(REMAKE, [Remake [vendored version]]) if test -z "$REMAKE"; then AC_PROG_CXX AC_MSG_NOTICE([building remake...]) case `$CXX -v 2>&1 | grep -e "^Target:"` in *mingw*) $CXX -Wall -O2 -o remake.exe remake.cpp -lws2_32 if test $? != 0; then AC_MSG_FAILURE([failed]); fi REMAKE=./remake.exe ;; *) $CXX -Wall -O2 -o remake remake.cpp if test $? != 0; then AC_MSG_FAILURE([failed]); fi REMAKE=./remake ;; esac fi AC_CONFIG_FILES(Remakefile) AC_OUTPUT coquelicot-coquelicot-3.4.1/examples/000077500000000000000000000000001455143432500176575ustar00rootroot00000000000000coquelicot-coquelicot-3.4.1/examples/BacS2013.v000066400000000000000000000300011455143432500211560ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. From Coquelicot Require Import Rcomplements Rbar Hierarchy Derive RInt Continuity Lim_seq ElemFct RInt_analysis. (** This file describes an experiment: most 18-year old French students pass an exam called Baccalaureate which ends the high school and is required for attending the university. We took the 2013 mathematics test of the scientific Baccalaureate at the same time as the students. The pdf of the test is available #here#. *) Ltac pos_rat := repeat ( apply Rdiv_lt_0_compat || apply Rplus_lt_0_compat || apply Rmult_lt_0_compat) ; try by apply Rlt_0_1. Lemma sign_0_lt : forall x, 0 < x <-> 0 < sign x. Proof. intros x. unfold sign. destruct total_order_T as [[H|H]|H] ; lra. Qed. Lemma sign_lt_0 : forall x, x < 0 <-> sign x < 0. Proof. intros x. unfold sign. destruct total_order_T as [[H|H]|H] ; lra. Qed. (** * Exercice 2 *) (* 8:14 *) Definition fab (a b x : R) : R := (a + b * ln x) / x. (** ** Questions 1 *) (** 1.a. On voit sur le graphique que l'image de 1 par f correspond au point B(1,2). On a donc f(1) = 2. Comme la tangente (BC) à la courbe en ce point admet pour coefficient directeur 0, f'(1) = 0 *) (** 1.b *) Lemma Dfab (a b : R) : forall x, 0 < x -> is_derive (fab a b) x (((b - a) - b * ln x) / x ^ 2). Proof. move => x Hx. evar_last. apply is_derive_div. apply @is_derive_plus. apply is_derive_const. apply is_derive_scal. now apply is_derive_Reals, derivable_pt_lim_ln. apply is_derive_id. by apply Rgt_not_eq. rewrite /Rdiv /plus /zero /one /=. field. by apply Rgt_not_eq. Qed. (** 1.c *) Lemma Val_a_b (a b : R) : fab a b 1 = 2 -> Derive (fab a b) 1 = 0 -> a = 2 /\ b = 2. Proof. move => Hf Hdf. rewrite /fab in Hf. rewrite ln_1 in Hf. rewrite Rdiv_1 in Hf. rewrite Rmult_0_r in Hf. rewrite Rplus_0_r in Hf. rewrite Hf in Hdf |- * => {a Hf}. split. reflexivity. replace (Derive (fab 2 b) 1) with (((b - 2) - b * ln 1) / 1 ^ 2) in Hdf. rewrite ln_1 /= in Hdf. field_simplify in Hdf. rewrite ?Rdiv_1 in Hdf. by apply Rminus_diag_uniq. apply sym_eq, is_derive_unique. apply Dfab. by apply Rlt_0_1. Qed. Definition f (x : R) : R := fab 2 2 x. (** ** Questions 2 *) (* 8:38 *) (** 2.a. *) Lemma Signe_df : forall x, 0 < x -> sign (Derive f x) = sign (- ln x). Proof. move => x Hx. rewrite (is_derive_unique f x _ (Dfab 2 2 x Hx)). replace ((2 - 2 - 2 * ln x) / x ^ 2) with (2 / x ^ 2 * (- ln x)) by (field ; now apply Rgt_not_eq). rewrite sign_mult sign_eq_1. apply Rmult_1_l. apply Rdiv_lt_0_compat. apply Rlt_0_2. apply pow2_gt_0. by apply Rgt_not_eq. Qed. (** 2.b. *) Lemma filterlim_f_0 : filterlim f (at_right 0) (Rbar_locally m_infty). Proof. unfold f, fab. eapply (filterlim_comp_2 _ _ Rmult). eapply filterlim_comp_2. apply filterlim_const. eapply filterlim_comp_2. apply filterlim_const. by apply is_lim_ln_0. apply (filterlim_Rbar_mult 2 m_infty m_infty). unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec (Rlt_le _ _ Rlt_0_2) => // H _ ; case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Rlt_0_2) => //. apply (filterlim_Rbar_plus 2 _ m_infty). by []. by apply filterlim_Rinv_0_right. by apply (filterlim_Rbar_mult m_infty p_infty). Qed. Lemma Lim_f_p_infty : is_lim f p_infty 0. Proof. apply is_lim_ext_loc with (fun x => 2 / x + 2 * (ln x / x)). exists 0. move => y Hy. rewrite /f /fab. field. by apply Rgt_not_eq. eapply is_lim_plus. apply is_lim_scal_l. apply is_lim_inv. by apply is_lim_id. by []. apply is_lim_scal_l. by apply is_lim_div_ln_p. unfold is_Rbar_plus, Rbar_plus' ; apply f_equal, f_equal ; ring. Qed. (** 2.c. *) Lemma Variation_1 : forall x y, 0 < x -> x < y -> y < 1 -> f x < f y. Proof. apply (incr_function _ 0 1 (fun x => (2 - 2 - 2 * ln x) / x ^ 2)). move => x H0x Hx1. by apply (Dfab 2 2 x). move => x H0x Hx1. apply sign_0_lt. rewrite -(is_derive_unique _ _ _ (Dfab 2 2 x H0x)). rewrite Signe_df. apply -> sign_0_lt. apply Ropp_lt_cancel ; rewrite Ropp_0 Ropp_involutive. rewrite -ln_1. by apply ln_increasing. by apply H0x. Qed. Lemma Variation_2 : forall x y, 1 < x -> x < y -> f x > f y. Proof. move => x y H1x Hxy. apply Ropp_lt_cancel. apply (incr_function (fun x => - f x) 1 p_infty (fun z => - ((2 - 2 - 2 * ln z) / z ^ 2))). move => z H1z _. apply: is_derive_opp. apply (Dfab 2 2 z). by apply Rlt_trans with (1 := Rlt_0_1). move => z H1z _. apply Ropp_lt_cancel ; rewrite Ropp_0 Ropp_involutive. apply sign_lt_0. rewrite -(is_derive_unique _ _ _ (Dfab 2 2 z (Rlt_trans _ _ _ Rlt_0_1 H1z))). rewrite Signe_df. apply -> sign_lt_0. apply Ropp_lt_cancel ; rewrite Ropp_0 Ropp_involutive. rewrite -ln_1. apply ln_increasing. by apply Rlt_0_1. by apply H1z. by apply Rlt_trans with (1 := Rlt_0_1). by []. by []. by []. Qed. (** ** Questions 3 *) (* 9:40 *) (** 3.a *) Lemma f_eq_1_0_1 : exists x, 0 < x <= 1 /\ f x = 1. Proof. case: (IVT_Rbar_incr (fun x => f (Rabs x)) 0 1 m_infty 2 1). eapply filterlim_comp. apply filterlim_Rabs_0. by apply filterlim_f_0. apply is_lim_comp with 1. replace 2 with (f 1). apply is_lim_continuity. apply derivable_continuous_pt. exists (((2 - 2) - 2 * ln 1) / 1 ^ 2) ; apply is_derive_Reals, Dfab. by apply Rlt_0_1. rewrite /f /fab ln_1 /= ; field. rewrite -{2}(Rabs_pos_eq 1). apply (is_lim_continuity Rabs 1). by apply continuity_pt_filterlim, continuous_Rabs. by apply Rle_0_1. exists (mkposreal _ Rlt_0_1) => /= x H0x Hx. rewrite /ball /= /AbsRing_ball /= in H0x. apply Rabs_lt_between' in H0x. rewrite Rminus_eq_0 in H0x. contradict Hx. rewrite -(Rabs_pos_eq x). by apply Rbar_finite_eq. by apply Rlt_le, H0x. move => x H0x Hx1. apply (continuity_pt_comp Rabs). by apply continuity_pt_filterlim, continuous_Rabs. rewrite Rabs_pos_eq. apply derivable_continuous_pt. exists (((2 - 2) - 2 * ln x) / x ^ 2) ; apply is_derive_Reals, Dfab. by []. by apply Rlt_le. by apply Rlt_0_1. split => //. apply Rminus_lt_0 ; ring_simplify ; by apply Rlt_0_1. move => x [H0x [Hx1 Hfx]]. rewrite Rabs_pos_eq in Hfx. exists x ; repeat split. by apply H0x. by apply Rlt_le. by apply Hfx. by apply Rlt_le. Qed. (** 3.b. *) Lemma f_eq_1_1_p_infty : exists x, 1 <= x /\ f x = 1. Proof. case: (IVT_Rbar_incr (fun x => - f x) 1 p_infty (-2) 0 (-1)). replace (-2) with (-f 1). apply (is_lim_continuity (fun x => - f x)). apply continuity_pt_opp. apply derivable_continuous_pt. exists (((2 - 2) - 2 * ln 1) / 1 ^ 2) ; apply is_derive_Reals, Dfab. by apply Rlt_0_1. rewrite /f /fab ln_1 /= ; field. evar_last. apply is_lim_opp. by apply Lim_f_p_infty. simpl ; by rewrite Ropp_0. move => x H0x Hx1. apply continuity_pt_opp. apply derivable_continuous_pt. exists (((2 - 2) - 2 * ln x) / x ^ 2) ; apply is_derive_Reals, Dfab. by apply Rlt_trans with (1 := Rlt_0_1). by []. split ; apply Rminus_lt_0 ; ring_simplify ; by apply Rlt_0_1. move => x [H0x [Hx1 Hfx]]. exists x ; split. by apply Rlt_le. rewrite -(Ropp_involutive (f x)) Hfx ; ring. Qed. (** ** Questions 5 *) (* 10:08 *) (** 5.a. *) (** 5.b. *) Lemma If : forall x, 0 < x -> is_derive (fun y : R => 2 * ln y + (ln y) ^ 2) x (f x). Proof. move => y Hy. evar_last. apply @is_derive_plus. apply is_derive_Reals. apply derivable_pt_lim_scal. by apply derivable_pt_lim_ln. apply is_derive_pow. by apply is_derive_Reals, derivable_pt_lim_ln. rewrite /f /fab /plus /= ; field. by apply Rgt_not_eq. Qed. Lemma RInt_f : is_RInt f ( / exp 1) 1 1. Proof. have Haux1: (0 < /exp 1). apply Rinv_0_lt_compat. apply exp_pos. evar_last. apply: is_RInt_derive. move => x Hx. apply If. apply Rlt_le_trans with (2 := proj1 Hx). apply Rmin_case. by apply Haux1. by apply Rlt_0_1. move => x Hx. apply continuity_pt_filterlim. apply derivable_continuous_pt. exists (((2 - 2) - 2 * ln x) / x ^ 2) ; apply is_derive_Reals, Dfab. apply Rlt_le_trans with (2 := proj1 Hx). apply Rmin_case. by apply Haux1. by apply Rlt_0_1. rewrite /minus /= /plus /opp /= -[eq]/(@eq R). rewrite ln_Rinv. rewrite ln_exp. rewrite ln_1. ring. by apply exp_pos. Qed. (** * Exercice 4 *) (* 10:36 *) Fixpoint u (n : nat) : R := match n with | O => 2 | S n => 2/3 * u n + 1/3 * (INR n) + 1 end. (** ** Questions 1 *) (** 1.a. *) (** 1.b. *) (** ** Questions 2 *) (* 10:40 *) (** 2.a *) Lemma Q2a : forall n, u n <= INR n + 3. Proof. elim => [ | n IH] ; rewrite ?S_INR /=. apply Rminus_le_0 ; ring_simplify ; apply Rle_0_1. eapply Rle_trans. apply Rplus_le_compat_r. apply Rplus_le_compat_r. apply Rmult_le_compat_l. lra. by apply IH. lra. Qed. (** 2.b. *) Lemma Q2b : forall n, u (S n) - u n = 1/3 * (INR n + 3 - u n). Proof. move => n ; simpl. field. Qed. (** 2.c. *) Lemma Q2c : forall n, u n <= u (S n). Proof. move => n. apply Rminus_le_0. rewrite Q2b. apply Rmult_le_pos. lra. apply (Rminus_le_0 (u n)). by apply Q2a. Qed. (** ** Question 3 *) (* 10:49 *) Definition v (n : nat) : R := u n - INR n. (** 3.a. *) Lemma Q3a : forall n, v n = 2 * (2/3) ^ n. Proof. elim => [ | n IH]. rewrite /v /u /= ; ring. replace (2 * (2 / 3) ^ S n) with (v n * (2/3)) by (rewrite IH /= ; ring). rewrite /v S_INR /=. field. Qed. (** 3.b. *) Lemma Q3b : forall n, u n = 2 * (2/3)^n + INR n. Proof. move => n. rewrite -Q3a /v ; ring. Qed. Lemma Q3c : is_lim_seq u p_infty. Proof. apply is_lim_seq_ext with (fun n => 2 * (2/3)^n + INR n). move => n ; by rewrite Q3b. eapply is_lim_seq_plus. eapply is_lim_seq_mult. by apply is_lim_seq_const. apply is_lim_seq_geom. rewrite Rabs_pos_eq. lra. lra. by []. apply is_lim_seq_INR. by []. Qed. (** ** Questions 4 *) (* 11:00 *) Definition Su (n : nat) : R := sum_f_R0 u n. Definition Tu (n : nat) : R := Su n / (INR n) ^ 2. (** 4.a. *) Lemma Q4a : forall n, Su n = 6 - 4 * (2/3)^n + INR n * (INR n + 1) / 2. Proof. move => n. rewrite /Su. rewrite -(sum_eq (fun n => (2/3)^n * 2 + INR n)). rewrite sum_plus. rewrite -scal_sum. rewrite tech3. rewrite sum_INR. simpl ; field. apply Rlt_not_eq, Rlt_div_l. repeat apply Rplus_lt_0_compat ; apply Rlt_0_1. apply Rminus_lt_0 ; ring_simplify ; by apply Rlt_0_1. move => i _. rewrite Q3b ; ring. Qed. (** 4.b. *) Lemma Q4b : is_lim_seq Tu (1/2). Proof. apply is_lim_seq_ext_loc with (fun n => (6 - 4 * (2/3)^n) / (INR n ^2) + / (2 * INR n) + /2). exists 1%nat => n Hn ; rewrite /Tu Q4a. simpl ; field. apply Rgt_not_eq, (lt_INR O) ; intuition. eapply is_lim_seq_plus. eapply is_lim_seq_plus. eapply is_lim_seq_div. eapply is_lim_seq_minus. apply is_lim_seq_const. eapply is_lim_seq_mult. by apply is_lim_seq_const. apply is_lim_seq_geom. rewrite Rabs_pos_eq. lra. lra. by []. rewrite /is_Rbar_minus /is_Rbar_plus /=. now ring_simplify (6 + - (4 * 0)). repeat eapply is_lim_seq_mult. apply is_lim_seq_INR. apply is_lim_seq_INR. apply is_lim_seq_const. apply is_Rbar_mult_p_infty_pos. by apply Rlt_0_1. by []. by []. by apply is_Rbar_div_p_infty. apply is_lim_seq_inv. eapply is_lim_seq_mult. by apply is_lim_seq_const. by apply is_lim_seq_INR. by apply is_Rbar_mult_sym, is_Rbar_mult_p_infty_pos, Rlt_0_2. by []. by []. apply is_lim_seq_const. apply (f_equal (@Some _)), f_equal. field. Qed. (* 11:33 *) coquelicot-coquelicot-3.4.1/examples/BacS2013_bonus.v000066400000000000000000000150161455143432500223750ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. From Coquelicot Require Import Hierarchy PSeries Rbar Lim_seq. (** This file describes an experiment: most 18-year old French students pass an exam called Baccalaureate which ends the high school and is required for attending the university. We took the 2013 mathematics test of the scientific Baccalaureate at the same time as the students. The pdf of the test is available #here#. This file is dedicated to the mathematics specialty exercise, done after the exam. *) Open Scope R_scope. (** * Bac 2013 - Exercice 4 spécialité *) (** 1. Exprimer v (S n) et c (S n) en fonction de v n et c n *) Fixpoint v (n : nat) : R := match n with | O => 7 / 10 * 250000 | S n => 95 / 100 * v n + 1 / 100 * c n end with c (n : nat) : R := match n with | O => 3 / 10 * 250000 | S n => 5 / 100 * v n + 99 / 100 * c n end. (** 2. Définition de la matrice A *) Definition A : matrix 2 2 := [[95/100, 1/100 ] , [ 5/100, 99/100]]. Definition X (n : nat) : matrix 2 1 := [[v n],[c n]]. Lemma Q2 : forall n, X (S n) = scal A (X n). Proof. intros n. rewrite /scal /= /Mmult. apply (coeff_mat_ext 0). case ; [ | case => //]. case ; [ | case => //] ; rewrite coeff_mat_bij /= ; (try lia) ; rewrite sum_Sn sum_O /plus /mult //=. case ; [ | case => //] ; rewrite coeff_mat_bij /= ; (try lia) ; rewrite sum_Sn sum_O /plus /mult //=. Qed. (** 3. Diagonalisation *) Definition P : matrix 2 2 := [[1,-1], [5,1]]. Definition Q : matrix 2 2 := [[1,1],[-5,1]]. Goal mult P Q = [[6,0],[0,6]]. apply (coeff_mat_ext_aux 0 0) => i j Hi Hj. rewrite coeff_mat_bij => //. rewrite /coeff_mat /= /mult /plus /=. (destruct i as [ | i] ; destruct j as [ | j] ; rewrite /zero /= ; try ring) ; (try (destruct i as [ | i]) ; try (destruct j as [ | j]) ; rewrite /zero /= ; try ring) ; rewrite sum_Sn sum_O /= /plus /= ; ring. Qed. Goal mult Q P = [[6,0],[0,6]]. apply (coeff_mat_ext_aux 0 0) => i j Hi Hj. rewrite coeff_mat_bij => //. rewrite /coeff_mat /= /mult /plus /=. (destruct i as [ | i] ; destruct j as [ | j] ; rewrite /zero /= ; try ring) ; (try (destruct i as [ | i]) ; try (destruct j as [ | j]) ; rewrite /zero /= ; try ring) ; rewrite sum_Sn sum_O /= /plus /= ; ring. Qed. Definition P' : matrix 2 2 := [[1 / 6,1 / 6],[-5 / 6,1 / 6]]. Lemma Q3a : mult P P' = Mone /\ mult P' P = Mone. Proof. split. apply (coeff_mat_ext_aux 0 0) => i j Hi Hj. rewrite coeff_mat_bij => //. rewrite /coeff_mat /= /mult /plus /=. (destruct i as [ | i] ; destruct j as [ | j] ; rewrite /zero /= ; try field) ; (try (destruct i as [ | i]) ; try (destruct j as [ | j]) ; rewrite /zero /one /= ; try field) ; rewrite sum_Sn sum_O /= /plus /= ; field. apply (coeff_mat_ext_aux 0 0) => i j Hi Hj. rewrite coeff_mat_bij => //. rewrite /coeff_mat /= /mult /plus /=. (destruct i as [ | i] ; destruct j as [ | j] ; rewrite /zero /= ; try field) ; (try (destruct i as [ | i]) ; try (destruct j as [ | j]) ; rewrite /zero /one /= ; try field) ; rewrite sum_Sn sum_O /= /plus /= ; field. Qed. Definition D : matrix 2 2 := [[1,0],[0,94 / 100]]. Lemma Q3b : mult P' (mult A P) = D. Proof. apply (coeff_mat_ext_aux 0 0) => i j Hi Hj. rewrite coeff_mat_bij => //. rewrite /coeff_mat /= /mult /plus /=. (destruct i as [ | i] ; destruct j as [ | j] ; rewrite /zero /= ; try field) ; (try (destruct i as [ | i]) ; try (destruct j as [ | j]) ; rewrite /zero /one /= ; try field) ; rewrite sum_Sn sum_O /= /plus /= ; (try field) ; rewrite !sum_Sn !sum_O /= /plus /coeff_mat /= ; field. Qed. Lemma Q3c : forall n, pow_n A n = mult P (mult (pow_n D n) P'). Proof. elim => /= [ | n IH]. rewrite mult_one_l. apply sym_eq, Q3a. by rewrite -{1}Q3b !mult_assoc (proj1 Q3a) mult_one_l -!mult_assoc IH. Qed. (** 4. Terme général et limite de la suite v n *) Lemma Q4 : forall n, v n = 1 / 6 * (1 + 5 * (94 / 100) ^ n) * v 0 + 1 / 6 * (1 - (94 / 100) ^ n) * c 0. Proof. intros n. assert (X n = scal (pow_n A n) (X 0)). elim: n => [ | n IH] /=. by rewrite scal_one. rewrite -scal_assoc -IH. by apply Q2. assert (pow_n D n = [[1,0], [0,(94 / 100)^n]]). elim: (n) => [ | m IH] //=. rewrite IH. apply (coeff_mat_ext_aux 0 0) => i j Hi Hj. rewrite coeff_mat_bij => //=. rewrite /plus /mult /= /coeff_mat /=. (destruct i as [ | i] ; destruct j as [ | j] ; rewrite /zero /one /=) ; (try (destruct i as [ | i]) ; try (destruct j as [ | j]) ; rewrite /zero /one /= ; try field) ; rewrite sum_Sn sum_O /= /plus /= ; field. rewrite Q3c H0 in H. apply (proj1 (coeff_mat_ext 0 _ _)) with (i := O) (j := O) in H. rewrite {1}/coeff_mat /= in H. rewrite H ; repeat (rewrite !/coeff_mat /=). rewrite !sum_Sn !sum_O /= /plus /mult /= ; field. Qed. Lemma lim_v : is_lim_seq v (41666 + 2 / 3). Proof. eapply is_lim_seq_ext. intros n ; apply sym_eq, Q4. eapply is_lim_seq_plus. eapply is_lim_seq_mult. eapply is_lim_seq_mult. apply is_lim_seq_const. eapply is_lim_seq_plus. apply is_lim_seq_const. eapply is_lim_seq_mult. apply is_lim_seq_const. apply is_lim_seq_geom. rewrite Rabs_pos_eq ; lra. by []. by []. by []. apply is_lim_seq_const. by []. eapply is_lim_seq_mult. eapply is_lim_seq_mult. apply is_lim_seq_const. eapply is_lim_seq_minus. apply is_lim_seq_const. apply is_lim_seq_geom. rewrite Rabs_pos_eq ; lra. by []. by []. apply is_lim_seq_const. by []. apply (f_equal (fun x => Some (Finite x))) ; simpl ; field. Qed. Lemma lim_c : is_lim_seq c (208333 + 1 / 3). Proof. assert (forall n, c n = 250000 - v n). elim => [ | n /= ->] /= ; field. eapply is_lim_seq_ext. intros n ; apply sym_eq, H. eapply is_lim_seq_minus. apply is_lim_seq_const. by apply lim_v. apply (f_equal (fun x => Some (Finite x))) ; simpl ; field. Qed. coquelicot-coquelicot-3.4.1/examples/Bessel.v000066400000000000000000000535271455143432500212770ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. From Coquelicot Require Import Rcomplements Rbar Hierarchy Derive Series PSeries Lim_seq AutoDerive. (** This file is an example of how to use power series. It defines and gives properties of the Bessel functions. *) Definition Bessel1_seq (n k : nat) := (-1)^(k)/(INR (fact (k)) * INR (fact (n + (k)))). Lemma Bessel1_seq_neq_0 (n : nat) : forall k, Bessel1_seq n k <> 0. Proof. move => k. apply Rmult_integral_contrapositive_currified. apply pow_nonzero, Ropp_neq_0_compat, R1_neq_R0. apply Rinv_neq_0_compat, Rmult_integral_contrapositive_currified ; apply INR_fact_neq_0. Qed. Lemma CV_Bessel1 (n : nat) : CV_radius (Bessel1_seq n) = p_infty. Proof. apply CV_radius_infinite_DAlembert. by apply Bessel1_seq_neq_0. apply is_lim_seq_ext with (fun p => / (INR (S p) * INR (S (n + p)))). move => p ; rewrite /Bessel1_seq -plus_n_Sm /fact -/fact !mult_INR. simpl ((-1)^(S p)). field_simplify (-1 * (-1) ^ p / (INR (S p) * INR (fact p) * (INR (S (n + p)) * INR (fact (n + p)))) / ((-1) ^ p / (INR (fact p) * INR (fact (n + p))))). rewrite Rabs_div. rewrite Rabs_Ropp Rabs_R1 /Rdiv Rmult_1_l Rabs_pos_eq. by []. apply Rmult_le_pos ; apply pos_INR. apply Rgt_not_eq, Rmult_lt_0_compat ; apply lt_0_INR, Nat.lt_0_succ. repeat split. by apply INR_fact_neq_0. by apply INR_fact_neq_0. by apply Rgt_not_eq, lt_0_INR, Nat.lt_0_succ. by apply Rgt_not_eq, lt_0_INR, Nat.lt_0_succ. by apply pow_nonzero, Rlt_not_eq, (IZR_lt (-1) 0). replace (Finite 0) with (Rbar_inv p_infty) by auto. apply is_lim_seq_inv. eapply is_lim_seq_mult. apply -> is_lim_seq_incr_1. by apply is_lim_seq_INR. apply is_lim_seq_ext with (fun k => INR (k + S n)). intros k. by rewrite (Nat.add_comm n k) plus_n_Sm. apply is_lim_seq_incr_n. by apply is_lim_seq_INR. by []. by []. Qed. Lemma ex_Bessel1 (n : nat) (x : R) : ex_pseries (Bessel1_seq n) x. Proof. apply CV_radius_inside. by rewrite CV_Bessel1. Qed. Definition Bessel1 (n : nat) (x : R) := (x/2)^n * PSeries (Bessel1_seq n) ((x/2)^2). Lemma is_derive_Bessel1 (n : nat) (x : R) : is_derive (Bessel1 n) x ((x / 2) ^ S n * PSeries (PS_derive (Bessel1_seq n)) ((x / 2) ^ 2) + (INR n)/2 * (x / 2) ^ pred n * PSeries (Bessel1_seq n) ((x / 2) ^ 2)). Proof. rewrite /Bessel1. auto_derive. apply ex_derive_PSeries. by rewrite CV_Bessel1. rewrite Derive_PSeries. rewrite /Rdiv ; simpl ; field. by rewrite CV_Bessel1. Qed. Lemma is_derive_2_Bessel1 (n : nat) (x : R) : is_derive_n (Bessel1 n) 2 x (((x/2)^(S (S n)) * PSeries (PS_derive (PS_derive (Bessel1_seq n))) ((x / 2) ^ 2)) + ((INR (2*n+1)/2) * (x/2)^n * PSeries (PS_derive (Bessel1_seq n)) ((x / 2) ^ 2)) + (INR (n * pred n) / 4 * (x / 2) ^ pred (pred n) * PSeries (Bessel1_seq n) ((x / 2) ^ 2))). Proof. rewrite plus_INR ?mult_INR ; simpl INR. eapply is_derive_ext. move => y ; by apply sym_eq, is_derive_unique, is_derive_Bessel1. auto_derive. repeat split. apply ex_derive_PSeries. by rewrite CV_radius_derive CV_Bessel1. apply ex_derive_PSeries. by rewrite CV_Bessel1. rewrite !Derive_PSeries. case: n => [ | n] ; rewrite ?S_INR /Rdiv /= ; field. by rewrite CV_Bessel1. by rewrite CV_radius_derive CV_Bessel1. Qed. Lemma Bessel1_correct (n : nat) (x : R) : x^2 * Derive_n (Bessel1 n) 2 x + x * Derive (Bessel1 n) x + (x^2 - (INR n)^2) * Bessel1 n x = 0. Proof. rewrite (is_derive_unique _ _ _ (is_derive_Bessel1 _ _)) ; rewrite /Derive_n (is_derive_unique _ _ _ (is_derive_2_Bessel1 _ _)) ; rewrite /Bessel1 plus_INR ?mult_INR ; simpl INR. set y := x/2 ; replace x with (2 * y) by (unfold y ; field). replace (_ + _) with (4 * y^S (S n) * (y^2 * PSeries (PS_derive (PS_derive (Bessel1_seq n))) (y ^ 2) + (INR n + 1) * PSeries (PS_derive (Bessel1_seq n)) (y ^ 2) + PSeries (Bessel1_seq n) (y ^ 2))). 2: { case: n => [|[|n]] ; rewrite ?S_INR /= ; field. } apply Rmult_eq_0_compat_l. rewrite -PSeries_incr_1 -PSeries_scal -?PSeries_plus. unfold PS_derive, PS_incr_1, PS_scal, PS_plus. rewrite -(PSeries_const_0 (y^2)). apply PSeries_ext. case => [ | p] ; rewrite /Bessel1_seq ; rewrite -?plus_n_Sm ?Nat.add_0_r /fact -/fact ?mult_INR ?S_INR ?plus_INR ; simpl INR ; simpl pow ; rewrite ?Rplus_0_l ?Rmult_1_l. rewrite /plus /zero /scal /= /mult /=. field. split ; rewrite -?S_INR ; apply Rgt_not_eq. by apply INR_fact_lt_0. by apply (lt_INR 0), Nat.lt_0_succ. rewrite /plus /scal /= /mult /=. field. repeat split ; rewrite -?plus_INR -?S_INR ; apply Rgt_not_eq. by apply INR_fact_lt_0. by apply (lt_INR 0), Nat.lt_0_succ. by apply INR_fact_lt_0. by apply (lt_INR 0), Nat.lt_0_succ. by apply (lt_INR 0), Nat.lt_0_succ. by apply (lt_INR 0), Nat.lt_0_succ. apply CV_radius_inside. apply Rbar_lt_le_trans with (2 := CV_radius_plus _ _). apply Rbar_min_case. by rewrite CV_radius_incr_1 ?CV_radius_derive CV_Bessel1. rewrite CV_radius_scal. by rewrite CV_radius_derive CV_Bessel1. now rewrite -S_INR ; apply not_0_INR, sym_not_eq, O_S. by apply ex_Bessel1. apply ex_pseries_R, ex_series_Rabs, CV_disk_inside. by rewrite CV_radius_incr_1 ?CV_radius_derive CV_Bessel1. apply ex_pseries_R, ex_series_Rabs, CV_disk_inside. rewrite CV_radius_scal. by rewrite CV_radius_derive CV_Bessel1. now rewrite -S_INR ; apply not_0_INR, sym_not_eq, O_S. Qed. Lemma Bessel1_equality_1 (n : nat) (x : R) : x <> 0 -> Bessel1 (S n)%nat x = INR n * Bessel1 n x / x - Derive (Bessel1 n) x. Proof. move => Hx. rewrite (is_derive_unique _ _ _ (is_derive_Bessel1 _ _)) /Bessel1. set y := (x / 2). replace x with (2 * y) by (unfold y ; field). (* Supprimer les PSeries *) have Hy : y <> 0. unfold y ; contradict Hx. replace x with (2 * (x/2)) by field ; rewrite Hx ; ring. case: n => [ | n] ; simpl ; field_simplify => // ; rewrite ?Rdiv_1 -/(pow _ 2). (* * cas n = 0 *) replace (- 2 * y ^ 2 * PSeries (PS_derive (Bessel1_seq 0)) (y ^ 2) / (2 * y)) with (y * ((-1) * PSeries (PS_derive (Bessel1_seq 0)) (y ^ 2))) by (simpl ; unfold y ; field => //). apply f_equal. rewrite -PSeries_scal. apply PSeries_ext => k. rewrite /Bessel1_seq /PS_scal /PS_derive Nat.add_0_l. replace (1+k)%nat with (S k) by ring. rewrite /fact -/fact mult_INR /pow -/pow. change scal with Rmult. field ; split. exact: INR_fact_neq_0. by apply not_0_INR, not_eq_sym, O_S. (* * cas S n *) replace (-2 * y ^ 2 * y ^ n * PSeries (PS_derive (Bessel1_seq (S n))) (y ^ 2) / 2) with (y^2 * y^n * (((-1)* PSeries (PS_derive (Bessel1_seq (S n))) (y ^ 2)))) by (unfold y ; field => //). apply f_equal. rewrite -PSeries_scal. apply PSeries_ext => k. rewrite /Bessel1_seq /PS_scal /PS_derive -?plus_n_Sm ?plus_Sn_m. rewrite /pow -/pow /fact -/fact ?mult_INR ?S_INR plus_INR. change scal with Rmult. field. rewrite -plus_INR -?S_INR. repeat split ; try by [exact: INR_fact_neq_0 | apply not_0_INR, not_eq_sym, O_S]. Qed. Lemma Bessel1_equality_2 (n : nat) (x : R) : (0 < n)%nat -> x<>0 -> Bessel1 (S n)%nat x + Bessel1 (pred n)%nat x = (2*INR n)/x * Bessel1 n x. Proof. case: n => [ | n] Hn Hx. by apply Nat.lt_irrefl in Hn. clear Hn ; simpl pred. rewrite /Bessel1 S_INR. replace ((x / 2) ^ S (S n) * PSeries (Bessel1_seq (S (S n))) ((x / 2) ^ 2) + (x / 2) ^ n * PSeries (Bessel1_seq n) ((x / 2) ^ 2)) with ((x/2)^n * ((x/2)^2 * PSeries (Bessel1_seq (S (S n))) ((x / 2) ^ 2) + PSeries (Bessel1_seq n) ((x / 2) ^ 2))) by (simpl ; ring). replace (2 * (INR n + 1) / x * ((x / 2) ^ S n * PSeries (Bessel1_seq (S n)) ((x / 2) ^ 2))) with ((x/2)^n * ((INR n + 1) * PSeries (Bessel1_seq (S n)) ((x / 2) ^ 2))) by (simpl ; field ; exact: Hx). apply f_equal. rewrite -PSeries_incr_1 -PSeries_scal -PSeries_plus. 2: (* ex_pseries (PS_incr_1 (Bessel1_seq (S (S n))) (S (S n))) ((x / 2) ^ 2) *) by apply ex_pseries_incr_1, ex_Bessel1. 2: (* ex_pseries (PS_incr_n (Bessel1_seq n) n) ((x / 2) ^ 2) *) by apply ex_Bessel1. apply PSeries_ext => k. (* egalité *) rewrite /PS_plus /PS_scal /PS_incr_1 /Bessel1_seq ; case: k => [ | k] ; rewrite ?Nat.add_0_r -?plus_n_Sm ?plus_Sn_m /fact -/fact ?mult_INR ?S_INR ?plus_INR /=. rewrite plus_zero_l /scal /= /mult /=. field. rewrite -S_INR ; split ; by [apply not_0_INR, sym_not_eq, O_S | apply INR_fact_neq_0]. rewrite /plus /scal /= /mult /=. field ; rewrite -?plus_INR -?S_INR ; repeat split ; by [apply INR_fact_neq_0 | apply not_0_INR, sym_not_eq, O_S]. Qed. Lemma Bessel1_equality_3 (n : nat) (x : R) : (0 < n)%nat -> Bessel1 (S n)%nat x - Bessel1 (pred n)%nat x = - 2 * Derive (Bessel1 n) x. Proof. move => Hn. rewrite (is_derive_unique _ _ _ (is_derive_Bessel1 _ _)) /Bessel1. case: n Hn => [ | n] Hn. by apply Nat.lt_irrefl in Hn. clear Hn ; simpl pred. replace ((x / 2) ^ S (S n) * PSeries (Bessel1_seq (S (S n))) ((x / 2) ^ 2) - (x / 2) ^ n * PSeries (Bessel1_seq n) ((x / 2) ^ 2)) with ((x/2)^n * ((x/2)^2 * PSeries (Bessel1_seq (S (S n))) ((x / 2) ^ 2) - PSeries (Bessel1_seq n) ((x / 2) ^ 2))) by (simpl ; ring). replace (-2 *((x / 2) ^ S (S n) * PSeries (PS_derive (Bessel1_seq (S n))) ((x / 2) ^ 2) + INR (S n) / 2 * (x / 2) ^ n * PSeries (Bessel1_seq (S n)) ((x / 2) ^ 2))) with ((x/2)^n * (-2 * ((x/2)^2 * PSeries (PS_derive (Bessel1_seq (S n))) ((x / 2) ^ 2)) - INR (S n) * PSeries (Bessel1_seq (S n)) ((x / 2) ^ 2))) by (rewrite S_INR ; simpl ; field). set y := (x / 2). apply f_equal. rewrite -?PSeries_incr_1 -?PSeries_scal -?PSeries_minus. apply PSeries_ext => k. rewrite /PS_minus /PS_incr_1 /PS_scal /PS_derive /Bessel1_seq. case: k => [ | k] ; rewrite -?plus_n_Sm ?plus_Sn_m /fact -/fact ?mult_INR ?S_INR -?plus_n_O ?plus_INR /= ; rewrite /plus /opp /zero /scal /= /mult /= ; field ; rewrite -?plus_INR -?S_INR. split ; (apply INR_fact_neq_0 || apply not_0_INR, sym_not_eq, O_S). repeat split ; (apply INR_fact_neq_0 || apply not_0_INR, sym_not_eq, O_S). apply @ex_pseries_scal, @ex_pseries_incr_1, ex_pseries_derive. by apply Rmult_comm. by rewrite CV_Bessel1. apply ex_pseries_scal, ex_Bessel1. by apply Rmult_comm. by apply ex_pseries_incr_1, ex_Bessel1. by apply ex_Bessel1. Qed. (** * Unicity *) Lemma Bessel1_uniqueness_aux_0 (a : nat -> R) (n : nat) : Rbar_lt 0 (CV_radius a) -> (forall x : R, Rbar_lt (Rabs x) (CV_radius a) -> x^2 * Derive_n (PSeries a) 2 x + x * Derive (PSeries a) x + (x^2 - (INR n)^2) * PSeries a x = 0) -> (a 0%nat = 0 \/ n = O) /\ (a 1%nat = 0 \/ n = 1%nat) /\ (forall k, (INR (S (S k)) ^ 2 - INR n ^ 2) * a (S (S k)) + a k = 0). Proof. move => Ha H. cut (forall k, (PS_plus (PS_plus (PS_incr_n (PS_derive_n 2 a) 2) (PS_incr_1 (PS_derive a))) (PS_plus (PS_incr_n a 2) (PS_scal (- INR n ^ 2) a))) k = 0). intros Haux. split ; [move: (Haux 0%nat) | move: (fun k => Haux (S k))] => {} Haux. (* n = 0 *) rewrite /PS_plus /= /PS_incr_1 /PS_derive_n /PS_scal /PS_derive in Haux. rewrite /plus /zero /scal /= /mult /= in Haux. ring_simplify in Haux. apply Rmult_integral in Haux ; case: Haux => Haux. right. suff : ~ n <> 0%nat. by intuition. contradict Haux. apply Ropp_neq_0_compat. apply pow_nonzero. by apply not_0_INR. by left. split ; [move: (Haux 0%nat) | move: (fun k => Haux (S k))] => {} Haux. (* n = 1 *) rewrite /PS_plus /= /PS_incr_1 /PS_derive_n /PS_scal /PS_derive /= in Haux. rewrite /plus /zero /scal /= /mult /= in Haux. ring_simplify in Haux. replace (- a 1%nat * INR n ^ 2 + a 1%nat) with ((1 - INR n ^ 2) * a 1%nat) in Haux. apply Rmult_integral in Haux ; case: Haux => Haux. right. suff : ~ n <> 1%nat. by intuition. contradict Haux. replace (1 - INR n ^ 2) with ((1-INR n) * (1 + INR n)) by ring. apply Rmult_integral_contrapositive_currified. apply Rminus_eq_contra. apply sym_not_eq. by apply not_1_INR. apply Rgt_not_eq, Rlt_le_trans with (1 := Rlt_0_1). apply Rminus_le_0 ; ring_simplify. by apply pos_INR. by left. ring. (* n >= 2 *) move => k ; rewrite ?S_INR /= ; move: (Haux k) ; rewrite /PS_plus /= /PS_incr_1 /PS_derive_n /PS_scal /PS_derive -?S_INR. replace (k + 2)%nat with (S (S k)) by ring. rewrite /fact -/fact ?mult_INR ?S_INR => {} Haux. rewrite /plus /scal /= /mult /= in Haux. field_simplify in Haux. field_simplify. by rewrite (Rmult_comm (INR n ^ 2)). try revert Haux. by apply INR_fact_neq_0. move => k. apply (PSeries_ext_recip _ (fun _ => 0)). apply Rbar_lt_le_trans with (2 := CV_radius_plus _ _). apply Rbar_min_case. apply Rbar_lt_le_trans with (2 := CV_radius_plus _ _). apply Rbar_min_case. rewrite /PS_incr_n ?CV_radius_incr_1. by rewrite CV_radius_derive_n. rewrite CV_radius_incr_1. by rewrite CV_radius_derive. apply Rbar_lt_le_trans with (2 := CV_radius_plus _ _). apply Rbar_min_case. by rewrite /PS_incr_n ?CV_radius_incr_1. destruct n. rewrite -(CV_radius_ext (fun _ => 0)) ?CV_radius_const_0. by []. intros n ; rewrite /PS_scal /= /scal /= /mult /= ; ring. rewrite CV_radius_scal ?Ha //. apply Ropp_neq_0_compat, pow_nonzero, not_0_INR, sym_not_eq, O_S. by rewrite CV_radius_const_0. assert (0 < Rbar_min 1 (CV_radius a)). destruct (CV_radius a) as [ca | | ] ; try by auto. apply Rbar_min_case => //. by apply Rlt_0_1. apply Rbar_min_case_strong => // _. by apply Rlt_0_1. exists (mkposreal _ H0) => x Hx. assert (Rbar_lt (Rabs x) (CV_radius a)). destruct (CV_radius a) as [ca | | ] ; try by auto. simpl. eapply Rlt_le_trans. rewrite -(Rminus_0_r x). by apply Hx. simpl. apply Rmin_case_strong => // H1. by apply Req_le. rewrite PSeries_const_0 ?PSeries_plus. rewrite ?PSeries_incr_n PSeries_incr_1 PSeries_scal -Derive_n_PSeries. rewrite -Derive_PSeries. rewrite -Rmult_plus_distr_r. apply H. by apply H1. by apply H1. by apply H1. apply ex_pseries_incr_n, CV_radius_inside, H1. apply ex_pseries_scal, CV_radius_inside. by apply Rmult_comm. by apply H1. apply ex_pseries_incr_n. apply CV_radius_inside. rewrite CV_radius_derive_n. by apply H1. apply ex_pseries_incr_1, ex_pseries_derive. by apply H1. apply ex_pseries_plus. apply ex_pseries_incr_n. apply CV_radius_inside. by rewrite CV_radius_derive_n ; apply H1. apply ex_pseries_incr_1, ex_pseries_derive. by apply H1. apply ex_pseries_plus. apply ex_pseries_incr_n. apply CV_radius_inside. by apply H1. apply ex_pseries_scal. by apply Rmult_comm. apply CV_radius_inside ; by apply H1. Qed. Lemma Bessel1_uniqueness_aux_1 (a : nat -> R) (n : nat) : (a 0%nat = 0 \/ n = O) -> (a 1%nat = 0 \/ n = 1%nat) -> (forall k, (INR (S (S k)) ^ 2 - INR n ^ 2) * a (S (S k)) + a k = 0) -> (forall k : nat, (k < n)%nat -> a k = 0) /\ (forall p : nat, a (n + 2 * p + 1)%nat = 0) /\ (forall p : nat, a (n + 2 * p)%nat = Bessel1_seq n p * / 2 ^ (2 * p) * INR (fact n) * a n). Proof. intros Ha0 Ha1 Ha. assert (forall k, S (S k) <> n -> a (S (S k)) = - a k / (INR (S (S k)) ^ 2 - INR n ^ 2)). intros k Hk. replace (a k) with (- (INR (S (S k)) ^ 2 - INR n ^ 2) * a (S (S k))). field. replace (INR (S (S k)) ^ 2 - INR n ^ 2) with ((INR (S (S k)) - INR n) * (INR (S (S k)) + INR n)) by ring. apply Rmult_integral_contrapositive_currified. apply Rminus_eq_contra. by apply not_INR. rewrite -plus_INR plus_Sn_m. by apply (not_INR _ O), sym_not_eq, O_S. replace (a k) with ((INR (S (S k)) ^ 2 - INR n ^ 2) * a (S (S k)) + a k - (INR (S (S k)) ^ 2 - INR n ^ 2) * a (S (S k))) by ring. rewrite Ha ; ring. assert (forall k : nat, (k < n)%nat -> a k = 0). destruct n => k Hk. by apply Nat.nlt_0_r in Hk. case: Ha0 => // Ha0. destruct n. destruct k => //. by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hk. case: Ha1 => // Ha1. move: k Hk. apply (MyNat.ind_0_1_SS (fun k => (k < S (S n))%nat -> a k = 0)) => // k IH Hk. rewrite H. rewrite IH /Rdiv. ring. eapply Nat.lt_trans, Hk. eapply Nat.lt_trans ; apply Nat.lt_succ_diag_r. by apply MyNat.lt_neq. repeat split. by []. elim => [ | p IH]. replace (n + 2 * 0 + 1)%nat with (S n) by ring. destruct n => //=. case: Ha1 => // Ha1. case: Ha0 => // Ha0. rewrite H ; try by intuition. rewrite H0 /Rdiv. ring. by apply Nat.lt_succ_diag_r. replace (n + 2 * S p + 1)%nat with (S (S (n + 2 * p + 1)%nat)) by ring. rewrite H ; try by intuition. rewrite IH /Rdiv. ring. elim => [ | p IH]. replace (n + 2 * 0)%nat with (n) by ring. rewrite /Bessel1_seq /= -plus_n_O. field ; by apply INR_fact_neq_0. replace (n + 2 * S p)%nat with (S (S (n + 2 * p)%nat)) by ring. rewrite H ; try by intuition. rewrite IH /Rdiv. rewrite /Bessel1_seq -plus_n_Sm. rewrite !pow_sqr /fact -/fact !mult_INR !S_INR !plus_INR /=. field ; rewrite -!plus_INR -!S_INR ; repeat split ; try (by apply INR_fact_neq_0) ; try (by apply (not_INR _ 0), sym_not_eq, O_S). apply pow_nonzero, Rgt_not_eq ; apply Rmult_lt_0_compat ; by apply Rlt_0_2. rewrite -Rsqr_plus_minus. apply Rmult_integral_contrapositive_currified. rewrite -plus_INR. apply Rgt_not_eq, lt_0_INR. lia. apply Rminus_eq_contra, not_INR. lia. Qed. Lemma Bessel1_uniqueness (a : nat -> R) (n : nat) : (Rbar_lt 0 (CV_radius a)) -> (forall x : R, x^2 * Derive_n (PSeries a) 2 x + x * Derive (PSeries a) x + (x^2 - (INR n)^2) * PSeries a x = 0) -> {b : R | forall x, PSeries a x = b * Bessel1 n x}. Proof. intros Hcv_a Ha. assert ((a 0%nat = 0 \/ n = O) /\ (a 1%nat = 0 \/ n = 1%nat) /\ (forall k, (INR (S (S k)) ^ 2 - INR n ^ 2) * a (S (S k)) + a k = 0)). by apply Bessel1_uniqueness_aux_0. assert ((forall k : nat, (k < n)%nat -> a k = 0) /\ (forall p : nat, a (n + 2 * p + 1)%nat = 0) /\ (forall p : nat, a (n + 2 * p)%nat = Bessel1_seq n p * / 2 ^ (2 * p) * INR (fact n) * a n)). apply Bessel1_uniqueness_aux_1 ; by apply H. exists (2^n * INR (fact n) * a n) => x. rewrite /Bessel1 (PSeries_decr_n_aux _ n). case: H0 => _ H0. rewrite Rpow_mult_distr -Rinv_pow. field_simplify ; rewrite ?Rdiv_1. rewrite !(Rmult_assoc (x ^ n)). apply Rmult_eq_compat_l. rewrite PSeries_odd_even. replace (PSeries (fun n0 : nat => PS_decr_n a n (2 * n0 + 1)) (x ^ 2)) with 0. case: H0 => _ H0. rewrite Rmult_0_r Rplus_0_r. rewrite -PSeries_scal. apply Series_ext => k. rewrite /PS_decr_n /PS_scal. rewrite H0. rewrite -!pow_mult. rewrite Rpow_mult_distr -Rinv_pow. rewrite /scal /= /mult /=. ring. by apply Rgt_not_eq, Rlt_0_2. apply sym_eq. rewrite -(PSeries_const_0 (x^2)). apply PSeries_ext => k. rewrite /PS_decr_n. replace (n + (2 * k + 1))%nat with (n + 2 * k + 1)%nat by ring. by apply H0. eapply ex_pseries_ext. move => p ; apply sym_eq. apply H0. eapply ex_pseries_ext. intros p ; rewrite Rmult_assoc ; apply Rmult_comm. apply @ex_pseries_scal. by apply Rmult_comm. case: (Req_dec x 0) => Hx0. rewrite Hx0. rewrite /= Rmult_0_l. by apply @ex_pseries_0. apply ex_series_Rabs. apply ex_series_DAlembert with 0. by apply Rlt_0_1. intros p. apply Rmult_integral_contrapositive_currified. rewrite pow_n_pow. by apply pow_nonzero, pow_nonzero. apply Rmult_integral_contrapositive_currified. by apply Bessel1_seq_neq_0. apply Rinv_neq_0_compat. apply pow_nonzero. by apply Rgt_not_eq, Rlt_0_2. apply is_lim_seq_ext with (fun p => x^2 / 4 * / (INR (S p) * INR (S (n + p)))). intros p ; rewrite !pow_n_pow !pow_mult. rewrite /Bessel1_seq -plus_n_Sm /fact -/fact !mult_INR. replace (@scal R_AbsRing R_NormedModule) with Rmult by auto. simpl (_^(S p)) ; rewrite -!/(pow _ 2) ; ring_simplify (2^2). field_simplify (x ^ 2 * (x ^ 2) ^ p * (-1 * (-1) ^ p / (INR (S p) * INR (fact p) * (INR (S (n + p)) * INR (fact (n + p)))) * / (4 * 4 ^ p)) / ((x ^ 2) ^ p * ((-1) ^ p / (INR (fact p) * INR (fact (n + p))) * / 4 ^ p))). rewrite Rabs_div. rewrite Rabs_Ropp /Rdiv !Rabs_pos_eq. field. split ; apply (not_INR _ 0), sym_not_eq, O_S. change 4 with (INR 2 * INR 2). repeat apply Rmult_le_pos ; apply pos_INR. by apply pow2_ge_0. change 4 with (INR 2 * INR 2). apply Rgt_not_eq ; repeat apply Rmult_lt_0_compat ; apply lt_0_INR, Nat.lt_0_succ. repeat split. apply pow_nonzero, Rgt_not_eq ; repeat apply Rmult_lt_0_compat ; apply Rlt_0_2. by apply INR_fact_neq_0. by apply INR_fact_neq_0. by apply Rgt_not_eq, lt_0_INR, Nat.lt_0_succ. by apply Rgt_not_eq, lt_0_INR, Nat.lt_0_succ. by apply pow_nonzero, Rlt_not_eq, (IZR_lt (-1) 0). rewrite -pow_mult ; by apply pow_nonzero. evar_last. apply is_lim_seq_scal_l. apply is_lim_seq_inv. eapply is_lim_seq_mult. apply -> is_lim_seq_incr_1. by apply is_lim_seq_INR. apply is_lim_seq_ext with (fun k => INR (k + S n)). intros k. by rewrite (Nat.add_comm n k) plus_n_Sm. apply is_lim_seq_incr_n. by apply is_lim_seq_INR. by []. by []. simpl ; apply f_equal ; ring. apply ex_pseries_ext with (fun _ => 0). intros k. rewrite /PS_decr_n /=. replace (n + (k + (k + 0) + 1))%nat with (n + 2 * k + 1)%nat by ring. by rewrite (proj1 H0). eapply ex_series_ext. intros k. rewrite /scal /= /mult /= Rmult_0_r. reflexivity. exists 0 ; apply filterlim_ext with (fun _ => 0). elim => /= [ | k IH]. by rewrite sum_O. by rewrite sum_Sn plus_zero_r. by apply filterlim_const. by apply pow_nonzero, Rgt_not_eq, Rlt_0_2. by apply Rgt_not_eq, Rlt_0_2. by apply H0. Qed. coquelicot-coquelicot-3.4.1/examples/DAlembert.v000066400000000000000000000167071455143432500217200ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect. From Coquelicot Require Import Rcomplements Derive RInt Hierarchy Derive_2d AutoDerive. (** This file aims at proving that d'Alembert's formula defines a function that is solution to the one-dimensional wave equation. We also need to prove the regularity of this function. *) Local Open Scope R_scope. Ltac auto_derive_2 := match goal with | |- is_derive_n ?f 2 ?x ?d => auto_derive_fun f ; match goal with | |- (forall x, _ -> is_derive _ x (@?d x)) -> _ => let H := fresh "H" in let u := fresh "u" in intro H ; apply (is_derive_ext d) ; [ intro u ; apply sym_eq, is_derive_unique ; apply H | auto_derive ] ; clear H end end. Section DAlembert. Parameter c : R. Hypothesis Zc : c <> 0. Parameter u0 : R -> R. Hypothesis Du0 : forall x, ex_derive (fun u => u0 u) x. Hypothesis D2u0 : forall x, ex_derive_n (fun u => u0 u) 2 x. Section Alpha. Definition alpha x t := 1/2 * (u0 (x + c * t) + u0 (x - c * t)). Definition alpha20 x t := 1/2 * (Derive_n u0 2 (x + c * t) + Derive_n u0 2 (x - c * t)). Definition alpha02 x t := c^2/2 * (Derive_n u0 2 (x + c * t) + Derive_n u0 2 (x - c * t)). Lemma alpha_20_lim : forall x t, is_derive_n (fun u => alpha u t) 2 x (alpha20 x t). Proof. intros x t. unfold alpha. auto_derive_2. repeat split ; apply Du0. repeat split ; apply D2u0. unfold alpha20, Derive_n, Rminus. ring. Qed. Lemma alpha_02_lim : forall x t, is_derive_n (fun u => alpha x u) 2 t (alpha02 x t). Proof. intros x t. unfold alpha. auto_derive_2. repeat split ; apply Du0. repeat split ; apply D2u0. unfold alpha02, Derive_n, Rminus, Rdiv. ring. Qed. End Alpha. Parameter u1 : R -> R. Hypothesis Du1 : forall x, ex_derive (fun u => u1 u) x. Lemma Cu1 : forall x, continuity_pt (fun u => u1 u) x. intros x. destruct (Du1 x) as (l,Hl). apply derivable_continuous_pt. unfold derivable_pt, derivable_pt_abs. exists l. now apply is_derive_Reals. Qed. Lemma continuity_implies_ex_Rint: forall f a b, (forall x, continuity_pt f x) -> ex_RInt f a b. intros f a b H. case (Rle_or_lt a b); intros H1. apply ex_RInt_Reals_1. apply continuity_implies_RiemannInt. exact H1. intros x _; apply H. apply ex_RInt_swap. apply ex_RInt_Reals_1. apply continuity_implies_RiemannInt. left; exact H1. intros x _; apply H. Qed. Lemma Iu1: forall a b, ex_RInt (fun u => u1 u) a b. intros a b. apply continuity_implies_ex_Rint. apply Cu1. Qed. Section Beta. Definition beta (x t : R) := 1/(2*c) * RInt (fun u => u1 u) (x - c * t) (x + c * t). Definition beta20 x t := 1/(2*c) * (Derive (fun u => u1 u) (x + c * t) - Derive (fun u => u1 u) (x - c * t)). Definition beta01 x t := 1/2 * (u1 (x + c * t) + u1 (x - c * t)). Definition beta02 x t := c/2 * (Derive (fun u => u1 u) (x + c * t) - Derive (fun u => u1 u) (x - c * t)). Lemma beta20_lim : forall x t, is_derive_n (fun u => beta u t) 2 x (beta20 x t). Proof. intros x t. unfold beta. auto_derive_2. (* . *) split. apply Iu1. repeat split. apply filter_forall. apply Cu1. apply filter_forall. apply Cu1. repeat split ; apply Du1. unfold beta20, Rminus. ring. Qed. Lemma beta01_lim : forall x t, is_derive (fun u => beta x u) t (beta01 x t). Proof. intros x t. unfold beta. auto_derive. split. apply Iu1. repeat split. apply filter_forall. apply Cu1. apply filter_forall. apply Cu1. unfold beta01, Rminus, Rdiv. now field. Qed. Lemma beta02_lim : forall x t, is_derive_n (fun u => beta x u) 2 t (beta02 x t). Proof. intros x t. unfold beta. auto_derive_2. split. apply Iu1. repeat split. apply filter_forall. apply Cu1. apply filter_forall. apply Cu1. repeat split ; apply Du1. unfold beta02, Rminus, Rdiv. now field. Qed. End Beta. Hypothesis f : R -> R -> R. Section Gamma. Definition gamma x t := 1/(2*c) * RInt (fun tau => RInt (fun xi => f xi tau) (x - c * (t - tau)) (x + c * (t - tau))) 0 t. Definition gamma20 x t := 1/(2*c) * RInt (fun tau => Derive (fun u => f u tau) (x + c * (t - tau)) - Derive (fun u => f u tau) (x - c * (t - tau))) 0 t. Definition gamma02 x t := (f x t + c/2 * RInt (fun tau => Derive (fun u => f u tau) (x + c * (t - tau)) - Derive (fun u => f u tau) (x - c * (t - tau))) 0 t). Lemma gamma20_lim : forall x t, is_derive_n (fun u => gamma u t) 2 x (gamma20 x t). Proof. intros x t. unfold gamma. auto_derive_2. repeat split. exists (mkposreal _ Rlt_0_1). simpl. intros t' u' _ _. repeat split. apply continuity_implies_ex_Rint => y. admit. (* cont 2D -> 1D *) apply filter_forall => y. admit. (* cont 2D -> 1D *) apply filter_forall => y. admit. (* cont 2D -> 1D *) apply filter_forall => y. apply continuity_implies_ex_Rint => z. apply derivable_continuous_pt. admit. (* ??? *) intros t' _. admit. repeat split. exists (mkposreal _ Rlt_0_1). intros t' u' _ _. repeat split. admit. admit. apply filter_forall => y. admit. intros t' _. admit. unfold gamma20. apply f_equal. apply RInt_ext => z _. now rewrite 4!Rmult_1_l. Admitted. Lemma gamma02_lim : forall x t, is_derive_n (fun u => gamma x u) 2 t (gamma02 x t). Proof. intros x t. unfold gamma. auto_derive_2. repeat split. apply locally_2d_forall => y z. admit. intros t' _. admit. apply filter_forall => y. admit. apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). simpl. apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). simpl. intros t' u' _ _. repeat split. apply continuity_implies_ex_Rint => y. admit. apply filter_forall => y. admit. apply filter_forall => y. admit. repeat split. apply locally_2d_forall => y z. admit. apply locally_2d_forall => y z. admit. intros x' _. admit. apply filter_forall => y. admit. apply filter_forall => y. admit. apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). intros t' u' _ _. admit. apply locally_2d_forall => y z. admit. intros t' _. admit. apply filter_forall => y. admit. apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). apply filter_forall => y. apply continuity_implies_ex_Rint => z. admit. exists (mkposreal _ Rlt_0_1). intros t' u' _ _. repeat split. admit. admit. unfold gamma02. ring_simplify. rewrite Rplus_opp_r Rmult_0_r Ropp_0 Rplus_0_r. rewrite RInt_point Rmult_0_r Rplus_0_r. apply Rplus_eq_reg_l with (- f x t). field_simplify. 2: exact Zc. rewrite Rmult_1_r. rewrite /Rdiv Rmult_comm. rewrite Rmult_assoc (Rmult_comm _ (/2)) -Rmult_assoc. rewrite -[Rmult]/(@scal _ R_ModuleSpace) -RInt_scal. rewrite -RInt_scal. apply RInt_ext => u _. rewrite /scal /= /mult /= /Rminus. now field. admit. admit. Admitted. End Gamma. End DAlembert. coquelicot-coquelicot-3.4.1/remake.cpp000066400000000000000000002424161455143432500200220ustar00rootroot00000000000000/* -*- mode: C++; indent-tabs-mode: t; c-basic-offset: 8; -*- */ /** @mainpage Remake, a build system that bridges the gap between make and redo. As with make, remake uses a centralized rule file, which is named Remakefile. It contains rules with a make-like syntax: @verbatim target1 target2 ... : prerequisite1 prerequisite2 ... shell script that builds the targets @endverbatim A target is known to be up-to-date if all its prerequisites are. If it has no known prerequisites yet the file already exits, it is assumed to be up-to-date. Obsolete targets are rebuilt thanks to the shell script provided by the rule. As with redo, remake supports dynamic dependencies in addition to these static dependencies. Whenever a script executes `remake prerequisite4 prerequisite5 ...`, these prerequisites are rebuilt if they are obsolete. (So remake acts like redo-ifchange.) Moreover, all the dependencies are stored in file .remake so that they are remembered in subsequent runs. Note that dynamic dependencies from previous runs are only used to decide whether a target is obsolete; they are not automatically rebuilt when they are obsolete yet a target depends on them. They will only be rebuilt once the dynamic call to remake is executed. In other words, the following two rules have almost the same behavior. @verbatim target1 target2 ... : prerequisite1 prerequisite2 ... shell script target1 target2 ... : remake prerequisite1 prerequisite2 ... shell script @endverbatim (There is a difference if the targets already exist, have never been built before, and the prerequisites are either younger or obsolete, since the targets will not be rebuilt in the second case.) The above usage of dynamic dependencies is hardly useful. Their strength lies in the fact that they can be computed on the fly: @verbatim %.o : %.c gcc -MMD -MF $@.d -o $@ -c $< remake -r < $@.d rm $@.d %.cmo : %.ml ocamldep $< | remake -r $@ ocamlc -c $< after.xml: before.xml rules.xsl xsltproc --load-trace -o after.xml rules.xsl before.xml 2> deps remake `sed -n -e "\\,//,! s,^.*URL=\"\\([^\"]*\\).*\$,\\1,p" deps` rm deps @endverbatim Note that the first rule fails if any of the header files included by a C source file has to be automatically generated. In that case, one should perform a first call to remake them before calling the compiler. (Dependencies from several calls to remake are cumulative, so they will all be remembered the next time.) \section sec-usage Usage Usage: remake options targets Options: - `-B`, `--always-make`: Unconditionally make all targets. - `-d`: Echo script commands. - `-f FILE`: Read `FILE` as Remakefile. - `-j[N]`, `--jobs=[N]`: Allow `N` jobs at once; infinite jobs with no argument. - `-k`, `--keep-going`: Keep going when some targets cannot be made. - `-r`: Look up targets from the dependencies on standard input. - `-s`, `--silent`, `--quiet`: Do not echo targets. \section sec-syntax Syntax Lines starting with a space character or a tabulation are assumed to be rule scripts. They are only allowed after a rule header. Lines starting with `#` are considered to be comments and are ignored. They do interrupt rule scripts though. Any other line is either a variable definition or a rule header. If such a line ends with a backslash, the following line break is ignored and the line extends to the next one. Variable definitions are a single name followed by equal followed by a list of names, possibly empty. Rule headers are a nonempty list of names, followed by a colon, followed by another list of names, possibly empty. Basically, the syntax of a rule is as follows: @verbatim targets : prerequisites shell script @endverbatim List of names are space-separated sequences of names. If a name contains a space character, it should be put into double quotes. Names cannot be any of the following special characters `:$(),="`. Again, quotation should be used. Quotation marks can be escaped by a backslash inside quoted names. \subsection sec-variables Variables Variables can be used to factor lists of targets or prerequisites. They are expanded as they are encountered during Remakefile parsing. @verbatim VAR2 = a VAR1 = c d VAR2 += $(VAR1) b $(VAR2) e : @endverbatim Variable assignments can appear instead of prerequisites inside non-generic rules with no script. They are then expanded inside the corresponding generic rule. @verbatim foo.o: CFLAGS += -DBAR %.o : %.c gcc $(CFLAGS) -MMD -MF $@.d -o $@ -c $< remake -r < $@.d rm $@.d @endverbatim Note: contrarily to make, variable names have to be enclosed in parentheses. For instance, `$y` is not a shorthand for \$(y) and is left unexpanded. \subsection sec-autovars Automatic variables The following special symbols can appear inside scripts: - `$<` expands to the first static prerequisite of the rule. - `$^` expands to all the static prerequisites of the rule, including duplicates if any. - `$@` expands to the first target of the rule. - `$*` expands to the string that matched `%` in a generic rule. - `$$` expands to a single dollar symbol. Note: contrarily to make, there are no corresponding variables. For instance, `$^` is not a shorthand for `$(^)`. Another difference is that `$@` is always the first target, not the one that triggered the rule. \subsection sec-functions Built-in functions remake also supports a few built-in functions inspired from make. - $(addprefix prefix, list) returns the list obtained by prepending its first argument to each element of its second argument. - $(addsuffix suffix, list) returns the list obtained by appending its first argument to each element of its second argument. \subsection sec-order Order-only prerequisites If the static prerequisites of a rule contain a pipe symbol, prerequisites on its right do not cause the targets to become obsolete if they are newer (unless they are also dynamically registered as dependencies). They are meant to be used when the targets do not directly depend on them, but the computation of their dynamic dependencies does. @verbatim %.o : %.c | parser.h gcc -MMD -MF $@.d -o $@ -c $< remake -r < $@.d rm $@.d parser.c parser.h: parser.y yacc -d -o parser.c parser.y @endverbatim \subsection sec-static-pattern Static pattern rules A rule with the following structure is expanded into several rules, one per target. @verbatim targets: pattern1 pattern2 ...: prerequisites @endverbatim Every target is matched against one of the patterns containing the `%` character. A rule is then created using the patterns as targets, after having substituted `%` in the patterns and prerequisites. The automatic variable `$*` can be used in the script of the rule. \subsection sec-special-tgt Special targets Target `.PHONY` marks its prerequisites as being always obsolete. \subsection sec-special-var Special variables Variable `.OPTIONS` is handled specially. Its content enables some features of remake that are not enabled by default. - `variable-propagation`: When a variable is set in the prerequisite part of a rule, it is propagated to the rules of all the targets this rule depends on. This option also enables variables to be set on the command line. Note that, as in make, this features introduces non-determinism: the content of some variables will depend on the build order. \section sec-semantics Semantics \subsection src-obsolete When are targets obsolete? A target is obsolete: - if there is no file corresponding to the target, or to one of its siblings in a multi-target rule, - if any of its dynamic prerequisites from a previous run or any of its static prerequisites is obsolete, - if the latest file corresponding to its siblings or itself is older than any of its dynamic prerequisites or static prerequisites. In all the other cases, it is assumed to be up-to-date (and so are all its siblings). Note that the last rule above says "latest" and not "earliest". While it might cause some obsolete targets to go unnoticed in corner cases, it allows for the following kind of rules: @verbatim config.h stamp-config_h: config.h.in config.status ./config.status config.h touch stamp-config_h @endverbatim A `config.status` file generally does not update header files (here `config.h`) if they would not change. As a consequence, if not for the `stamp-config_h` file above, a header would always be considered obsolete once one of its prerequisites is modified. Note that touching `config.h` rather than `stamp-config_h` would defeat the point of not updating it in the first place, since the program files would need to be rebuilt. Once all the static prerequisites of a target have been rebuilt, remake checks whether the target still needs to be built. If it was obsolete only because its prerequisites needed to be rebuilt and none of them changed, the target is assumed to be up-to-date. \subsection sec-rules How are targets (re)built? There are two kinds of rules. If any of the targets or prerequisites contains a `%` character, the rule is said to be generic. All the targets of the rule shall then contain a single `%` character. All the other rules are said to be specific. A rule is said to match a given target: - if it is specific and the target appears inside its target list, - if it is generic and there is a way to replace the `%` character from one of its targets so that it matches the given target. When remake tries to build a given target, it looks for a specific rule that matches it. If there is one and its script is nonempty, it uses it to rebuild the target. Otherwise, it looks for a generic rule that matches the target. If there are several matching rules, it chooses the one with the shortest pattern (and if there are several ones, the earliest one). It then looks for specific rules that match each target of the generic rule. All the prerequisites of these specific rules are added to those of the generic rule. The script of the generic rule is used to build the target. Example: @verbatim t%1 t2%: p1 p%2 commands building t%1 and t2% t2z: p4 commands building t2z ty1: p3 # t2x is built by the first rule (which also builds tx1) and its prerequisites are p1, px2 # t2y is built by the first rule (which also builds ty1) and its prerequisites are p1, py2, p3 # t2z is built by the second rule and its prerequisite is p4 @endverbatim The set of rules from Remakefile is ill-formed: - if any specific rule matching a target of the generic rule has a nonempty script, - if any target of the generic rule is matched by a generic rule with a shorter pattern. \section sec-compilation Compilation - On Linux, MacOSX, and BSD: `g++ -o remake remake.cpp` - On Windows: `g++ -o remake.exe remake.cpp -lws2_32` Installing remake is needed only if Remakefile does not specify the path to the executable for its recursive calls. Thanks to its single source file, remake can be shipped inside other packages and built at configuration time. \section sec-differences Differences with other build systems Differences with make: - Dynamic dependencies are supported. - For rules with multiple targets, the shell script is executed only once and is assumed to build all the targets. There is no need for convoluted rules that are robust enough for parallel builds. For generic rules, this is similar to the behavior of pattern rules from gmake. - As with redo, only one shell is run when executing a script, rather than one per script line. Note that the shells are run with option `-e`, thus causing them to exit as soon as an error is encountered. - The prerequisites of generic rules (known as implicit rules in make lingo) are not used to decide between several of them, which means that remake does not select one for which it could satisfy the dependencies. - Variables and built-in functions are expanded as they are encountered during Remakefile parsing. - Target-specific variables are not propagated, unless specifically enabled, since this causes non-deterministic builds. This is the same for variables set on the command line. Differences with redo: - As with make, it is possible to write the following kind of rules in remake. @verbatim Remakefile: Remakefile.in ./config.status ./config.status Remakefile @endverbatim - If a target is already built the first time remake runs, it still uses the static prerequisites of rules mentioning it to check whether it needs to be rebuilt. It does not assume it to be up-to-date. As with redo though, if its obsolete status would be due to a dynamic prerequisite, it will go unnoticed; it should be removed beforehand. - Multiple targets are supported. - remake has almost no features: no checksum-based dependencies, no compatibility with job servers, etc. \section sec-limitations Limitations - If a rule script calls remake, the current working directory should be the directory containing Remakefile (or the working directory from the original remake if it was called with option `-f`). - As with make, variables passed on the command line should keep the same values, to ensure deterministic builds. - Some cases of ill-formed rules are not caught by remake and can thus lead to unpredictable behaviors. \section sec-links Links @see http://cr.yp.to/redo.html for the philosophy of redo and https://github.com/apenwarr/redo for an implementation and some comprehensive documentation. \section sec-licensing Licensing @author Guillaume Melquiond @version 0.15 @date 2012-2020 @copyright This program 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 3 of the License, or (at your option) any later version. \n This program 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. \section sec-internals Internals The parent remake process acts as a server. The other ones have a REMAKE_SOCKET environment variable that tells them how to contact the server. They send the content of the REMAKE_JOB_ID environment variable, so that the server can associate the child targets to the jobs that spawned them. They then wait for completion and exit with the status returned by the server. This is handled by #client_mode. The server calls #load_dependencies and #save_dependencies to serialize dynamic dependencies from .remake. It loads Remakefile with #load_rules. It then runs #server_mode, which calls #server_loop. When building a target, the following sequence of events happens: - #start calls #find_rule (and #find_generic_rule) to get the rule. - It then creates a pseudo-client if the rule has static dependencies, or calls #run_script otherwise. In both cases, a new job is created; the rule and the variables are stored into #jobs. - #run_script creates a shell process and stores it in #job_pids. It increases #running_jobs. - The child process possibly calls remake with a list of targets. - #accept_client receives a build request from a child process and adds it to #clients. It also records the new dependencies of the job into #dependencies. It increases #waiting_jobs. - #handle_clients uses #get_status to look up the obsoleteness of the targets. - Once the targets of a request have been built or one of them has failed, #handle_clients calls #complete_request and removes the request from #clients. - If the build targets come from a pseudo-client, #complete_request calls #run_script. Otherwise it sends the reply to the corresponding child process and decreases #waiting_jobs. - When a child process ends, #server_loop calls #finalize_job, which removes the process from #job_pids, decreases #running_jobs, and calls #complete_job. - #complete_job removes the job from #jobs and calls #update_status to change the status of the targets. It also removes the target files in case of failure. */ #ifdef _WIN32 #define WIN32_LEAN_AND_MEAN #define WINDOWS #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifdef __APPLE__ #define MACOSX #endif #ifdef __linux__ #define LINUX #endif #ifdef WINDOWS #include #include #include #define pid_t HANDLE typedef SOCKET socket_t; #else #include #include #include typedef int socket_t; enum { INVALID_SOCKET = -1 }; extern char **environ; #endif #if (defined(WINDOWS) || defined(MACOSX)) && !defined(MSG_NOSIGNAL) enum { MSG_NOSIGNAL = 0 }; #endif typedef std::list string_list; typedef std::set string_set; /** * Reference-counted shared object. * @note The default constructor delays the creation of the object until it * is first dereferenced. */ template struct ref_ptr { struct content { size_t cnt; T val; content(): cnt(1) {} content(T const &t): cnt(1), val(t) {} }; mutable content *ptr; ref_ptr(): ptr(NULL) {} ref_ptr(T const &t): ptr(new content(t)) {} ref_ptr(ref_ptr const &p): ptr(p.ptr) { if (ptr) ++ptr->cnt; } ~ref_ptr() { if (ptr && --ptr->cnt == 0) delete ptr; } ref_ptr &operator=(ref_ptr const &p) { if (ptr == p.ptr) return *this; if (ptr && --ptr->cnt == 0) delete ptr; ptr = p.ptr; if (ptr) ++ptr->cnt; return *this; } T &operator*() const { if (!ptr) ptr = new content; return ptr->val; } T *operator->() const { return &**this; } }; struct dependency_t { string_list targets; string_set deps; }; typedef std::map > dependency_map; typedef std::map variable_map; /** * Build status of a target. */ enum status_e { Uptodate, ///< Target is up-to-date. Todo, ///< Target is missing or obsolete. Recheck, ///< Target has an obsolete dependency. Running, ///< Target is being rebuilt. RunningRecheck, ///< Static prerequisites are being rebuilt. Remade, ///< Target was successfully rebuilt. Failed ///< Build failed for target. }; /** * Build status of a target. */ struct status_t { status_e status; ///< Actual status. time_t last; ///< Last-modified date. }; typedef std::map status_map; /** * Delayed assignment to a variable. */ struct assign_t { bool append; string_list value; }; typedef std::map assign_map; /** * A rule loaded from Remakefile. */ struct rule_t { string_list targets; ///< Files produced by this rule. string_list deps; ///< Dependencies used for an implicit call to remake at the start of the script. string_list wdeps; ///< Like #deps, except that they are not registered as dependencies. assign_map assigns; ///< Assignment of variables. std::string stem; ///< Stem used to instantiate the rule, if any. std::string script; ///< Shell script for building the targets. }; typedef std::list rule_list; typedef std::map > rule_map; /** * A job created from a set of rules. */ struct job_t { rule_t rule; ///< Original rule. variable_map vars; ///< Values of local variables. }; typedef std::map job_map; typedef std::map pid_job_map; /** * Client waiting for a request to complete. * * There are two kinds of clients: * - real clients, which are instances of remake created by built scripts, * - pseudo clients, which are created by the server to build specific targets. * * Among pseudo clients, there are two categories: * - original clients, which are created for the targets passed on the * command line by the user or for the initial regeneration of the rule file, * - dependency clients, which are created to handle rules that have * explicit dependencies and thus to emulate a call to remake. */ struct client_t { socket_t socket; ///< Socket used to reply to the client (invalid for pseudo clients). int job_id; ///< Job for which the built script called remake and spawned the client (negative for original clients). bool failed; ///< Whether some targets failed in mode -k. string_list pending; ///< Targets not yet started. string_set running; ///< Targets being built. variable_map vars; ///< Variables set on request. bool delayed; ///< Whether it is a dependency client and a script has to be started on request completion. client_t(): socket(INVALID_SOCKET), job_id(-1), failed(false), delayed(false) {} }; typedef std::list client_list; /** * Map from variable names to their content. * Initialized with the values passed on the command line. */ static variable_map variables; /** * Map from targets to their known dependencies. */ static dependency_map dependencies; /** * Map from targets to their build status. */ static status_map status; /** * Set of generic rules loaded from Remakefile. */ static rule_list generic_rules; /** * Map from targets to specific rules loaded from Remakefile. */ static rule_map specific_rules; /** * Map of jobs being built. */ static job_map jobs; /** * Map from jobs to shell pids. */ static pid_job_map job_pids; /** * List of clients waiting for a request to complete. * New clients are put to front, so that the build process is depth-first. */ static client_list clients; /** * Maximum number of parallel jobs (non-positive if unbounded). * Can be modified by the -j option. */ static int max_active_jobs = 1; /** * Whether to keep building targets in case of failure. * Can be modified by the -k option. */ static bool keep_going = false; /** * Number of jobs currently running: * - it increases when a process is created in #run_script, * - it decreases when a completion message is received in #finalize_job. * * @note There might be some jobs running while #clients is empty. * Indeed, if a client requested two targets to be rebuilt, if they * are running concurrently, if one of them fails, the client will * get a failure notice and might terminate before the other target * finishes. */ static int running_jobs = 0; /** * Number of jobs currently waiting for a build request to finish: * - it increases when a build request is received in #accept_client * (since the client is presumably waiting for the reply), * - it decreases when a reply is sent in #complete_request. */ static int waiting_jobs = 0; /** * Global counter used to produce increasing job numbers. * @see jobs */ static int job_counter = 0; /** * Socket on which the server listens for client request. */ static socket_t socket_fd; /** * Whether the request of an original client failed. */ static bool build_failure; #ifndef WINDOWS /** * Name of the server socket in the file system. */ static char *socket_name; #endif /** * Name of the first target of the first specific rule, used for default run. */ static std::string first_target; /** * Whether a short message should be displayed for each target. */ static bool show_targets = true; /** * Whether script commands are echoed. */ static bool echo_scripts = false; /** * Time at the start of the program. */ static time_t now = time(NULL); /** * Directory with respect to which command-line names are relative. */ static std::string working_dir; /** * Directory with respect to which targets are relative. */ static std::string prefix_dir; /** * Whether the prefix directory is different from #working_dir. */ static bool changed_prefix_dir; /** * Whether target-specific variables are propagated to prerequisites. */ static bool propagate_vars = false; /** * Whether targets are unconditionally obsolete. */ static bool obsolete_targets = false; #ifndef WINDOWS static sigset_t old_sigmask; static volatile sig_atomic_t got_SIGCHLD = 0; static void sigchld_handler(int) { got_SIGCHLD = 1; } static void sigint_handler(int) { // Child processes will receive the signal too, so just prevent // new jobs from starting and wait for the running jobs to fail. keep_going = false; } #endif struct log { bool active, open; int depth; log(): active(false), open(false), depth(0) { } std::ostream &operator()() { if (open) std::cerr << std::endl; assert(depth >= 0); std::cerr << std::string(depth * 2, ' '); open = false; return std::cerr; } std::ostream &operator()(bool o) { if (o && open) std::cerr << std::endl; if (!o) --depth; assert(depth >= 0); if (o || !open) std::cerr << std::string(depth * 2, ' '); if (o) ++depth; open = o; return std::cerr; } }; static struct log debug; struct log_auto_close { bool still_open; log_auto_close(): still_open(true) { } ~log_auto_close() { if (debug.active && still_open) debug(false) << "done\n"; } }; #define DEBUG if (debug.active) debug() #define DEBUG_open log_auto_close auto_close; if (debug.active) debug(true) #define DEBUG_close if ((auto_close.still_open = false), debug.active) debug(false) /** * Strong typedef for strings that need escaping. * @note The string is stored as a reference, so the constructed object is * meant to be immediately consumed. */ struct escape_string { std::string const &input; escape_string(std::string const &s): input(s) {} }; /** * Write the string in @a se to @a out if it does not contain any special * characters, a quoted and escaped string otherwise. */ static std::ostream &operator<<(std::ostream &out, escape_string const &se) { std::string const &s = se.input; char const *quoted_char = ",: '"; char const *escaped_char = "\"\\$!"; bool need_quotes = false; char *buf = NULL; size_t len = s.length(), last = 0, j = 0; for (size_t i = 0; i < len; ++i) { if (strchr(escaped_char, s[i])) { need_quotes = true; if (!buf) buf = new char[len * 2]; memcpy(&buf[j], &s[last], i - last); j += i - last; buf[j++] = '\\'; buf[j++] = s[i]; last = i + 1; } if (!need_quotes && strchr(quoted_char, s[i])) need_quotes = true; } if (!need_quotes) return out << s; out << '"'; if (!buf) return out << s << '"'; out.write(buf, j); out.write(&s[last], len - last); delete[] buf; return out << '"'; } /** * @defgroup paths Path helpers * * @{ */ /** * Initialize #working_dir. */ static void init_working_dir() { char buf[1024]; char *res = getcwd(buf, sizeof(buf)); if (!res) { perror("Failed to get working directory"); exit(EXIT_FAILURE); } working_dir = buf; #ifdef WINDOWS for (size_t i = 0, l = working_dir.size(); i != l; ++i) { if (working_dir[i] == '\\') working_dir[i] = '/'; } #endif prefix_dir = working_dir; } /** * Initialize #prefix_dir and switch to it. */ static void init_prefix_dir() { for (;;) { struct stat s; if (stat((prefix_dir + "/Remakefile").c_str(), &s) == 0) { if (!changed_prefix_dir) return; if (chdir(prefix_dir.c_str())) { perror("Failed to change working directory"); exit(EXIT_FAILURE); } if (show_targets) { std::cout << "remake: Entering directory `" << prefix_dir << '\'' << std::endl; } return; } size_t pos = prefix_dir.find_last_of('/'); if (pos == std::string::npos) { std::cerr << "Failed to locate Remakefile in the current directory or one of its parents" << std::endl; exit(EXIT_FAILURE); } prefix_dir.erase(pos); changed_prefix_dir = true; } } /** * Normalize an absolute path with respect to @a p. * Paths outside the subtree are left unchanged. */ static std::string normalize_abs(std::string const &s, std::string const &p) { size_t l = p.length(); if (s.compare(0, l, p)) return s; size_t ll = s.length(); if (ll == l) return "."; if (s[l] != '/') { size_t pos = s.rfind('/', l); assert(pos != std::string::npos); return s.substr(pos + 1); } if (ll == l + 1) return "."; return s.substr(l + 1); } /** * Normalize path @a s (possibly relative to @a w) with respect to @a p. * * - If both @a p and @a w are empty, the function just removes ".", "..", "//". * - If only @a p is empty, the function returns an absolute path. */ static std::string normalize(std::string const &s, std::string const &w, std::string const &p) { #ifdef WINDOWS char const *delim = "/\\"; #else char delim = '/'; #endif size_t pos = s.find_first_of(delim); if (pos == std::string::npos && w == p) return s; bool absolute = pos == 0; if (!absolute && w != p && !w.empty()) return normalize(w + '/' + s, w, p); size_t prev = 0, len = s.length(); string_list l; for (;;) { if (pos != prev) { std::string n = s.substr(prev, pos - prev); if (n == "..") { if (!l.empty()) l.pop_back(); else if (!absolute && !w.empty()) return normalize(w + '/' + s, w, p); } else if (n != ".") l.push_back(n); } ++pos; if (pos >= len) break; prev = pos; pos = s.find_first_of(delim, prev); if (pos == std::string::npos) pos = len; } string_list::const_iterator i = l.begin(), i_end = l.end(); if (i == i_end) return absolute ? "/" : "."; std::string n; if (absolute) n.push_back('/'); n.append(*i); for (++i; i != i_end; ++i) { n.push_back('/'); n.append(*i); } if (absolute && !p.empty()) return normalize_abs(n, p); return n; } /** * Normalize the content of a list of targets. */ static void normalize_list(string_list &l, std::string const &w, std::string const &p) { for (string_list::iterator i = l.begin(), i_end = l.end(); i != i_end; ++i) { *i = normalize(*i, w, p); } } /** @} */ /** * @defgroup lexer Lexer * * @{ */ /** * Skip spaces. */ static void skip_spaces(std::istream &in) { char c; while (strchr(" \t", (c = in.get()))) {} if (in.good()) in.putback(c); } /** * Skip empty lines. */ static void skip_empty(std::istream &in) { char c; while (strchr("\r\n", (c = in.get()))) {} if (in.good()) in.putback(c); } /** * Skip end of line. If @a multi is true, skip the following empty lines too. * @return true if there was a line to end. */ static bool skip_eol(std::istream &in, bool multi = false) { char c = in.get(); if (c == '\r') c = in.get(); if (c != '\n' && in.good()) in.putback(c); if (c != '\n' && !in.eof()) return false; if (multi) skip_empty(in); return true; } enum { Unexpected = 0, Word = 1 << 1, Colon = 1 << 2, Equal = 1 << 3, Dollarpar = 1 << 4, Rightpar = 1 << 5, Comma = 1 << 6, Plusequal = 1 << 7, Pipe = 1 << 8, }; /** * Skip spaces and peek at the next token. * If it is one of @a mask, skip it (if it is not Word) and return it. * @note For composite tokens allowed by @a mask, input characters might * have been eaten even for an Unexpected result. */ static int expect_token(std::istream &in, int mask) { while (true) { skip_spaces(in); char c = in.peek(); if (!in.good()) return Unexpected; int tok; switch (c) { case '\r': case '\n': return Unexpected; case ':': tok = Colon; break; case ',': tok = Comma; break; case '=': tok = Equal; break; case ')': tok = Rightpar; break; case '|': tok = Pipe; break; case '$': if (!(mask & Dollarpar)) return Unexpected; in.ignore(1); tok = Dollarpar; if (in.peek() != '(') return Unexpected; break; case '+': if (!(mask & Plusequal)) return Unexpected; in.ignore(1); tok = Plusequal; if (in.peek() != '=') return Unexpected; break; case '\\': in.ignore(1); if (skip_eol(in)) continue; in.putback('\\'); return mask & Word ? Word : Unexpected; default: return mask & Word ? Word : Unexpected; } if (!(tok & mask)) return Unexpected; in.ignore(1); return tok; } } /** * Read a (possibly quoted) word. */ static std::string read_word(std::istream &in, bool detect_equal = true) { int c = in.peek(); std::string res; if (!in.good()) return res; char const *separators = " \t\r\n$(),:"; bool quoted = c == '"'; if (quoted) in.ignore(1); bool plus = false; while (true) { c = in.peek(); if (!in.good()) return res; if (quoted) { in.ignore(1); if (c == '\\') res += in.get(); else if (c == '"') quoted = false; else res += c; continue; } if (detect_equal && c == '=') { if (plus) in.putback('+'); return res; } if (plus) { res += '+'; plus = false; } if (strchr(separators, c)) return res; in.ignore(1); if (detect_equal && c == '+') plus = true; else res += c; } } /** @} */ /** * @defgroup stream Token streams * * @{ */ /** * Possible results from word producers. */ enum input_status { Success, SyntaxError, Eof }; /** * Interface for word producers. */ struct generator { virtual ~generator() {} virtual input_status next(std::string &) = 0; }; /** * Generator for the words of a variable. */ struct variable_generator: generator { std::string name; string_list::const_iterator vcur, vend; variable_generator(std::string const &, variable_map const *); input_status next(std::string &); }; variable_generator::variable_generator(std::string const &n, variable_map const *local_variables): name(n) { if (local_variables) { variable_map::const_iterator i = local_variables->find(name); if (i != local_variables->end()) { vcur = i->second.begin(); vend = i->second.end(); return; } } variable_map::const_iterator i = variables.find(name); if (i == variables.end()) return; vcur = i->second.begin(); vend = i->second.end(); } input_status variable_generator::next(std::string &res) { if (vcur != vend) { res = *vcur; ++vcur; return Success; } return Eof; } /** * Generator for the words of an input stream. */ struct input_generator { std::istream ∈ generator *nested; variable_map const *local_variables; bool earliest_exit, done; input_generator(std::istream &i, variable_map const *lv, bool e = false) : in(i), nested(NULL), local_variables(lv), earliest_exit(e), done(false) {} input_status next(std::string &); ~input_generator() { assert(!nested); } }; static generator *get_function(input_generator const &, std::string const &); input_status input_generator::next(std::string &res) { if (nested) { restart: input_status s = nested->next(res); if (s == Success) return Success; delete nested; nested = NULL; if (s == SyntaxError) return SyntaxError; } if (done) return Eof; if (earliest_exit) done = true; switch (expect_token(in, Word | Dollarpar)) { case Word: res = read_word(in, false); return Success; case Dollarpar: { std::string name = read_word(in, false); if (name.empty()) return SyntaxError; if (expect_token(in, Rightpar)) nested = new variable_generator(name, local_variables); else { nested = get_function(*this, name); if (!nested) return SyntaxError; } goto restart; } default: return Eof; } } /** * Read a list of words from an input generator. * @return false if a syntax error was encountered. */ static bool read_words(input_generator &in, string_list &res) { while (true) { res.push_back(std::string()); input_status s = in.next(res.back()); if (s == Success) continue; res.pop_back(); return s == Eof; } } static bool read_words(std::istream &in, string_list &res) { input_generator gen(in, NULL); return read_words(gen, res); } /** * Generator for the result of function addprefix. */ struct addprefix_generator: generator { input_generator gen; string_list pre; string_list::const_iterator prei; size_t prej, prel; std::string suf; addprefix_generator(input_generator const &, bool &); input_status next(std::string &); }; addprefix_generator::addprefix_generator(input_generator const &top, bool &ok) : gen(top.in, top.local_variables) { if (!read_words(gen, pre)) return; if (!expect_token(gen.in, Comma)) return; prej = 0; prel = pre.size(); ok = true; } input_status addprefix_generator::next(std::string &res) { if (prej) { produce: if (prej == prel) { res = *prei + suf; prej = 0; } else { res = *prei++; ++prej; } return Success; } switch (gen.next(res)) { case Success: if (!prel) return Success; prei = pre.begin(); prej = 1; suf = res; goto produce; case Eof: return expect_token(gen.in, Rightpar) ? Eof : SyntaxError; default: return SyntaxError; } } /** * Generator for the result of function addsuffix. */ struct addsuffix_generator: generator { input_generator gen; string_list suf; string_list::const_iterator sufi; size_t sufj, sufl; std::string pre; addsuffix_generator(input_generator const &, bool &); input_status next(std::string &); }; addsuffix_generator::addsuffix_generator(input_generator const &top, bool &ok) : gen(top.in, top.local_variables) { if (!read_words(gen, suf)) return; if (!expect_token(gen.in, Comma)) return; sufj = 0; sufl = suf.size(); ok = true; } input_status addsuffix_generator::next(std::string &res) { if (sufj) { if (sufj != sufl) { res = *sufi++; ++sufj; return Success; } sufj = 0; } switch (gen.next(res)) { case Success: if (!sufl) return Success; sufi = suf.begin(); sufj = 1; res += *sufi++; return Success; case Eof: return expect_token(gen.in, Rightpar) ? Eof : SyntaxError; default: return SyntaxError; } } /** * Return a generator for function @a name. */ static generator *get_function(input_generator const &in, std::string const &name) { skip_spaces(in.in); generator *g = NULL; bool ok = false; if (name == "addprefix") g = new addprefix_generator(in, ok); else if (name == "addsuffix") g = new addsuffix_generator(in, ok); if (!g || ok) return g; delete g; return NULL; } /** @} */ /** * @defgroup database Dependency database * * @{ */ /** * Load dependencies from @a in. */ static void load_dependencies(std::istream &in) { if (false) { error: std::cerr << "Failed to load database" << std::endl; exit(EXIT_FAILURE); } while (!in.eof()) { string_list targets; if (!read_words(in, targets)) goto error; if (in.eof()) return; if (targets.empty()) goto error; DEBUG << "reading dependencies of target " << targets.front() << std::endl; if (in.get() != ':') goto error; ref_ptr dep; dep->targets = targets; string_list deps; if (!read_words(in, deps)) goto error; dep->deps.insert(deps.begin(), deps.end()); for (string_list::const_iterator i = targets.begin(), i_end = targets.end(); i != i_end; ++i) { dependencies[*i] = dep; } skip_empty(in); } } /** * Load known dependencies from file `.remake`. */ static void load_dependencies() { DEBUG_open << "Loading database... "; std::ifstream in(".remake"); if (!in.good()) { DEBUG_close << "not found\n"; return; } load_dependencies(in); } /** * Save all the dependencies in file `.remake`. */ static void save_dependencies() { DEBUG_open << "Saving database... "; std::ofstream db(".remake"); while (!dependencies.empty()) { ref_ptr dep = dependencies.begin()->second; for (string_list::const_iterator i = dep->targets.begin(), i_end = dep->targets.end(); i != i_end; ++i) { db << escape_string(*i) << ' '; dependencies.erase(*i); } db << ':'; for (string_set::const_iterator i = dep->deps.begin(), i_end = dep->deps.end(); i != i_end; ++i) { db << ' ' << escape_string(*i); } db << std::endl; } } /** @} */ static void merge_rule(rule_t &dest, rule_t const &src); static void instantiate_rule(std::string const &target, rule_t const &src, rule_t &dst); /** * @defgroup parser Rule parser * * @{ */ /** * Register a specific rule with an empty script: * * - Check that none of the targets already has an associated rule with a * nonempty script. * - Create a new rule with a single target for each target, if needed. * - Add the prerequisites of @a rule to all these associated rules. */ static void register_transparent_rule(rule_t const &rule, string_list const &targets) { assert(rule.script.empty()); for (string_list::const_iterator i = targets.begin(), i_end = targets.end(); i != i_end; ++i) { std::pair j = specific_rules.insert(std::make_pair(*i, ref_ptr())); ref_ptr &r = j.first->second; if (j.second) { r = ref_ptr(rule); r->targets = string_list(1, *i); continue; } if (!r->script.empty()) { std::cerr << "Failed to load rules: " << *i << " cannot be the target of several rules" << std::endl; exit(EXIT_FAILURE); } assert(r->targets.size() == 1 && r->targets.front() == *i); merge_rule(*r, rule); } for (string_list::const_iterator i = targets.begin(), i_end = targets.end(); i != i_end; ++i) { ref_ptr &dep = dependencies[*i]; if (dep->targets.empty()) dep->targets.push_back(*i); dep->deps.insert(rule.deps.begin(), rule.deps.end()); } } /** * Register a specific rule with a nonempty script: * * - Check that none of the targets already has an associated rule. * - Create a single shared rule and associate it to all the targets. * - Merge the prerequisites of all the targets into a single set and * add the prerequisites of the rule to it. (The preexisting * prerequisites, if any, come from a previous run.) */ static void register_scripted_rule(rule_t const &rule) { ref_ptr r(rule); for (string_list::const_iterator i = rule.targets.begin(), i_end = rule.targets.end(); i != i_end; ++i) { std::pair j = specific_rules.insert(std::make_pair(*i, r)); if (j.second) continue; std::cerr << "Failed to load rules: " << *i << " cannot be the target of several rules" << std::endl; exit(EXIT_FAILURE); } ref_ptr dep; dep->targets = rule.targets; dep->deps.insert(rule.deps.begin(), rule.deps.end()); for (string_list::const_iterator i = rule.targets.begin(), i_end = rule.targets.end(); i != i_end; ++i) { ref_ptr &d = dependencies[*i]; dep->deps.insert(d->deps.begin(), d->deps.end()); d = dep; } } /** * Register a specific rule. */ static void register_rule(rule_t const &rule) { if (!rule.script.empty()) { register_scripted_rule(rule); } else { // Swap away the targets to avoid costly copies when registering. rule_t &r = const_cast(rule); string_list targets; targets.swap(r.targets); register_transparent_rule(r, targets); targets.swap(r.targets); } // If there is no default target yet, mark it as such. if (first_target.empty()) first_target = rule.targets.front(); } /** * Read a rule starting with target @a first, if nonempty. * Store into #generic_rules or #specific_rules depending on its genericity. */ static void load_rule(std::istream &in, std::string const &first) { DEBUG_open << "Reading rule for target " << first << "... "; if (false) { error: DEBUG_close << "failed\n"; std::cerr << "Failed to load rules: syntax error" << std::endl; exit(EXIT_FAILURE); } // Read targets and check genericity. string_list targets; if (!read_words(in, targets)) goto error; if (!first.empty()) targets.push_front(first); else if (targets.empty()) goto error; else DEBUG << "actual target: " << targets.front() << std::endl; bool generic = false; normalize_list(targets, "", ""); for (string_list::const_iterator i = targets.begin(), i_end = targets.end(); i != i_end; ++i) { if (i->empty()) goto error; if ((i->find('%') != std::string::npos) != generic) { if (i == targets.begin()) generic = true; else goto error; } } skip_spaces(in); if (in.get() != ':') goto error; bool assignment = false, static_pattern = false; rule_t rule; rule.targets.swap(targets); // Read dependencies. { string_list v; if (expect_token(in, Word)) { std::string d = read_word(in); if (int tok = expect_token(in, Equal | Plusequal)) { if (!read_words(in, v)) goto error; assign_t &a = rule.assigns[d]; a.append = tok == Plusequal; a.value.swap(v); assignment = true; goto end_line; } v.push_back(d); } if (!read_words(in, v)) goto error; normalize_list(v, "", ""); rule.deps.swap(v); if (expect_token(in, Colon)) { if (!read_words(in, v)) goto error; normalize_list(v, "", ""); targets.swap(rule.targets); rule.targets.swap(rule.deps); rule.deps.swap(v); if (rule.targets.empty()) goto error; for (string_list::const_iterator i = rule.targets.begin(), i_end = rule.targets.end(); i != i_end; ++i) { if (i->find('%') == std::string::npos) goto error; } generic = false; static_pattern = true; } if (expect_token(in, Pipe)) { if (!read_words(in, v)) goto error; normalize_list(v, "", ""); rule.wdeps.swap(v); } } end_line: skip_spaces(in); if (!skip_eol(in, true)) goto error; // Read script. std::ostringstream buf; while (true) { char c = in.get(); if (!in.good()) break; if (c == '\t' || c == ' ') { in.get(*buf.rdbuf()); if (in.fail() && !in.eof()) in.clear(); } else if (c == '\r' || c == '\n') buf << c; else { in.putback(c); break; } } rule.script = buf.str(); // Register phony targets. if (rule.targets.front() == ".PHONY") { for (string_list::const_iterator i = rule.deps.begin(), i_end = rule.deps.end(); i != i_end; ++i) { status[*i].status = Todo; } return; } // Add generic rules to the correct set. if (generic) { if (assignment) goto error; generic_rules.push_back(rule); return; } if (!static_pattern) { if (!rule.script.empty() && assignment) goto error; register_rule(rule); return; } for (string_list::const_iterator i = targets.begin(), i_end = targets.end(); i != i_end; ++i) { rule_t r; instantiate_rule(*i, rule, r); if (!r.stem.empty()) register_rule(r); } } /** * Load rules from @a remakefile. * If some rules have dependencies and non-generic targets, add these * dependencies to the targets. */ static void load_rules(std::string const &remakefile) { DEBUG_open << "Loading rules... "; if (false) { error: std::cerr << "Failed to load rules: syntax error" << std::endl; exit(EXIT_FAILURE); } std::ifstream in(remakefile.c_str()); if (!in.good()) { std::cerr << "Failed to load rules: no Remakefile found" << std::endl; exit(EXIT_FAILURE); } skip_empty(in); string_list options; // Read rules while (in.good()) { char c = in.peek(); if (c == '#') { while (in.get() != '\n') {} skip_empty(in); continue; } if (c == ' ' || c == '\t') goto error; if (expect_token(in, Word)) { std::string name = read_word(in); if (name.empty()) goto error; if (int tok = expect_token(in, Equal | Plusequal)) { DEBUG << "Assignment to variable " << name << std::endl; string_list value; if (!read_words(in, value)) goto error; string_list &dest = *(name == ".OPTIONS" ? &options : &variables[name]); if (tok == Equal) dest.swap(value); else dest.splice(dest.end(), value); if (!skip_eol(in, true)) goto error; } else load_rule(in, name); } else load_rule(in, std::string()); } // Set actual options. for (string_list::const_iterator i = options.begin(), i_end = options.end(); i != i_end; ++i) { if (*i == "variable-propagation") propagate_vars = true; else { std::cerr << "Failed to load rules: unrecognized option" << std::endl; exit(EXIT_FAILURE); } } } /** @} */ /** * @defgroup rules Rule resolution * * @{ */ static void merge_rule(rule_t &dest, rule_t const &src) { dest.deps.insert(dest.deps.end(), src.deps.begin(), src.deps.end()); dest.wdeps.insert(dest.wdeps.end(), src.wdeps.begin(), src.wdeps.end()); for (assign_map::const_iterator i = src.assigns.begin(), i_end = src.assigns.end(); i != i_end; ++i) { if (!i->second.append) { new_assign: dest.assigns[i->first] = i->second; continue; } assign_map::iterator j = dest.assigns.find(i->first); if (j == dest.assigns.end()) goto new_assign; j->second.value.insert(j->second.value.end(), i->second.value.begin(), i->second.value.end()); } } /** * Substitute a pattern into a list of strings. */ static void substitute_pattern(std::string const &pat, string_list const &src, string_list &dst) { for (string_list::const_iterator i = src.begin(), i_end = src.end(); i != i_end; ++i) { size_t pos = i->find('%'); if (pos == std::string::npos) dst.push_back(*i); else dst.push_back(i->substr(0, pos) + pat + i->substr(pos + 1)); } } /** * Instantiate a specific rule, given a target and a generic rule. * If the rule @a dst already contains a stem longer than the one found, * it is left unchanged. */ static void instantiate_rule(std::string const &target, rule_t const &src, rule_t &dst) { size_t tlen = target.length(), plen = dst.stem.length(); for (string_list::const_iterator j = src.targets.begin(), j_end = src.targets.end(); j != j_end; ++j) { size_t len = j->length(); if (tlen < len) continue; if (plen && plen <= tlen - (len - 1)) continue; size_t pos = j->find('%'); if (pos == std::string::npos) continue; size_t len2 = len - (pos + 1); if (j->compare(0, pos, target, 0, pos) || j->compare(pos + 1, len2, target, tlen - len2, len2)) continue; plen = tlen - (len - 1); dst = rule_t(); dst.stem = target.substr(pos, plen); dst.script = src.script; substitute_pattern(dst.stem, src.targets, dst.targets); substitute_pattern(dst.stem, src.deps, dst.deps); substitute_pattern(dst.stem, src.wdeps, dst.wdeps); break; } } /** * Find a generic rule matching @a target: * - the one leading to shorter matches has priority, * - among equivalent rules, the earliest one has priority. */ static void find_generic_rule(job_t &job, std::string const &target) { for (rule_list::const_iterator i = generic_rules.begin(), i_end = generic_rules.end(); i != i_end; ++i) { instantiate_rule(target, *i, job.rule); } } /** * Find a specific rule matching @a target. Return a generic one otherwise. * If there is both a specific rule with an empty script and a generic rule, the * generic one is returned after adding the dependencies of the specific one. */ static void find_rule(job_t &job, std::string const &target) { rule_map::const_iterator i = specific_rules.find(target), i_end = specific_rules.end(); // If there is a specific rule with a script, return it. if (i != i_end && !i->second->script.empty()) { job.rule = *i->second; return; } find_generic_rule(job, target); // If there is no generic rule, return the specific rule (no script), if any. if (job.rule.targets.empty()) { if (i != i_end) { job.rule = *i->second; return; } } // Optimize the lookup when there is only one target (already looked up). if (job.rule.targets.size() == 1) { if (i == i_end) return; merge_rule(job.rule, *i->second); return; } // Add the dependencies of the specific rules of every target to the // generic rule. If any of those rules has a nonempty script, error out. for (string_list::const_iterator j = job.rule.targets.begin(), j_end = job.rule.targets.end(); j != j_end; ++j) { i = specific_rules.find(*j); if (i == i_end) continue; if (!i->second->script.empty()) return; merge_rule(job.rule, *i->second); } } /** @} */ /** * @defgroup status Target status * * @{ */ /** * Compute and memoize the status of @a target: * - if the file does not exist, the target is obsolete, * - if any dependency is obsolete or younger than the file, it is obsolete, * - otherwise it is up-to-date. * * @note For rules with multiple targets, all the targets share the same * status. (If one is obsolete, they all are.) The second rule above * is modified in that case: the latest target is chosen, not the oldest! */ static status_t const &get_status(std::string const &target) { std::pair i = status.insert(std::make_pair(target, status_t())); status_t &ts = i.first->second; if (!i.second) return ts; DEBUG_open << "Checking status of " << target << "... "; dependency_map::const_iterator j = dependencies.find(target); if (j == dependencies.end()) { struct stat s; if (stat(target.c_str(), &s) != 0) { DEBUG_close << "missing\n"; ts.status = Todo; ts.last = 0; return ts; } DEBUG_close << "up-to-date\n"; ts.status = Uptodate; ts.last = s.st_mtime; return ts; } if (obsolete_targets) { DEBUG_close << "forcefully obsolete\n"; ts.status = Todo; ts.last = 0; return ts; } dependency_t const &dep = *j->second; status_e st = Uptodate; time_t latest = 0; for (string_list::const_iterator k = dep.targets.begin(), k_end = dep.targets.end(); k != k_end; ++k) { struct stat s; if (stat(k->c_str(), &s) != 0) { if (st == Uptodate) DEBUG_close << *k << " missing\n"; s.st_mtime = 0; st = Todo; } status[*k].last = s.st_mtime; if (s.st_mtime > latest) latest = s.st_mtime; } if (st != Uptodate) goto update; for (string_set::const_iterator k = dep.deps.begin(), k_end = dep.deps.end(); k != k_end; ++k) { status_t const &ts_ = get_status(*k); if (latest < ts_.last) { DEBUG_close << "older than " << *k << std::endl; st = Todo; goto update; } if (ts_.status != Uptodate && st != Recheck) { DEBUG << "obsolete dependency " << *k << std::endl; st = Recheck; } } if (st == Uptodate) DEBUG_close << "all siblings up-to-date\n"; update: for (string_list::const_iterator k = dep.targets.begin(), k_end = dep.targets.end(); k != k_end; ++k) { status[*k].status = st; } return ts; } /** * Change the status of @a target to #Remade or #Uptodate depending on whether * its modification time changed. */ static void update_status(std::string const &target) { DEBUG_open << "Rechecking status of " << target << "... "; status_map::iterator i = status.find(target); assert(i != status.end()); status_t &ts = i->second; ts.status = Remade; if (ts.last >= now) { DEBUG_close << "possibly remade\n"; return; } struct stat s; if (stat(target.c_str(), &s) != 0) { DEBUG_close << "missing\n"; ts.last = 0; } else if (s.st_mtime != ts.last) { DEBUG_close << "remade\n"; ts.last = s.st_mtime; } else { DEBUG_close << "unchanged\n"; ts.status = Uptodate; } } /** * Check whether all the prerequisites of @a target ended being up-to-date. */ static bool still_need_rebuild(std::string const &target) { status_map::const_iterator i = status.find(target); assert(i != status.end()); if (i->second.status != RunningRecheck) return true; DEBUG_open << "Rechecking obsoleteness of " << target << "... "; dependency_map::const_iterator j = dependencies.find(target); assert(j != dependencies.end()); dependency_t const &dep = *j->second; for (string_set::const_iterator k = dep.deps.begin(), k_end = dep.deps.end(); k != k_end; ++k) { if (status[*k].status != Uptodate) return true; } for (string_list::const_iterator k = dep.targets.begin(), k_end = dep.targets.end(); k != k_end; ++k) { status[*k].status = Uptodate; } DEBUG_close << "no longer obsolete\n"; return false; } /** @} */ /** * @defgroup server Server * * @{ */ /** * Handle job completion. */ static void complete_job(int job_id, bool success, bool started = true) { DEBUG << "Completing job " << job_id << '\n'; job_map::iterator i = jobs.find(job_id); assert(i != jobs.end()); string_list const &targets = i->second.rule.targets; if (success) { bool show = show_targets && started; if (show) std::cout << "Finished"; for (string_list::const_iterator j = targets.begin(), j_end = targets.end(); j != j_end; ++j) { update_status(*j); if (show) std::cout << ' ' << *j; } if (show) std::cout << std::endl; } else { std::cerr << "Failed to build"; for (string_list::const_iterator j = targets.begin(), j_end = targets.end(); j != j_end; ++j) { std::cerr << ' ' << *j; update_status(*j); status_e &s = status[*j].status; if (s != Uptodate) { DEBUG << "Removing " << *j << '\n'; remove(j->c_str()); } s = Failed; } std::cerr << std::endl; } jobs.erase(i); } /** * Return the script obtained by substituting variables. */ static std::string prepare_script(job_t const &job) { std::string const &s = job.rule.script; std::istringstream in(s); std::ostringstream out; size_t len = s.size(); while (!in.eof()) { size_t pos = in.tellg(), p = s.find('$', pos); if (p == std::string::npos || p == len - 1) p = len; out.write(&s[pos], p - pos); if (p == len) break; ++p; switch (s[p]) { case '$': out << '$'; in.seekg(p + 1); break; case '<': if (!job.rule.deps.empty()) out << job.rule.deps.front(); in.seekg(p + 1); break; case '^': { bool first = true; for (string_list::const_iterator i = job.rule.deps.begin(), i_end = job.rule.deps.end(); i != i_end; ++i) { if (first) first = false; else out << ' '; out << *i; } in.seekg(p + 1); break; } case '@': assert(!job.rule.targets.empty()); out << job.rule.targets.front(); in.seekg(p + 1); break; case '*': out << job.rule.stem; in.seekg(p + 1); break; case '(': { in.seekg(p - 1); bool first = true; input_generator gen(in, &job.vars, true); while (true) { std::string w; input_status s = gen.next(w); if (s == SyntaxError) { // TODO return "false"; } if (s == Eof) break; if (first) first = false; else out << ' '; out << w; } break; } default: // Let dollars followed by an unrecognized character // go through. This differs from Make, which would // use a one-letter variable. out << '$'; in.seekg(p); } } return out.str(); } /** * Execute the script from @a rule. */ static status_e run_script(int job_id, job_t const &job) { ref_ptr dep; dep->targets = job.rule.targets; dep->deps.insert(job.rule.deps.begin(), job.rule.deps.end()); if (show_targets) std::cout << "Building"; for (string_list::const_iterator i = job.rule.targets.begin(), i_end = job.rule.targets.end(); i != i_end; ++i) { dependencies[*i] = dep; if (show_targets) std::cout << ' ' << *i; } if (show_targets) std::cout << std::endl; std::string script = prepare_script(job); std::ostringstream job_id_buf; job_id_buf << job_id; std::string job_id_ = job_id_buf.str(); DEBUG_open << "Starting script for job " << job_id << "... "; if (script.empty()) { DEBUG_close << "no script\n"; complete_job(job_id, true); return Remade; } if (false) { error: DEBUG_close << "failed\n"; complete_job(job_id, false); return Failed; } #ifdef WINDOWS HANDLE pfd[2]; if (false) { error2: CloseHandle(pfd[0]); CloseHandle(pfd[1]); goto error; } if (!CreatePipe(&pfd[0], &pfd[1], NULL, 0)) goto error; if (!SetHandleInformation(pfd[0], HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT)) goto error2; STARTUPINFO si; ZeroMemory(&si, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.hStdError = GetStdHandle(STD_ERROR_HANDLE); si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); si.hStdInput = pfd[0]; si.dwFlags |= STARTF_USESTDHANDLES; PROCESS_INFORMATION pi; ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); if (!SetEnvironmentVariable("REMAKE_JOB_ID", job_id_.c_str())) goto error2; char const *argv = echo_scripts ? "SH.EXE -e -s -v" : "SH.EXE -e -s"; if (!CreateProcess(NULL, (char *)argv, NULL, NULL, true, 0, NULL, NULL, &si, &pi)) { goto error2; } CloseHandle(pi.hThread); DWORD len = script.length(), wlen; if (!WriteFile(pfd[1], script.c_str(), len, &wlen, NULL) || wlen < len) std::cerr << "Unexpected failure while sending script to shell" << std::endl; CloseHandle(pfd[0]); CloseHandle(pfd[1]); ++running_jobs; job_pids[pi.hProcess] = job_id; return Running; #else int pfd[2]; if (false) { error2: close(pfd[0]); close(pfd[1]); goto error; } if (pipe(pfd) == -1) goto error; if (setenv("REMAKE_JOB_ID", job_id_.c_str(), 1)) goto error2; if (pid_t pid = vfork()) { if (pid == -1) goto error2; ssize_t len = script.length(); if (write(pfd[1], script.c_str(), len) < len) std::cerr << "Unexpected failure while sending script to shell" << std::endl; close(pfd[0]); close(pfd[1]); ++running_jobs; job_pids[pid] = job_id; return Running; } // Child process starts here. Notice the use of vfork above. char const *argv[5] = { "sh", "-e", "-s", NULL, NULL }; if (echo_scripts) argv[3] = "-v"; close(pfd[1]); if (pfd[0] != 0) { dup2(pfd[0], 0); close(pfd[0]); } sigprocmask(SIG_SETMASK, &old_sigmask, NULL); execve("/bin/sh", (char **)argv, environ); _exit(EXIT_FAILURE); #endif } /** * Create a job for @a target according to the loaded rules. * Mark all the targets from the rule as running and reset their dependencies. * Inherit variables from @a current, if enabled. * If the rule has dependencies, create a new client to build them just * before @a current, and change @a current so that it points to it. */ static status_e start(std::string const &target, client_list::iterator ¤t) { int job_id = job_counter++; DEBUG_open << "Starting job " << job_id << " for " << target << "... "; job_t &job = jobs[job_id]; find_rule(job, target); if (job.rule.targets.empty()) { status[target].status = Failed; DEBUG_close << "failed\n"; std::cerr << "No rule for building " << target << std::endl; return Failed; } bool has_deps = !job.rule.deps.empty() || !job.rule.wdeps.empty(); status_e st = Running; if (has_deps && status[target].status == Recheck) st = RunningRecheck; for (string_list::const_iterator i = job.rule.targets.begin(), i_end = job.rule.targets.end(); i != i_end; ++i) { status[*i].status = st; } if (propagate_vars) job.vars = current->vars; for (assign_map::const_iterator i = job.rule.assigns.begin(), i_end = job.rule.assigns.end(); i != i_end; ++i) { std::pair k = job.vars.insert(std::make_pair(i->first, string_list())); string_list &v = k.first->second; if (i->second.append) { if (k.second) { variable_map::const_iterator j = variables.find(i->first); if (j != variables.end()) v = j->second; } } else if (!k.second) v.clear(); v.insert(v.end(), i->second.value.begin(), i->second.value.end()); } if (has_deps) { current = clients.insert(current, client_t()); current->job_id = job_id; current->pending = job.rule.deps; current->pending.insert(current->pending.end(), job.rule.wdeps.begin(), job.rule.wdeps.end()); if (propagate_vars) current->vars = job.vars; current->delayed = true; return RunningRecheck; } return run_script(job_id, job); } /** * Send a reply to a client then remove it. * If the client was a dependency client, start the actual script. */ static void complete_request(client_t &client, bool success) { DEBUG_open << "Completing request from client of job " << client.job_id << "... "; if (client.delayed) { assert(client.socket == INVALID_SOCKET); if (success) { job_map::const_iterator i = jobs.find(client.job_id); assert(i != jobs.end()); if (still_need_rebuild(i->second.rule.targets.front())) run_script(client.job_id, i->second); else complete_job(client.job_id, true, false); } else complete_job(client.job_id, false); } else if (client.socket != INVALID_SOCKET) { char res = success ? 1 : 0; send(client.socket, &res, 1, MSG_NOSIGNAL); #ifdef WINDOWS closesocket(client.socket); #else close(client.socket); #endif --waiting_jobs; } if (client.job_id < 0 && !success) build_failure = true; } /** * Return whether there are slots for starting new jobs. */ static bool has_free_slots() { if (max_active_jobs <= 0) return true; return running_jobs - waiting_jobs < max_active_jobs; } /** * Handle client requests: * - check for running targets that have finished, * - start as many pending targets as allowed, * - complete the request if there are neither running nor pending targets * left or if any of them failed. * * @return true if some child processes are still running. * * @post If there are pending requests, at least one child process is running. * * @invariant New free slots cannot appear during a run, since the only way to * decrease #running_jobs is #finalize_job and the only way to * increase #waiting_jobs is #accept_client. None of these functions * are called during a run. So breaking out as soon as there are no * free slots left is fine. */ static bool handle_clients() { DEBUG_open << "Handling client requests... "; restart: bool need_restart = false; for (client_list::iterator i = clients.begin(), i_next = i, i_end = clients.end(); i != i_end; i = i_next) { if (!has_free_slots()) break; ++i_next; DEBUG_open << "Handling client from job " << i->job_id << "... "; // Remove running targets that have finished. for (string_set::iterator j = i->running.begin(), j_next = j, j_end = i->running.end(); j != j_end; j = j_next) { ++j_next; status_map::const_iterator k = status.find(*j); assert(k != status.end()); switch (k->second.status) { case Running: case RunningRecheck: break; case Failed: i->failed = true; if (!keep_going) goto complete; // fallthrough case Uptodate: case Remade: i->running.erase(j); break; case Recheck: case Todo: assert(false); } } // Start pending targets. while (!i->pending.empty()) { std::string target = i->pending.front(); i->pending.pop_front(); switch (get_status(target).status) { case Running: case RunningRecheck: i->running.insert(target); break; case Failed: pending_failed: i->failed = true; if (!keep_going) goto complete; // fallthrough case Uptodate: case Remade: break; case Recheck: case Todo: client_list::iterator j = i; switch (start(target, i)) { case Failed: goto pending_failed; case Running: // A shell was started, check for free slots. j->running.insert(target); if (!has_free_slots()) return true; break; case RunningRecheck: // Switch to the dependency client that was inserted. j->running.insert(target); i_next = j; break; case Remade: // Nothing to run. need_restart = true; break; default: assert(false); } } } // Try to complete the request. // (This might start a new job if it was a dependency client.) if (i->running.empty() || i->failed) { complete: complete_request(*i, !i->failed); DEBUG_close << (i->failed ? "failed\n" : "finished\n"); clients.erase(i); need_restart = true; } } if (running_jobs != waiting_jobs) return true; if (running_jobs == 0 && clients.empty()) return false; if (need_restart) goto restart; // There is a circular dependency. // Try to break it by completing one of the requests. assert(!clients.empty()); std::cerr << "Circular dependency detected" << std::endl; client_list::iterator i = clients.begin(); complete_request(*i, false); clients.erase(i); goto restart; } /** * Create a named unix socket that listens for build requests. Also set * the REMAKE_SOCKET environment variable that will be inherited by all * the job scripts. */ static void create_server() { if (false) { error: perror("Failed to create server"); #ifndef WINDOWS error2: #endif exit(EXIT_FAILURE); } DEBUG_open << "Creating server... "; #ifdef WINDOWS // Prepare a windows socket. struct sockaddr_in socket_addr; socket_addr.sin_family = AF_INET; socket_addr.sin_addr.s_addr = inet_addr("127.0.0.1"); socket_addr.sin_port = 0; // Create and listen to the socket. socket_fd = socket(AF_INET, SOCK_STREAM, 0); if (socket_fd == INVALID_SOCKET) goto error; if (!SetHandleInformation((HANDLE)socket_fd, HANDLE_FLAG_INHERIT, 0)) goto error; if (bind(socket_fd, (struct sockaddr *)&socket_addr, sizeof(sockaddr_in))) goto error; int len = sizeof(sockaddr_in); if (getsockname(socket_fd, (struct sockaddr *)&socket_addr, &len)) goto error; std::ostringstream buf; buf << socket_addr.sin_port; if (!SetEnvironmentVariable("REMAKE_SOCKET", buf.str().c_str())) goto error; if (listen(socket_fd, 1000)) goto error; #else // Set signal handlers for SIGCHLD and SIGINT. // Block SIGCHLD (unblocked during select). sigset_t sigmask; sigemptyset(&sigmask); sigaddset(&sigmask, SIGCHLD); if (sigprocmask(SIG_BLOCK, &sigmask, &old_sigmask) == -1) goto error; struct sigaction sa; sa.sa_flags = 0; sigemptyset(&sa.sa_mask); sa.sa_handler = &sigchld_handler; if (sigaction(SIGCHLD, &sa, NULL) == -1) goto error; sa.sa_handler = &sigint_handler; if (sigaction(SIGINT, &sa, NULL) == -1) goto error; // Prepare a named unix socket in temporary directory. socket_name = tempnam(NULL, "rmk-"); if (!socket_name) goto error2; struct sockaddr_un socket_addr; size_t len = strlen(socket_name); if (len >= sizeof(socket_addr.sun_path) - 1) goto error2; socket_addr.sun_family = AF_UNIX; strcpy(socket_addr.sun_path, socket_name); len += sizeof(socket_addr.sun_family); if (setenv("REMAKE_SOCKET", socket_name, 1)) goto error; // Create and listen to the socket. #ifdef LINUX socket_fd = socket(AF_UNIX, SOCK_STREAM | SOCK_CLOEXEC, 0); if (socket_fd == INVALID_SOCKET) goto error; #else socket_fd = socket(AF_UNIX, SOCK_STREAM, 0); if (socket_fd == INVALID_SOCKET) goto error; if (fcntl(socket_fd, F_SETFD, FD_CLOEXEC) < 0) goto error; #endif if (bind(socket_fd, (struct sockaddr *)&socket_addr, len)) goto error; if (listen(socket_fd, 1000)) goto error; #endif } /** * Accept a connection from a client, get the job it spawned from, * get the targets, and mark them as dependencies of the job targets. */ static void accept_client() { DEBUG_open << "Handling client request... "; // Accept connection. #ifdef WINDOWS socket_t fd = accept(socket_fd, NULL, NULL); if (fd == INVALID_SOCKET) return; if (!SetHandleInformation((HANDLE)fd, HANDLE_FLAG_INHERIT, 0)) { error2: std::cerr << "Unexpected failure while setting connection with client" << std::endl; closesocket(fd); return; } // WSAEventSelect puts sockets into nonblocking mode, so disable it here. u_long nbio = 0; if (ioctlsocket(fd, FIONBIO, &nbio)) goto error2; #elif defined(LINUX) int fd = accept4(socket_fd, NULL, NULL, SOCK_CLOEXEC); if (fd < 0) return; #else int fd = accept(socket_fd, NULL, NULL); if (fd < 0) return; if (fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) return; #endif clients.push_front(client_t()); client_list::iterator proc = clients.begin(); if (false) { error: DEBUG_close << "failed\n"; std::cerr << "Received an ill-formed client message" << std::endl; #ifdef WINDOWS closesocket(fd); #else close(fd); #endif clients.erase(proc); return; } // Receive message. Stop when encountering two nuls in a row. std::vector buf; size_t len = 0; while (len < sizeof(int) + 2 || buf[len - 1] || buf[len - 2]) { buf.resize(len + 1024); ssize_t l = recv(fd, &buf[0] + len, 1024, 0); if (l <= 0) goto error; len += l; } // Parse job that spawned the client. int job_id; memcpy(&job_id, &buf[0], sizeof(int)); proc->socket = fd; proc->job_id = job_id; job_map::const_iterator i = jobs.find(job_id); if (i == jobs.end()) goto error; DEBUG << "receiving request from job " << job_id << std::endl; if (propagate_vars) proc->vars = i->second.vars; // Parse the targets and the variable assignments. // Mark the targets as dependencies of the job targets. dependency_t &dep = *dependencies[i->second.rule.targets.front()]; string_list *last_var = NULL; char const *p = &buf[0] + sizeof(int); while (true) { len = strlen(p); if (len == 0) { ++waiting_jobs; break; } switch (*p) { case 'T': { if (len == 1) goto error; std::string target(p + 1, p + len); DEBUG << "adding dependency " << target << " to job\n"; proc->pending.push_back(target); dep.deps.insert(target); break; } case 'V': { if (len == 1) goto error; std::string var(p + 1, p + len); DEBUG << "adding variable " << var << " to job\n"; last_var = &proc->vars[var]; last_var->clear(); break; } case 'W': { if (!last_var) goto error; last_var->push_back(std::string(p + 1, p + len)); break; } default: goto error; } p += len + 1; } if (!propagate_vars && !proc->vars.empty()) { std::cerr << "Assignments are ignored unless 'variable-propagation' is enabled" << std::endl; proc->vars.clear(); } } /** * Handle child process exit status. */ static void finalize_job(pid_t pid, bool res) { pid_job_map::iterator i = job_pids.find(pid); assert(i != job_pids.end()); int job_id = i->second; job_pids.erase(i); --running_jobs; complete_job(job_id, res); } /** * Loop until all the jobs have finished. * * @post There are no client requests left, not even virtual ones. */ static void server_loop() { while (handle_clients()) { DEBUG_open << "Handling events... "; #ifdef WINDOWS size_t len = job_pids.size() + 1; HANDLE h[len]; int num = 0; for (pid_job_map::const_iterator i = job_pids.begin(), i_end = job_pids.end(); i != i_end; ++i, ++num) { h[num] = i->first; } WSAEVENT aev = WSACreateEvent(); h[num] = aev; WSAEventSelect(socket_fd, aev, FD_ACCEPT); DWORD w = WaitForMultipleObjects(len, h, false, INFINITE); WSAEventSelect(socket_fd, aev, 0); WSACloseEvent(aev); if (len <= w) continue; if (w == len - 1) { accept_client(); continue; } pid_t pid = h[w]; DWORD s = 0; bool res = GetExitCodeProcess(pid, &s) && s == 0; CloseHandle(pid); finalize_job(pid, res); #else sigset_t emptymask; sigemptyset(&emptymask); fd_set fdset; FD_ZERO(&fdset); FD_SET(socket_fd, &fdset); int ret = pselect(socket_fd + 1, &fdset, NULL, NULL, NULL, &emptymask); if (ret > 0 /* && FD_ISSET(socket_fd, &fdset)*/) accept_client(); if (!got_SIGCHLD) continue; got_SIGCHLD = 0; pid_t pid; int status; while ((pid = waitpid(-1, &status, WNOHANG)) > 0) { bool res = WIFEXITED(status) && WEXITSTATUS(status) == 0; finalize_job(pid, res); } #endif } assert(clients.empty()); } /** * Load dependencies and rules, listen to client requests, and loop until * all the requests have completed. * If Remakefile is obsolete, perform a first run with it only, then reload * the rules, and perform a second with the original clients. */ static void server_mode(std::string const &remakefile, string_list const &targets) { load_dependencies(); load_rules(remakefile); create_server(); if (get_status(remakefile).status != Uptodate) { clients.push_back(client_t()); clients.back().pending.push_back(remakefile); server_loop(); if (build_failure) goto early_exit; variables.clear(); specific_rules.clear(); generic_rules.clear(); first_target.clear(); load_rules(remakefile); } clients.push_back(client_t()); if (!targets.empty()) clients.back().pending = targets; else if (!first_target.empty()) clients.back().pending.push_back(first_target); server_loop(); early_exit: close(socket_fd); #ifndef WINDOWS remove(socket_name); free(socket_name); #endif save_dependencies(); if (show_targets && changed_prefix_dir) { std::cout << "remake: Leaving directory `" << prefix_dir << '\'' << std::endl; } exit(build_failure ? EXIT_FAILURE : EXIT_SUCCESS); } /** @} */ /** * @defgroup client Client * * @{ */ /** * Connect to the server @a socket_name, send a request for building @a targets * with some @a variables, and exit with the status returned by the server. */ static void client_mode(char *socket_name, string_list const &targets) { if (false) { error: perror("Failed to send targets to server"); exit(EXIT_FAILURE); } if (targets.empty()) exit(EXIT_SUCCESS); DEBUG_open << "Connecting to server... "; // Connect to server. #ifdef WINDOWS struct sockaddr_in socket_addr; socket_fd = socket(AF_INET, SOCK_STREAM, 0); if (socket_fd == INVALID_SOCKET) goto error; socket_addr.sin_family = AF_INET; socket_addr.sin_addr.s_addr = inet_addr("127.0.0.1"); socket_addr.sin_port = atoi(socket_name); if (connect(socket_fd, (struct sockaddr *)&socket_addr, sizeof(sockaddr_in))) goto error; #else struct sockaddr_un socket_addr; size_t len = strlen(socket_name); if (len >= sizeof(socket_addr.sun_path) - 1) exit(EXIT_FAILURE); socket_fd = socket(AF_UNIX, SOCK_STREAM, 0); if (socket_fd == INVALID_SOCKET) goto error; socket_addr.sun_family = AF_UNIX; strcpy(socket_addr.sun_path, socket_name); if (connect(socket_fd, (struct sockaddr *)&socket_addr, sizeof(socket_addr.sun_family) + len)) goto error; #ifdef MACOSX int set_option = 1; if (setsockopt(socket_fd, SOL_SOCKET, SO_NOSIGPIPE, &set_option, sizeof(set_option))) goto error; #endif #endif // Send current job id. char *id = getenv("REMAKE_JOB_ID"); int job_id = id ? atoi(id) : -1; if (send(socket_fd, (char *)&job_id, sizeof(job_id), MSG_NOSIGNAL) != sizeof(job_id)) goto error; // Send targets. for (string_list::const_iterator i = targets.begin(), i_end = targets.end(); i != i_end; ++i) { DEBUG_open << "Sending target " << *i << "... "; std::string s = 'T' + *i; ssize_t len = s.length() + 1; if (send(socket_fd, s.c_str(), len, MSG_NOSIGNAL) != len) goto error; } // Send variables. for (variable_map::const_iterator i = variables.begin(), i_end = variables.end(); i != i_end; ++i) { DEBUG_open << "Sending variable " << i->first << "... "; std::string s = 'V' + i->first; ssize_t len = s.length() + 1; if (send(socket_fd, s.c_str(), len, MSG_NOSIGNAL) != len) goto error; for (string_list::const_iterator j = i->second.begin(), j_end = i->second.end(); j != j_end; ++j) { std::string s = 'W' + *j; len = s.length() + 1; if (send(socket_fd, s.c_str(), len, MSG_NOSIGNAL) != len) goto error; } } // Send terminating nul and wait for reply. char result = 0; if (send(socket_fd, &result, 1, MSG_NOSIGNAL) != 1) goto error; if (recv(socket_fd, &result, 1, 0) != 1) exit(EXIT_FAILURE); exit(result ? EXIT_SUCCESS : EXIT_FAILURE); } /** @} */ /** * @defgroup ui User interface * * @{ */ /** * Display usage and exit with @a exit_status. */ static void usage(int exit_status) { std::cerr << "Usage: remake [options] [target] ...\n" "Options\n" " -B, --always-make Unconditionally make all targets.\n" " -d Echo script commands.\n" " -d -d Print lots of debugging information.\n" " -f FILE Read FILE as Remakefile.\n" " -h, --help Print this message and exit.\n" " -j[N], --jobs=[N] Allow N jobs at once; infinite jobs with no arg.\n" " -k, --keep-going Keep going when some targets cannot be made.\n" " -r Look up targets from the dependencies on stdin.\n" " -s, --silent, --quiet Do not echo targets.\n"; exit(exit_status); } /** * This program behaves in two different ways. * * - If the environment contains the REMAKE_SOCKET variable, the client * connects to this socket and sends to the server its build targets. * It exits once it receives the server reply. * * - Otherwise, it creates a server that waits for build requests. It * also creates a pseudo-client that requests the targets passed on the * command line. */ int main(int argc, char *argv[]) { std::string remakefile; string_list targets; bool literal_targets = false; bool indirect_targets = false; // Parse command-line arguments. for (int i = 1; i < argc; ++i) { std::string arg = argv[i]; if (arg.empty()) usage(EXIT_FAILURE); if (literal_targets) goto new_target; if (arg == "-h" || arg == "--help") usage(EXIT_SUCCESS); if (arg == "-d") if (echo_scripts) debug.active = true; else echo_scripts = true; else if (arg == "-k" || arg =="--keep-going") keep_going = true; else if (arg == "-s" || arg == "--silent" || arg == "--quiet") show_targets = false; else if (arg == "-r") indirect_targets = true; else if (arg == "-B" || arg == "--always-make") obsolete_targets = true; else if (arg == "-f") { if (++i == argc) usage(EXIT_FAILURE); remakefile = argv[i]; } else if (arg == "--") literal_targets = true; else if (arg.compare(0, 2, "-j") == 0) max_active_jobs = atoi(arg.c_str() + 2); else if (arg.compare(0, 7, "--jobs=") == 0) max_active_jobs = atoi(arg.c_str() + 7); else { if (arg[0] == '-') usage(EXIT_FAILURE); if (arg.find('=') != std::string::npos) { std::istringstream in(arg); std::string name = read_word(in); if (name.empty() || !expect_token(in, Equal)) usage(EXIT_FAILURE); read_words(in, variables[name]); continue; } new_target: targets.push_back(arg); DEBUG << "New target: " << arg << '\n'; } } init_working_dir(); normalize_list(targets, working_dir, working_dir); if (indirect_targets) { load_dependencies(std::cin); string_list l; targets.swap(l); if (l.empty() && !dependencies.empty()) { l.push_back(dependencies.begin()->second->targets.front()); } for (string_list::const_iterator i = l.begin(), i_end = l.end(); i != i_end; ++i) { dependency_map::const_iterator j = dependencies.find(*i); if (j == dependencies.end()) continue; dependency_t const &dep = *j->second; for (string_set::const_iterator k = dep.deps.begin(), k_end = dep.deps.end(); k != k_end; ++k) { targets.push_back(normalize(*k, working_dir, working_dir)); } } dependencies.clear(); } #ifdef WINDOWS WSADATA wsaData; if (WSAStartup(MAKEWORD(2,2), &wsaData)) { std::cerr << "Unexpected failure while initializing Windows Socket" << std::endl; return 1; } #endif // Run as client if REMAKE_SOCKET is present in the environment. if (char *sn = getenv("REMAKE_SOCKET")) client_mode(sn, targets); // Otherwise run as server. if (remakefile.empty()) { remakefile = "Remakefile"; init_prefix_dir(); } normalize_list(targets, working_dir, prefix_dir); server_mode(remakefile, targets); } /** @} */ coquelicot-coquelicot-3.4.1/theories/000077500000000000000000000000001455143432500176635ustar00rootroot00000000000000coquelicot-coquelicot-3.4.1/theories/AutoDerive.v000066400000000000000000001552531455143432500221340ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2017 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Datatypes ssreflect ssrbool. From mathcomp Require Import seq. Require Import Rcomplements Hierarchy Derive RInt RInt_analysis Derive_2d Continuity ElemFct. (** * Reflective tactic for solving goals of the form [derivable_pt_lim] *) Fixpoint Rn n T := match n with | O => T | S n => R -> Rn n T end. Inductive bop := | Eplus | Emult. Inductive uop := | Eopp | Einv | Efct : forall (f f' : R -> R), (forall x, is_derive f x (f' x)) -> uop | Efct' : forall (f f' : R -> R) (df : R -> Prop), (forall x, df x -> is_derive f x (f' x)) -> uop. Inductive expr := | Var : nat -> expr | AppExt : forall k, Rn k R -> seq expr -> expr | AppExtD : forall k, Rn k R -> nat -> seq expr -> expr | App : expr -> expr -> expr | Subst : expr -> expr -> expr | Cst : R -> expr | Binary : bop -> expr -> expr -> expr | Unary : uop -> expr -> expr | Int : expr -> expr -> expr -> expr. Section ExprInduction. Hypothesis P : expr -> Prop. Hypothesis P_Var : forall n, P (Var n). Hypothesis P_AppExt : forall k f le, foldr (fun e acc => P e /\ acc) True le -> P (AppExt k f le). Hypothesis P_AppExtD : forall k f n le, foldr (fun e acc => P e /\ acc) True le -> P (AppExtD k f n le). Hypothesis P_App : forall e1 e2, P e1 -> P e2 -> P (App e1 e2). Hypothesis P_Subst : forall e1 e2, P e1 -> P e2 -> P (Subst e1 e2). Hypothesis P_Cst : forall r, P (Cst r). Hypothesis P_Binary : forall o e1 e2, P e1 -> P e2 -> P (Binary o e1 e2). Hypothesis P_Unary : forall o e, P e -> P (Unary o e). Hypothesis P_Int : forall f e1 e2, P f -> P e1 -> P e2 -> P (Int f e1 e2). Fixpoint expr_ind' (e : expr) : P e := match e return P e with | Var n => P_Var n | AppExt k f le => P_AppExt k f le ((fix expr_ind'' (le : seq expr) : foldr (fun e acc => P e /\ acc) True le := match le return foldr (fun e acc => P e /\ acc) True le with | nil => I | cons h q => conj (expr_ind' h) (expr_ind'' q) end) le) | AppExtD k f n le => P_AppExtD k f n le ((fix expr_ind'' (le : seq expr) : foldr (fun e acc => P e /\ acc) True le := match le return foldr (fun e acc => P e /\ acc) True le with | nil => I | cons h q => conj (expr_ind' h) (expr_ind'' q) end) le) | App e1 e2 => P_App e1 e2 (expr_ind' e1) (expr_ind' e2) | Subst e1 e2 => P_Subst e1 e2 (expr_ind' e1) (expr_ind' e2) | Cst r => P_Cst r | Binary o e1 e2 => P_Binary o e1 e2 (expr_ind' e1) (expr_ind' e2) | Unary o e => P_Unary o e (expr_ind' e) | Int f e1 e2 => P_Int f e1 e2 (expr_ind' f) (expr_ind' e1) (expr_ind' e2) end. End ExprInduction. Fixpoint apply {T} p : Rn p T -> (nat -> R) -> T := match p return Rn p T -> _ -> T with | O => fun (x : T) _ => x | S p => fun (f : Rn (S p) T) g => apply p (f (g p)) g end. Lemma apply_ext : forall T k (f : Rn k T) g1 g2, (forall n, (n < k)%nat -> g1 n = g2 n) -> apply k f g1 = apply k f g2. Proof. intros T k f g1 g2 Hg. revert f. induction k. easy. simpl. intros f. rewrite Hg. apply IHk. intros n Hn. apply Hg. now apply Nat.lt_lt_succ_r. apply Nat.lt_succ_diag_r. Qed. Definition Derive_Rn n (f : Rn n R) p g := Derive (fun x => apply n f (fun i => if ssrnat.eqn i p then x else g i)) (g p). Definition ex_derive_Rn n (f : Rn n R) p g := ex_derive (fun x => apply n f (fun i => if ssrnat.eqn i p then x else g i)) (g p). Fixpoint interp (l : seq R) (e : expr) : R := match e with | Var n => nth R0 l n | AppExt k f le => apply k f (nth 0 (map (interp l) le)) | AppExtD k f n le => Derive_Rn k f n (nth 0 (map (interp l) le)) | App e1 e2 => interp ((interp l e2) :: l) e1 | Subst e1 e2 => interp (set_nth R0 l 0 (interp l e2)) e1 | Cst c => c | Binary o e1 e2 => match o with Eplus => Rplus | Emult => Rmult end (interp l e1) (interp l e2) | Unary o e => match o with Eopp => Ropp | Einv => Rinv | Efct f f' H => f | Efct' f f' df H => f end (interp l e) | Int e1 e2 e3 => RInt (fun x => interp (x :: l) e1) (interp l e2) (interp l e3) end. Inductive domain := | Never : domain | Always : domain | Partial : (R -> Prop) -> expr -> domain | Derivable : nat -> forall k, Rn k R -> seq expr -> domain | Derivable2 : nat -> nat -> forall k, Rn k R -> seq expr -> domain | Continuous : nat -> expr -> domain | Continuous2 : nat -> nat -> expr -> domain | Integrable : expr -> expr -> expr -> domain | ParamIntegrable : nat -> expr -> expr -> expr -> domain | LocallyParamIntegrable : nat -> expr -> expr -> domain | And : seq domain -> domain | Forall : expr -> expr -> domain -> domain | Forone : expr -> domain -> domain | Locally : nat -> domain -> domain | Locally2 : nat -> nat -> domain -> domain | ForallWide : nat -> expr -> expr -> domain -> domain. Section DomainInduction. Hypothesis P : domain -> Prop. Hypothesis P_Never : P Never. Hypothesis P_Always : P Always. Hypothesis P_Partial : forall p e, P (Partial p e). Hypothesis P_Derivable : forall n k f le, P (Derivable n k f le). Hypothesis P_Derivable2 : forall m n k f le, P (Derivable2 m n k f le). Hypothesis P_Continuous : forall n e, P (Continuous n e). Hypothesis P_Continuous2 : forall m n e, P (Continuous2 m n e). Hypothesis P_Integrable : forall f e1 e2, P (Integrable f e1 e2). Hypothesis P_ParamIntegrable : forall n f e1 e2, P (ParamIntegrable n f e1 e2). Hypothesis P_LocallyParamIntegrable : forall n f e, P (LocallyParamIntegrable n f e). Hypothesis P_And : forall ld, foldr (fun d acc => P d /\ acc) True ld -> P (And ld). Hypothesis P_Forall : forall e1 e2 d, P d -> P (Forall e1 e2 d). Hypothesis P_Forone : forall e d, P d -> P (Forone e d). Hypothesis P_Locally : forall n d, P d -> P (Locally n d). Hypothesis P_Locally2 : forall m n d, P d -> P (Locally2 m n d). Hypothesis P_ForallWide : forall n e1 e2 d, P d -> P (ForallWide n e1 e2 d). Fixpoint domain_ind' (d : domain) : P d := match d return P d with | Never => P_Never | Always => P_Always | Partial d e => P_Partial d e | Derivable n k f le => P_Derivable n k f le | Derivable2 m n k f le => P_Derivable2 m n k f le | Continuous n e => P_Continuous n e | Continuous2 m n e => P_Continuous2 m n e | Integrable f e1 e2 => P_Integrable f e1 e2 | ParamIntegrable n f e1 e2 => P_ParamIntegrable n f e1 e2 | LocallyParamIntegrable n f e => P_LocallyParamIntegrable n f e | And ld => P_And ld ((fix domain_ind'' (ld : seq domain) : foldr (fun d acc => P d /\ acc) True ld := match ld return foldr (fun d acc => P d /\ acc) True ld with | nil => I | cons h q => conj (domain_ind' h) (domain_ind'' q) end) ld) | Forall e1 e2 d => P_Forall e1 e2 d (domain_ind' d) | Forone e d => P_Forone e d (domain_ind' d) | Locally n d => P_Locally n d (domain_ind' d) | Locally2 m n d => P_Locally2 m n d (domain_ind' d) | ForallWide n e1 e2 d => P_ForallWide n e1 e2 d (domain_ind' d) end. End DomainInduction. Lemma foldr_prop_nth : forall {T} {P: T -> Prop} d l n, foldr (fun d acc => P d /\ acc) True l -> P d -> P (nth d l n). Proof. intros T P d l n Hl Hd. revert l n Hl. induction l. intros n _. now rewrite nth_nil. intros [|n]. now intros (H,_). intros (_,H). now apply IHl. Qed. Fixpoint interp_domain (l : seq R) (d : domain) : Prop := match d with | Never => False | Always => True | Partial p e => p (interp l e) | Derivable n k f le => ex_derive_Rn k f n (nth 0 (map (interp l) le)) | Derivable2 m n k f le => let le' := map (interp l) le in locally_2d (fun u v => ex_derive_Rn k f m (fun i => if ssrnat.eqn i m then u else if ssrnat.eqn i n then v else nth 0 le' i)) (nth 0 le' m) (nth 0 le' n) /\ continuity_2d_pt (fun u v => Derive_Rn k f m (fun i => if ssrnat.eqn i m then u else if ssrnat.eqn i n then v else nth 0 le' i)) (nth 0 le' m) (nth 0 le' n) | Continuous n f => continuity_pt (fun x => interp (set_nth R0 l n x) f) (nth R0 l n) | Continuous2 m n f => continuity_2d_pt (fun x y => interp (set_nth R0 (set_nth R0 l n y) m x) f) (nth R0 l m) (nth R0 l n) | Integrable f e1 e2 => ex_RInt (fun x => interp (x :: l) f) (interp l e1) (interp l e2) | ParamIntegrable n f e1 e2 => locally (nth R0 l n) (fun y => ex_RInt (fun t => interp (t :: set_nth R0 l n y) f) (interp l e1) (interp l e2)) | LocallyParamIntegrable n f e => let a := interp l e in exists eps : posreal, locally (nth R0 l n) (fun y => ex_RInt (fun t => interp (t :: set_nth R0 l n y) f) (a - eps) (a + eps)) | And ld => foldr (fun d acc => interp_domain l d /\ acc) True ld | Forall e1 e2 s => let a1 := interp l e1 in let a2 := interp l e2 in forall t, Rmin a1 a2 <= t <= Rmax a1 a2 -> interp_domain (t :: l) s | Forone e s => interp_domain (interp l e :: l) s | Locally n s => locally (nth R0 l n) (fun x => interp_domain (set_nth R0 l n x) s) | Locally2 m n s => locally_2d (fun x y => interp_domain (set_nth R0 (set_nth R0 l n y) m x) s) (nth R0 l m) (nth R0 l n) | ForallWide n e1 e2 s => let a1 := interp l e1 in let a2 := interp l e2 in exists d : posreal, forall t u, Rmin a1 a2 - d < t < Rmax a1 a2 + d -> Rabs (u - nth R0 l n) < d -> interp_domain (t :: set_nth R0 l n u) s end. Fixpoint is_const (e : expr) n : bool := match e with | Var v => negb (ssrnat.eqn v n) | AppExt k f le => foldr (fun v acc => andb (is_const v n) acc) true le | AppExtD k f p le => false | App f e => andb (is_const f (S n)) (is_const e n) | Subst f e => andb (orb (ssrnat.eqn n 0) (is_const f n)) (is_const e n) | Cst _ => true | Binary b e1 e2 => andb (is_const e1 n) (is_const e2 n) | Unary u e => is_const e n | Int f e1 e2 => andb (is_const f (S n)) (andb (is_const e1 n) (is_const e2 n)) end. Lemma is_const_correct : forall e n, is_const e n = true -> forall l x1 x2, interp (set_nth 0 l n x1) e = interp (set_nth 0 l n x2) e. Proof. induction e using expr_ind'. (* *) simpl => k Hk l x1 x2. rewrite 2!nth_set_nth /=. now rewrite -ssrnat.eqnE (ssrbool.negbTE Hk). (* *) simpl => n Hc l x1 x2. apply apply_ext. intros m _. revert m. induction le. intros m. now rewrite nth_nil. apply andb_prop in Hc. intros [|m]. simpl. now apply H. simpl. apply IHle. apply H. apply Hc. (* *) easy. (* *) simpl => n. move /ssrbool.andP => [H1 H2] l x1 x2. rewrite (IHe2 n H2 l x1 x2). now apply: (IHe1 (S n) _ (interp (set_nth 0 l n x2) e2 :: l)). (* *) intros n. simpl is_const. move /ssrbool.andP => [H1 H2] l x1 x2. change (interp (set_nth 0 (set_nth 0 l n x1) 0 (interp (set_nth 0 l n x1) e2)) e1 = interp (set_nth 0 (set_nth 0 l n x2) 0 (interp (set_nth 0 l n x2) e2)) e1). move: H1. replace (orb (ssrnat.eqn n 0) (is_const e1 n)) with (orb (ssrnat.eqn n 0) (andb (negb (ssrnat.eqn n 0)) (is_const e1 n))). move /ssrbool.orP => [H1|]. rewrite set_set_nth (set_set_nth 0 l n x2). rewrite -ssrnat.eqnE H1. now rewrite (IHe2 n H2 l x1 x2). move /ssrbool.andP => [H1 H3]. rewrite set_set_nth (set_set_nth 0 l n x2). rewrite -ssrnat.eqnE (ssrbool.negbTE H1). rewrite (IHe2 n H2 l x1 x2). now apply IHe1. now case (ssrnat.eqn n 0). (* *) easy. (* *) simpl => n. move /ssrbool.andP => [H1 H2] l x1 x2. now rewrite (IHe1 n H1 l x1 x2) (IHe2 n H2 l x1 x2). (* *) simpl => n H l x1 x2. now rewrite (IHe n H l x1 x2). (* *) simpl => n. move /ssrbool.andP => [H1]. move /ssrbool.andP => [H2 H3] l x1 x2. rewrite (IHe2 n H2 l x1 x2) (IHe3 n H3 l x1 x2). apply RInt_ext => x _. apply (IHe1 _ H1 (x :: l)). Qed. Lemma nth_map' : forall {T1} x1 {T2} (f : T1 -> T2) n s, nth (f x1) (map f s) n = f (nth x1 s n). Proof. intros T1 x T2 f n s. case (ssrnat.leqP (size s) n) => Hs. rewrite 2?nth_default ?size_map //. now apply nth_map. Qed. Lemma interp_ext : forall l1 l2 e, (forall k, nth 0 l1 k = nth 0 l2 k) -> interp l1 e = interp l2 e. Proof. intros l1 l2 e Hl. revert l1 l2 Hl. induction e using expr_ind'. (* *) now simpl => l1 l2 Hl. (* *) simpl => l1 l2 Hl. apply apply_ext. intros n _. revert n. induction le. easy. simpl in H |- *. destruct H as (Ha,Hb). intros [|n]. simpl. now apply Ha. now apply IHle. (* *) simpl => l1 l2 Hl. unfold Derive_Rn. assert (Hn: forall n, nth 0 (map (interp l1) le) n = nth 0 (map (interp l2) le) n). intros p. rewrite (nth_map' (Cst 0) (interp l1)) (nth_map' (Cst 0) (interp l2)). now apply (foldr_prop_nth _ _ _ H). rewrite Hn. apply Derive_ext => t. apply apply_ext => p Hp. now rewrite Hn. (* *) simpl => l1 l2 Hl. apply IHe1. intros [|k]. now apply IHe2. apply Hl. (* *) intros l1 l2 Hl. rewrite /interp -/interp. apply IHe1 => k. rewrite 2!nth_set_nth /=. case eqtype.eq_op. now apply IHe2. apply Hl. (* *) easy. (* *) simpl => l1 l2 Hl. apply f_equal2. now apply IHe1. now apply IHe2. (* *) simpl => l1 l2 Hl. apply f_equal. now apply IHe. (* *) simpl => l1 l2 Hl. rewrite (IHe2 l1 l2 Hl) (IHe3 l1 l2 Hl). apply RInt_ext => x _. apply IHe1. intros [|k]. easy. apply Hl. Qed. Lemma interp_set_nth : forall n l e, interp (set_nth 0 l n (nth 0 l n)) e = interp l e. Proof. intros n l e. apply interp_ext. intros k. rewrite nth_set_nth /=. case ssrnat.eqnP. intros H. now apply f_equal. easy. Qed. Lemma interp_domain_ext : forall l1 l2 b, (forall k, nth 0 l1 k = nth 0 l2 k) -> interp_domain l1 b -> interp_domain l2 b. Proof. intros l1 l2 b Hl. revert l1 l2 Hl. induction b using domain_ind' ; try easy ; simpl => l1 l2 Hl. (* *) by rewrite (interp_ext _ _ _ Hl). (* *) now rewrite -(eq_map (fun e => interp_ext _ _ e Hl)). (* *) intros Hb. now rewrite -(eq_map (fun e => interp_ext _ _ e Hl)). (* *) rewrite Hl. apply continuity_pt_ext => x. apply interp_ext => k. rewrite 2!nth_set_nth /=. now case eqtype.eq_op. (* *) rewrite 2!Hl. apply continuity_2d_pt_ext => x y. apply interp_ext => k. rewrite 2!nth_set_nth /=. case eqtype.eq_op => //. rewrite 2!nth_set_nth /=. now case eqtype.eq_op. (* *) rewrite 2!(interp_ext _ _ _ Hl). apply ex_RInt_ext. intros x _. apply interp_ext. intros [|k]. easy. apply Hl. (* *) rewrite Hl. apply filter_imp => y. rewrite 2!(interp_ext _ _ _ Hl). apply ex_RInt_ext. intros x _. apply interp_ext. intros [|k]. easy. now rewrite /= 2!nth_set_nth /= Hl. (* *) intros (d,H). exists d. rewrite -Hl. move: H ; apply filter_imp => y. rewrite (interp_ext _ _ _ Hl). apply ex_RInt_ext. intros x _. apply interp_ext. intros [|k]. easy. now rewrite /= 2!nth_set_nth /= Hl. (* *) induction ld. easy. simpl in H |- *. intros (H1,H2). split. apply (proj1 H _ _ Hl H1). now apply IHld. (* *) rewrite 2!(interp_ext _ _ _ Hl). intros H t Ht. apply (IHb (t :: l1)). intros [|k]. easy. apply Hl. now apply H. (* *) apply IHb. intros [|k]. now apply interp_ext. apply Hl. (* *) rewrite Hl. apply filter_imp => y. apply IHb => k. now rewrite 2!nth_set_nth /= Hl. (* *) rewrite 2!Hl. apply locally_2d_impl. apply locally_2d_forall => u v. apply IHb => k. rewrite 2!nth_set_nth /=. case eqtype.eq_op => //. rewrite 2!nth_set_nth /=. now case eqtype.eq_op. (* *) rewrite Hl 2!(interp_ext _ _ _ Hl). intros (d,Hd). exists d => t u Ht Hu. apply: IHb (Hd t u Ht Hu). intros [|k]. easy. now rewrite /= 2!nth_set_nth /= Hl. Qed. Lemma interp_domain_set_nth : forall n l b, interp_domain (set_nth 0 l n (nth 0 l n)) b <-> interp_domain l b. Proof. intros n l b. split ; apply interp_domain_ext => k. rewrite nth_set_nth /=. case ssrnat.eqnP. intros H. now apply f_equal. easy. rewrite nth_set_nth /=. case ssrnat.eqnP. intros H. now apply f_equal. easy. Qed. Definition index_not_const l n := filter (fun v => ~~ is_const (nth (Cst 0) l v) n) (seq.iota 0 (size l)). Lemma uniq_index_not_const : forall n l, uniq (T:=ssrnat_eqType) (index_not_const l n). Proof. intros n l. unfold index_not_const. apply filter_uniq. apply iota_uniq. Qed. Canonical ssrnat_eqType. Lemma index_not_const_correct : forall n l (k : nat), not (in_mem k (mem (index_not_const l n))) -> is_const (nth (Cst 0) l k) n = true. Proof. intros n l k. rewrite /index_not_const (@mem_filter ssrnat_eqType) mem_iota /=. rewrite ssrnat.add0n. case E: ssrnat.leq. case is_const. easy. now elim. intros _. rewrite nth_default //. revert E. rewrite ssrnat.ltnNge. now case ssrnat.leq. Qed. Lemma interp_AppExt_set_nth_not_const : forall k f le l n x, interp (set_nth 0 l n x) (AppExt k f le) = apply k f (foldr (fun v acc i => if ssrnat.eqn i v then interp (set_nth 0 l n x) (nth (Cst 0) le v) else acc i) (nth 0 (map (interp l) le)) (index_not_const le n)). Proof. intros k f le l n x. simpl. apply apply_ext => m _. generalize (index_not_const_correct n le m). induction (index_not_const le n) as [|t s IHs]. simpl => Hp. case (ssrnat.leqP (size le) m) => Hs. rewrite 2?nth_default ?size_map //. rewrite 2?(nth_map (Cst 0)) //. rewrite (is_const_correct _ n _ l x (nth 0 l n)). apply interp_set_nth. now apply Hp. rewrite (@in_cons ssrnat_eqType) /= -ssrnat.eqnE. case E: (ssrnat.eqn m t). intros _. rewrite (ssrnat.eqnP E). case (ssrnat.leqP (size le) t) => Hs. now rewrite 2?nth_default ?size_map. now rewrite (nth_map (Cst 0)). simpl. apply IHs. Qed. Fixpoint D (e : expr) n {struct e} : expr * domain := match e with | Var v => (if ssrnat.eqn v n then Cst 1 else Cst 0, Always) | Cst _ => (Cst 0, Always) | AppExt k f le => let lnc := index_not_const le n in let ld := map (fun e => D e n) le in match lnc with | nil => (Cst 0, Always) | v :: nil => let '(d1,d2) := nth (Cst 0,Never) ld v in (Binary Emult d1 (AppExtD k f v le), And (Derivable v k f le :: d2 :: nil)) | v1 :: v2 :: nil => let '(d1,d2) := nth (Cst 0,Never) ld v1 in let '(d3,d4) := nth (Cst 0,Never) ld v2 in (Binary Eplus (Binary Emult d1 (AppExtD k f v1 le)) (Binary Emult d3 (AppExtD k f v2 le)), And (Derivable2 v1 v2 k f le :: d2 :: Derivable v2 k f le :: d4 :: nil)) | _ => (Cst 0, Never) end | AppExtD k f v le => (Cst 0, Never) | App f e => (Cst 0, Never) | Subst f e => (Cst 0, Never) | Binary b e1 e2 => let '(a1,b1) := D e1 n in let '(a2,b2) := D e2 n in match b, is_const e1 n, is_const e2 n with | Eplus, true, _ => (a2, b2) | Eplus, _, true => (a1, b1) | Eplus, _, _ => (Binary Eplus a1 a2, And (b1::b2::nil)) | Emult, true, _ => (Binary Emult e1 a2, b2) | Emult, _, true => (Binary Emult a1 e2, b1) | Emult, _, _ => (Binary Eplus (Binary Emult a1 e2) (Binary Emult e1 a2), And (b1::b2::nil)) end | Unary u e => let '(a,b) := D e n in match u with | Eopp => (Unary Eopp a, b) | Einv => (Binary Emult (Unary Eopp a) (Unary Einv (Binary Emult e e)), And (b:: (Partial (fun x => x <> 0) e) :: nil)) | Efct f f' H => (Binary Emult a (AppExt 1 f' [:: e]), b) | Efct' f f' df H => (Binary Emult a (AppExt 1 f' [:: e]), And (b :: (Partial df e) :: nil)) end | Int f e1 e2 => let '(a1,b1) := D e1 n in let '(a2,b2) := D e2 n in let '(a3,b3) := D f (S n) in match is_const f (S n), is_const e1 n, is_const e2 n with | true, true, _ => (Binary Emult a2 (App f e2), And (b2::(Integrable f e1 e2)::(Forone e2 (Locally 0 (Continuous 0 f)))::nil)) | true, false, true => (Unary Eopp (Binary Emult a1 (App f e1)), And (b1::(Integrable f e1 e2)::(Forone e1 (Locally 0 (Continuous 0 f)))::nil)) | true, false, false => (Binary Eplus (Binary Emult a2 (App f e2)) (Unary Eopp (Binary Emult a1 (App f e1))), And (b1::b2::(Integrable f e1 e2)::(Forone e1 (Locally 0 (Continuous 0 f)))::(Forone e2 (Locally 0 (Continuous 0 f)))::nil)) | false, true, true => (Int a3 e1 e2, And ((ForallWide n e1 e2 b3)::(Locally n (Integrable f e1 e2)):: (Forall e1 e2 (Continuous2 (S n) 0 a3))::nil)) | false, false, true => (Binary Eplus (Unary Eopp (Binary Emult a1 (App f e1))) (Int a3 e1 e2), And ((Forone e1 (Locally2 (S n) 0 (Continuous2 (S n) 0 a3))):: (Forall e1 e2 (Continuous2 (S n) 0 a3)):: b1::(Forone e1 (Locally 0 (Continuous 0 f))):: ParamIntegrable n f e1 e2::LocallyParamIntegrable n f e1:: ForallWide n e1 e2 b3::nil)) | false, true, false => (Binary Eplus (Binary Emult a2 (App f e2)) (Int a3 e1 e2), And ((Forone e2 (Locally2 (S n) 0 (Continuous2 (S n) 0 a3))):: (Forall e1 e2 (Continuous2 (S n) 0 a3)):: b2::(Forone e2 (Locally 0 (Continuous 0 f))):: ParamIntegrable n f e1 e2::LocallyParamIntegrable n f e2:: ForallWide n e1 e2 b3::nil)) | false, false, false => (Binary Eplus (Binary Eplus (Binary Emult a2 (App f e2)) (Unary Eopp (Binary Emult a1 (App f e1)))) (Int a3 e1 e2), And ((Forone e1 (Locally2 (S n) 0 (Continuous2 (S n) 0 a3))):: (Forone e2 (Locally2 (S n) 0 (Continuous2 (S n) 0 a3))):: (Forall e1 e2 (Continuous2 (S n) 0 a3)):: b1::(Forone e1 (Locally 0 (Continuous 0 f))):: b2::(Forone e2 (Locally 0 (Continuous 0 f))):: ParamIntegrable n f e1 e2::LocallyParamIntegrable n f e1::LocallyParamIntegrable n f e2:: ForallWide n e1 e2 b3::nil)) end end. Lemma D_correct : forall (e : expr) l n, let '(a,b) := D e n in interp_domain l b -> is_derive (fun x => interp (set_nth R0 l n x) e) (nth R0 l n) (interp l a). Proof. induction e using expr_ind'. (* Var *) simpl => l k _. apply is_derive_ext with (fun x => if ssrnat.eqn n k then x else nth 0 l n). intros t. now rewrite nth_set_nth. case ssrnat.eqnP => [H|H]. eapply filterdiff_ext_lin. apply filterdiff_id. simpl => y ; apply sym_eq, Rmult_1_r. eapply filterdiff_ext_lin. apply filterdiff_const. simpl => y ; apply sym_eq, Rmult_0_r. (* AppExt *) simpl D => l n. assert (Dle: forall v n l, let '(a,b) := D (nth (Cst 0) le v) n in interp_domain l b -> is_derive (fun x => interp (set_nth 0 l n x) (nth (Cst 0) le v)) (nth 0 l n) (interp l a)). clear n l. induction le => v n l. rewrite nth_nil /= => _. apply: is_derive_const. simpl in H |- *. destruct v as [|v]. apply H. simpl. now apply IHle. move: (interp_AppExt_set_nth_not_const k f le l n) (uniq_index_not_const n le). case (index_not_const le n) => [|v1 [|v2 [|v3 q]]] /= Hc. (* . *) intros _ _. apply is_derive_ext with (fun x => apply k f (nth 0 (map (interp l) le))). intros t. apply sym_eq. apply Hc. apply: is_derive_const. (* . *) intros _. case (ssrnat.leqP (size le) v1) => Hv1. rewrite nth_default ?size_map //. now intros (_&F&_). rewrite (nth_map (Cst 0)) //. move: (Dle v1 n l). case (D (nth (Cst 0) le v1)) => /= [d1 d2] {} Dle [H1 [H2 _]]. specialize (Dle H2). apply is_derive_ext with (fun x => apply k f (fun i => if ssrnat.eqn i v1 then interp (set_nth 0 l n x) (nth (Cst 0) le v1) else nth 0 (map (interp l) le) i)). intros t. now apply sym_eq. apply: (is_derive_comp (fun x => apply k f (fun i => if ssrnat.eqn i v1 then x else nth 0 (map (interp l) le) i))) Dle. rewrite interp_set_nth. rewrite -(nth_map (Cst 0) 0) //. now apply Derive_correct. (* . *) intros Hv. case (ssrnat.leqP (size le) v1) => Hv1. rewrite nth_default ?size_map //. case (nth (Cst 0, Never) (map (fun e => D e n) le) v2) => [d3 d4]. now intros (_&F&_). rewrite (nth_map (Cst 0)) //. move: (Dle v1 n l). case (D (nth (Cst 0) le v1)) => /= [d1 d2] Dle1. case (ssrnat.leqP (size le) v2) => Hv2. rewrite nth_default ?size_map //. now intros (_&_&_&F&_). rewrite (nth_map (Cst 0)) //. move: (Dle v2 n l). case (D (nth (Cst 0) le v2)) => /= [d3 d4] Dle2 {Dle} [[H1 H2] [H3 [H4 [H5 _]]]]. rewrite Rmult_comm (Rmult_comm (interp l d3) _). specialize (Dle1 H3). specialize (Dle2 H5). set (g u v := apply k f (fun i => if ssrnat.eqn i v1 then u else if ssrnat.eqn i v2 then v else nth 0 (map (interp l) le) i)). apply is_derive_ext with (fun x => g (interp (set_nth 0 l n x) (nth (Cst 0) le v1)) (interp (set_nth 0 l n x) (nth (Cst 0) le v2))). intros t. unfold g. now apply sym_eq. apply is_derive_Reals. apply derivable_pt_lim_comp_2d with (f1 := g). rewrite 2!interp_set_nth. assert (H1': ex_derive_Rn k f v1 (nth 0 (map (interp l) le))). apply locally_2d_singleton in H1. unfold ex_derive_Rn in H1 |- *. rewrite ssrnat.eqnE eqtype.eq_refl in H1. apply: ex_derive_ext H1 => t. apply apply_ext => p Hp. rewrite -ssrnat.eqnE. case E: (ssrnat.eqn p v1) => //. case E': (ssrnat.eqn p v2) => //. now rewrite (ssrnat.eqnP E'). rewrite /Derive_Rn. rewrite -(nth_map (Cst 0) 0 (interp l) Hv1). rewrite -(nth_map (Cst 0) 0 (interp l) Hv2). rewrite -(Derive_ext (fun x => g x (nth 0 (map (interp l) le) v2))). apply filterdiff_differentiable_pt_lim. eapply filterdiff_ext_lin. apply (is_derive_filterdiff g). apply filter_imp with ( 2 := proj1 (locally_2d_locally _ _ _) H1). case => u v H'. unfold g. unfold ex_derive_Rn in H'. rewrite ssrnat.eqnE eqtype.eq_refl in H'. evar_last. apply Derive_correct. apply: ex_derive_ext H' => t. apply apply_ext => p Hp. rewrite -ssrnat.eqnE. now case E: (ssrnat.eqn p v1). simpl ; reflexivity. apply is_derive_ext with (2 := Derive_correct _ _ H4) => t. apply apply_ext => p Hp. case E: (ssrnat.eqn p v1) => //. rewrite (ssrnat.eqnP E). revert Hv. rewrite /in_mem /= ssrnat.eqnE. now rewrite orbF andbT => /negbTE ->. apply continuity_2d_pt_filterlim in H2. apply: continuous_ext H2 => [[u v]]. unfold Derive_Rn. rewrite ssrnat.eqnE eqtype.eq_refl. apply Derive_ext => t. apply apply_ext => p Hp. rewrite -ssrnat.eqnE. now case E: (ssrnat.eqn p v1). intros t ; reflexivity. intros t. apply apply_ext. intros p Hp. case (ssrnat.eqn p v1) => //. case E: (ssrnat.eqn p v2) => //. now rewrite (ssrnat.eqnP E). apply is_derive_Reals, Dle1. apply is_derive_Reals, Dle2. (* . *) easy. (* AppExtD *) simpl => l p []. (* App *) simpl => l n []. (* Subst *) simpl => l n []. (* Cst *) simpl => l n _. apply: is_derive_const. (* Binary *) simpl => l n. specialize (IHe1 l n). specialize (IHe2 l n). destruct (D e1 n) as (a1,b1). destruct (D e2 n) as (a2,b2). case C1: (is_const e1 n). (* . *) assert (H1 := is_const_correct e1 n C1 l). case o ; intros H2. rewrite -(Rplus_0_l (interp l a2)). apply: is_derive_plus. apply is_derive_ext with (fun x => interp (set_nth 0 l n 0) e1). apply H1. apply: is_derive_const. now apply IHe2. simpl. replace (interp l e1 * interp l a2) with (0 * interp (set_nth 0 l n (nth 0 l n)) e2 + interp l e1 * interp l a2) by ring. rewrite -(interp_set_nth n _ e1). apply is_derive_Reals. apply (derivable_pt_lim_mult (fun x => interp (set_nth 0 l n x) e1) (fun x => interp (set_nth 0 l n x) e2)). apply is_derive_Reals. apply is_derive_ext with (fun x => interp (set_nth 0 l n 0) e1). apply H1. apply: is_derive_const. apply is_derive_Reals. now apply IHe2. case C2: (is_const e2 n) => {C1}. (* . *) assert (H2 := is_const_correct e2 n C2 l). case o ; intros H1. rewrite -(Rplus_0_r (interp l a1)). apply: is_derive_plus. now apply IHe1. apply is_derive_ext with (fun x => interp (set_nth 0 l n 0) e2). apply H2. apply: is_derive_const. simpl. replace (interp l a1 * interp l e2) with (interp l a1 * interp l e2 + interp (set_nth 0 l n (nth 0 l n)) e1 * 0) by ring. rewrite -(interp_set_nth n _ e2). apply is_derive_Reals. apply (derivable_pt_lim_mult (fun x => interp (set_nth 0 l n x) e1) (fun x => interp (set_nth 0 l n x) e2)). now apply is_derive_Reals, IHe1. apply is_derive_Reals. apply is_derive_ext with (fun x => interp (set_nth 0 l n 0) e2). apply H2. apply: is_derive_const. (* . *) clear C2. case o ; simpl ; intros (H1&H2&_) ; specialize (IHe1 H1) ; specialize (IHe2 H2). now apply: is_derive_plus. rewrite -(interp_set_nth n _ e1) -(interp_set_nth n _ e2). apply is_derive_Reals. apply (derivable_pt_lim_mult (fun x => interp (set_nth 0 l n x) e1) (fun x => interp (set_nth 0 l n x) e2)) ; now apply is_derive_Reals. (* Unary *) simpl => l n. specialize (IHe l n). destruct (D e n) as (a,b). case o. simpl. intros H. apply: is_derive_opp. now apply IHe. simpl. intros (H,(H0,_)). rewrite -{2}(Rmult_1_r (interp l e)). rewrite -(interp_set_nth n l e) in H0 |-*. apply is_derive_inv. now apply IHe. exact H0. simpl. intros f f' Df H. rewrite -(interp_set_nth n l e). apply: is_derive_comp. apply Df. now apply IHe. simpl. intros f f' df Df (H,(H0,_)). rewrite -(interp_set_nth n l e) in H0 |-*. apply: is_derive_comp. apply Df. exact H0. now apply IHe. (* Int *) simpl => l n. specialize (IHe2 l n). specialize (IHe3 l n). move: (fun l => IHe1 l (S n)) => {} IHe1. destruct (D e1 (S n)) as (a1,b1). destruct (D e2 n) as (a2,b2). destruct (D e3 n) as (a3,b3). (* . *) assert (HexI: forall f x, locally x (fun x => continuity_pt f x) -> exists eps : posreal, ex_RInt f (x - eps) (x + eps)). clear => f x [eps H]. exists (pos_div_2 eps). apply ex_RInt_Reals_1. apply RiemannInt_P6. apply Rplus_lt_compat_l. apply Rle_lt_trans with (2 := cond_pos _). rewrite -Ropp_0. apply Ropp_le_contravar. apply Rlt_le. apply cond_pos. intros u Hu. apply H. apply Rle_lt_trans with (pos_div_2 eps). now apply Rabs_le_between'. rewrite (double_var eps). rewrite -(Rplus_0_r (pos_div_2 eps)). apply Rplus_lt_compat_l. apply (cond_pos (pos_div_2 eps)). (* . *) assert (HexD: ( exists d : posreal, forall t u, Rmin (interp l e2) (interp l e3) - d < t < Rmax (interp l e2) (interp l e3) + d -> Rabs (u - nth 0 l n) < d -> interp_domain (t :: set_nth 0 l n u) b1 ) -> forall t, Rmin (interp l e2) (interp l e3) <= t <= Rmax (interp l e2) (interp l e3) -> locally_2d (fun u v => is_derive (fun x => interp (v :: set_nth 0 l n x) e1) u (interp (v :: set_nth 0 l n u) a1)) (nth 0 l n) t). intros (e,H) t Ht. exists e => /= u v Hu Hv. assert (H': Rmin (interp l e2) (interp l e3) - e < v < Rmax (interp l e2) (interp l e3) + e). apply (Rlt_le_trans _ _ e) in Hv. 2: apply Rle_refl. apply Rabs_lt_between' in Hv. split. apply Rle_lt_trans with (2 := proj1 Hv). now apply Rplus_le_compat_r. apply Rlt_le_trans with (1 := proj2 Hv). now apply Rplus_le_compat_r. move: (IHe1 _ (H v u H' Hu)) => {IHe1} /=. rewrite nth_set_nth /= eqtype.eq_refl. apply is_derive_ext => z. now rewrite set_set_nth /= eqtype.eq_refl. (* . *) assert (Htw: forall e : posreal, forall t, Rmin (interp l e2) (interp l e3) <= t <= Rmax (interp l e2) (interp l e3) -> Rmin (interp l e2) (interp l e3) - e < t < Rmax (interp l e2) (interp l e3) + e). intros e t Ht. split. apply Rlt_le_trans with (2 := proj1 Ht). rewrite -{2}[Rmin _ _]Rplus_0_r -Ropp_0. apply Rplus_lt_compat_l. apply Ropp_lt_contravar. apply cond_pos. apply Rle_lt_trans with (1 := proj2 Ht). rewrite -{1}[Rmax _ _]Rplus_0_r. apply Rplus_lt_compat_l. apply cond_pos. case C1: (is_const e1 (S n)). clear IHe1. case C2: (is_const e2 n). (* . *) simpl. intros (H3&Hi&H1&_). apply is_derive_ext with (comp (fun x => RInt (fun t => interp (t :: l) e1) (interp (set_nth 0 l n (nth 0 l n)) e2) x) (fun x => interp (set_nth 0 l n x) e3)). intros t. unfold comp. rewrite -(is_const_correct e2 n C2 l (nth 0 l n)). apply RInt_ext. intros z _. rewrite -(interp_set_nth (S n)). apply (is_const_correct e1 (S n) C1 (z :: l)). apply: is_derive_comp. rewrite 2!interp_set_nth. apply (is_derive_RInt (fun t : R => interp (t :: l)%SEQ e1) _ (interp l e2)). apply HexI in H1. case: H1 => e He. exists e => /= y Hy. apply: RInt_correct. eapply ex_RInt_Chasles. apply Hi. eapply ex_RInt_Chasles. eapply ex_RInt_Chasles, He. eapply ex_RInt_swap, @ex_RInt_Chasles_1, He. apply Rabs_le_between'. rewrite Rminus_eq_0 Rabs_R0 ; by apply Rlt_le, e. eapply ex_RInt_swap, @ex_RInt_Chasles_2, He. apply Rabs_le_between'. by apply Rlt_le, Hy. now apply continuity_pt_filterlim, locally_singleton. now apply IHe3. clear C2. case C3: (is_const e3 n). (* . *) simpl. intros (H2&Hi&H1&_). rewrite -Ropp_mult_distr_r_reverse. apply is_derive_ext with (fun x => comp (fun x => RInt (fun t => interp (t :: l) e1) x (interp (set_nth 0 l n (nth 0 l n)) e3)) (fun x => interp (set_nth 0 l n x) e2) x). intros t. unfold comp. rewrite -(is_const_correct e3 n C3 l (nth 0 l n)). apply RInt_ext. intros z _. rewrite -(interp_set_nth (S n)). apply (is_const_correct e1 (S n) C1 (z :: l)). apply: (is_derive_comp (fun x0 : R => RInt (fun t : R => interp (t :: l) e1) x0 (interp (set_nth 0 l n (nth 0 l n)) e3)) (fun x0 : R => interp (set_nth 0 l n x0) e2)). rewrite 2!interp_set_nth. apply (is_derive_RInt' (fun t : R => interp (t :: l)%SEQ e1) _ _ (interp l e3)). apply HexI in H1. case: H1 => e He. exists e => /= y Hy. apply: RInt_correct. eapply ex_RInt_Chasles, Hi. eapply ex_RInt_Chasles. eapply ex_RInt_Chasles, He. eapply ex_RInt_swap, @ex_RInt_Chasles_1, He. apply Rabs_le_between'. by apply Rlt_le, Hy. eapply ex_RInt_swap, @ex_RInt_Chasles_2, He. apply Rabs_le_between'. rewrite Rminus_eq_0 Rabs_R0 ; by apply Rlt_le, e. now apply continuity_pt_filterlim, locally_singleton. now apply IHe2. (* . *) clear C3. simpl. intros (H2&H3&Hi&H12&H13&_). apply is_derive_ext with (fun x => RInt (fun t => interp (t :: l) e1) (interp (set_nth 0 l n x) e2) (interp (set_nth 0 l n x) e3)). intros t. apply RInt_ext. intros z _. rewrite -(interp_set_nth (S n)). apply (is_const_correct e1 (S n) C1 (z :: l)). rewrite -(interp_set_nth n l e2) -(interp_set_nth n l e3). evar_last. apply (is_derive_RInt_bound_comp (fun t : R => interp (t :: l)%SEQ e1)). rewrite 2!interp_set_nth. eapply filter_imp. intros x Hx ; simpl. apply: RInt_correct. exact: Hx. apply @ex_RInt_locally => //. now apply HexI. now apply HexI. rewrite interp_set_nth. now apply continuity_pt_filterlim, locally_singleton. rewrite interp_set_nth. now apply continuity_pt_filterlim, locally_singleton. now apply IHe2. now apply IHe3. reflexivity. case C2: (is_const e2 n). clear IHe2. case C3: (is_const e3 n). clear IHe3. (* . *) clear C1. simpl. intros (H3&H2&H4&_). apply is_derive_ext with (fun x => RInt (fun t => interp (t :: set_nth 0 l n x) e1) (interp (set_nth 0 l n (nth 0 l n)) e2) (interp (set_nth 0 l n (nth 0 l n)) e3)). intros t. apply f_equal2. now apply is_const_correct. now apply is_const_correct. rewrite 2!interp_set_nth. destruct H3 as (d,H3). assert (H3': locally (nth R0 l n) (fun x => forall t, Rmin (interp l e2) (interp l e3) <= t <= Rmax (interp l e2) (interp l e3) -> interp_domain (set_nth 0 (t :: l) (S n) x) b1)). exists d => y Hy t Ht. apply H3. split. apply Rlt_le_trans with (2 := proj1 Ht). rewrite -{2}[Rmin _ _]Rplus_0_r -Ropp_0. apply Rplus_lt_compat_l. apply Ropp_lt_contravar. apply cond_pos. apply Rle_lt_trans with (1 := proj2 Ht). rewrite -{1}[Rmax _ _]Rplus_0_r. apply Rplus_lt_compat_l. apply cond_pos. exact Hy. rewrite (RInt_ext (fun x => interp (x :: l) a1) (fun x => Derive (fun t => interp (set_nth 0 (x :: l) (S n) t) e1) (nth 0 (x :: l) (S n)))). apply is_derive_RInt_param. move: H3' ; apply filter_imp => y H3' t Ht. specialize (IHe1 _ (H3' t Ht)). rewrite nth_set_nth /= eqtype.eq_refl in IHe1. exists (interp (set_nth 0 (t :: l) (S n) y) a1). apply is_derive_ext with (f := fun x => interp (set_nth 0 (set_nth 0 (t :: l) (S n) y) (S n) x) e1) (2 := IHe1). intros t'. now rewrite set_set_nth eqtype.eq_refl. intros t Ht. apply continuity_2d_pt_ext_loc with (f := fun x y => interp (set_nth 0 (y :: l) (S n) x) a1). exists d => u v Hu Hv. apply sym_eq. apply is_derive_unique. apply is_derive_ext with (f := fun z => interp (set_nth 0 (set_nth 0 (v :: l) (S n) u) (S n) z) e1). intros z. now rewrite set_set_nth eqtype.eq_refl. pattern u at 2; replace u with (nth 0 (set_nth 0 (v :: l) (S n) u) (S n)). apply IHe1. apply H3. apply Rabs_lt_between' in Hv. split. apply Rle_lt_trans with (2 := proj1 Hv). now apply Rplus_le_compat_r. apply Rlt_le_trans with (1 := proj2 Hv). now apply Rplus_le_compat_r. exact Hu. now rewrite nth_set_nth /= eqtype.eq_refl. now apply H4. move: H2 ; apply filter_imp => y. rewrite (is_const_correct e2 n C2 l y (nth 0 l n)). rewrite (is_const_correct e3 n C3 l y (nth 0 l n)). now rewrite 2!interp_set_nth. intros t Ht. apply sym_eq. apply is_derive_unique. apply locally_singleton in H3'. apply (IHe1 (t :: l)). cut (interp_domain (set_nth 0 (t :: l)%SEQ (S n) (nth 0 l n)) b1). apply (interp_domain_set_nth (S n) (t :: l)). apply H3'. now split ; apply Rlt_le. (* . *) clear C1 C3. simpl. intros (H2&H3&H6&H7&H8&H10&H11&_). rewrite Rplus_comm Rmult_comm. apply is_derive_ext with (fun x => RInt (fun t => interp (t :: set_nth 0 l n x) e1) (interp l e2) (interp (set_nth 0 l n x) e3)). intros x. rewrite (is_const_correct e2 n C2 l x (nth 0 l n)). now rewrite interp_set_nth. rewrite -(RInt_ext (fun x => Derive (fun t => interp (x :: set_nth 0 l n t) e1) (nth 0 l n))). rewrite -(interp_set_nth (S n) (interp l e3 :: l) e1). rewrite -(interp_set_nth n l e3) /=. apply (is_derive_RInt_param_bound_comp_aux3 (fun x t => interp (t :: set_nth 0 l n x) e1) (interp l e2) (fun x => interp (set_nth 0 l n x) e3)). now rewrite interp_set_nth. now rewrite interp_set_nth. now apply IHe3. rewrite interp_set_nth. destruct H11 as (e&H11). exists (pos_div_2 e). exists e => y Hy t Ht. assert (Ht': Rmin (interp l e2) (interp l e3) - e < t < Rmax (interp l e2) (interp l e3) + e). split. apply Rlt_le_trans with (2 := proj1 Ht). apply Rlt_le_trans with (Rmin (interp l e2) (interp l e3) - pos_div_2 e). apply Rplus_lt_compat_l. apply Ropp_lt_contravar. rewrite -(Rplus_0_r (pos_div_2 e)) /= {2}(double_var e). apply Rplus_lt_compat_l. apply is_pos_div_2. rewrite /Rminus Rplus_min_distr_r. apply Rle_min_compat_r. rewrite -{2}[interp l e2]Rplus_0_r -Ropp_0. apply Rplus_le_compat_l. apply Ropp_le_contravar. apply Rlt_le, cond_pos. apply Rle_lt_trans with (1 := proj2 Ht). apply Rle_lt_trans with (Rmax (interp l e2) (interp l e3) + pos_div_2 e). rewrite /Rminus Rplus_max_distr_r. apply Rle_max_compat_r. rewrite -{1}[interp l e2]Rplus_0_r. apply Rplus_le_compat_l. apply Rlt_le, cond_pos. apply Rplus_lt_compat_l. rewrite -(Rplus_0_r (pos_div_2 e)) /= {2}(double_var e). apply Rplus_lt_compat_l. apply is_pos_div_2. eexists. move: (IHe1 _ (H11 t y Ht' Hy)) => {IHe1} /=. rewrite nth_set_nth /= eqtype.eq_refl. apply is_derive_ext => z. now rewrite set_set_nth eqtype.eq_refl. rewrite interp_set_nth. intros t Ht. apply continuity_2d_pt_ext_loc with (f := fun x y => interp (set_nth 0 (y :: l) (S n) x) a1). apply: locally_2d_impl (HexD H11 t Ht). apply locally_2d_forall => u v H. apply sym_eq. now apply is_derive_unique. now apply H3. rewrite interp_set_nth. apply: locally_2d_impl H2. specialize (HexD H11 _ (conj (Rmin_r _ _) (Rmax_r _ _))). apply: locally_2d_impl_strong HexD. apply locally_2d_forall => u v H. rewrite nth_set_nth /= eqtype.eq_refl. apply continuity_2d_pt_ext_loc. apply: locally_2d_impl H. apply locally_2d_forall => u' v' H. apply sym_eq. apply is_derive_unique. now rewrite set_set_nth eqtype.eq_refl. rewrite interp_set_nth. apply locally_singleton in H7. apply: continuity_pt_ext H7. intros t. apply sym_eq. apply (interp_set_nth (S n) (t :: l)). intros t Ht. apply is_derive_unique. apply (IHe1 (t :: l)). destruct H11 as (e,H11). specialize (H11 t (nth 0 l n)). rewrite -(interp_domain_set_nth (S n)) /=. apply H11. apply Htw. now split ; apply Rlt_le. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. case C3: (is_const e3 n). clear IHe3. (* . *) clear C1 C2. simpl. intros (H2&H3&H6&H7&H8&H10&H11&_). rewrite Rplus_comm Rmult_comm -Ropp_mult_distr_l_reverse. apply is_derive_ext with (fun x => RInt (fun t => interp (t :: set_nth 0 l n x) e1) (interp (set_nth 0 l n x) e2) (interp l e3)). intros x. rewrite (is_const_correct e3 n C3 l x (nth 0 l n)). now rewrite interp_set_nth. rewrite -(RInt_ext (fun x => Derive (fun t => interp (x :: set_nth 0 l n t) e1) (nth 0 l n))). rewrite -(interp_set_nth (S n) (interp l e2 :: l) e1). rewrite -(interp_set_nth n l e2) /=. apply (is_derive_RInt_param_bound_comp_aux2 (fun x t => interp (t :: set_nth 0 l n x) e1) (fun x => interp (set_nth 0 l n x) e2) (interp l e3)). now rewrite interp_set_nth. now rewrite interp_set_nth. now apply IHe2. rewrite interp_set_nth. destruct H11 as (e&H11). exists (pos_div_2 e). exists e => y Hy t Ht. assert (Ht': Rmin (interp l e2) (interp l e3) - e < t < Rmax (interp l e2) (interp l e3) + e). split. apply Rlt_le_trans with (2 := proj1 Ht). apply Rlt_le_trans with (Rmin (interp l e2) (interp l e3) - pos_div_2 e). apply Rplus_lt_compat_l. apply Ropp_lt_contravar. rewrite -(Rplus_0_r (pos_div_2 e)) /= {2}(double_var e). apply Rplus_lt_compat_l. apply is_pos_div_2. rewrite /Rminus Rplus_min_distr_r. apply Rle_min_compat_l. rewrite -{2}[interp l e3]Rplus_0_r -Ropp_0. apply Rplus_le_compat_l. apply Ropp_le_contravar. apply Rlt_le, cond_pos. apply Rle_lt_trans with (1 := proj2 Ht). apply Rle_lt_trans with (Rmax (interp l e2) (interp l e3) + pos_div_2 e). rewrite /Rminus Rplus_max_distr_r. apply Rle_max_compat_l. rewrite -{1}[interp l e3]Rplus_0_r. apply Rplus_le_compat_l. apply Rlt_le, cond_pos. apply Rplus_lt_compat_l. rewrite -(Rplus_0_r (pos_div_2 e)) /= {2}(double_var e). apply Rplus_lt_compat_l. apply is_pos_div_2. eexists. move: (IHe1 _ (H11 t y Ht' Hy)) => {IHe1} /=. rewrite nth_set_nth /= eqtype.eq_refl. apply is_derive_ext => z. now rewrite set_set_nth eqtype.eq_refl. rewrite interp_set_nth. intros t Ht. apply continuity_2d_pt_ext_loc with (f := fun x y => interp (set_nth 0 (y :: l) (S n) x) a1). apply: locally_2d_impl (HexD H11 t Ht). apply locally_2d_forall => u v H. apply sym_eq. now apply is_derive_unique. now apply H3. rewrite interp_set_nth. apply: locally_2d_impl H2. specialize (HexD H11 _ (conj (Rmin_l _ _) (Rmax_l _ _))). apply: locally_2d_impl_strong HexD. apply locally_2d_forall => u v H. rewrite nth_set_nth /= eqtype.eq_refl. apply continuity_2d_pt_ext_loc. apply: locally_2d_impl H. apply locally_2d_forall => u' v' H. apply sym_eq. apply is_derive_unique. now rewrite set_set_nth eqtype.eq_refl. rewrite interp_set_nth. apply locally_singleton in H7. apply: continuity_pt_ext H7. intros t. apply sym_eq. apply (interp_set_nth (S n) (t :: l)). intros t Ht. apply is_derive_unique. apply (IHe1 (t :: l)). destruct H11 as (e,H11). specialize (H11 t (nth 0 l n)). rewrite -(interp_domain_set_nth (S n)) /=. apply H11. apply Htw. now split ; apply Rlt_le. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. (* . *) clear C1 C2 C3. simpl. intros (H1&H2&H3&H4&H5&H6&H7&H8&H9&H10&H11&_). rewrite Rplus_comm Rmult_comm (Rmult_comm (interp l a2)) -Ropp_mult_distr_l_reverse. rewrite [_*_+_]Rplus_comm -Rplus_assoc. rewrite -(RInt_ext (fun x => Derive (fun t => interp (x :: set_nth 0 l n t) e1) (nth 0 l n))). rewrite -(interp_set_nth (S n) (interp l e2 :: l) e1) -(interp_set_nth (S n) (interp l e3 :: l) e1). rewrite -(interp_set_nth n l e2) -(interp_set_nth n l e3) /=. apply (is_derive_RInt_param_bound_comp (fun x t => interp (t :: set_nth 0 l n x) e1) (fun x => interp (set_nth 0 l n x) e2) (fun x => interp (set_nth 0 l n x) e3)). rewrite 2!interp_set_nth. exact H8. rewrite interp_set_nth. exact H9. rewrite interp_set_nth. exact H10. now apply IHe2. now apply IHe3. rewrite 2!interp_set_nth. destruct H11 as (e&H11). exists (pos_div_2 e). exists e => y Hy t Ht. assert (Ht': Rmin (interp l e2) (interp l e3) - e < t < Rmax (interp l e2) (interp l e3) + e). split. apply Rlt_le_trans with (2 := proj1 Ht). rewrite /Rminus -Rplus_min_distr_r. apply Rplus_lt_compat_l. apply Ropp_lt_contravar. rewrite -(Rplus_0_r (pos_div_2 e)) /= {2}(double_var e). apply Rplus_lt_compat_l. apply is_pos_div_2. apply Rle_lt_trans with (1 := proj2 Ht). rewrite -Rplus_max_distr_r. apply Rplus_lt_compat_l. rewrite -(Rplus_0_r (pos_div_2 e)) /= {2}(double_var e). apply Rplus_lt_compat_l. apply is_pos_div_2. eexists. move: (IHe1 _ (H11 t y Ht' Hy)) => {IHe1} /=. rewrite nth_set_nth /= eqtype.eq_refl. apply is_derive_ext => z. now rewrite set_set_nth eqtype.eq_refl. rewrite 2!interp_set_nth. intros t Ht. apply continuity_2d_pt_ext_loc with (f := fun x y => interp (set_nth 0 (y :: l) (S n) x) a1). apply: locally_2d_impl (HexD H11 t Ht). apply locally_2d_forall => u v H. apply sym_eq. now apply is_derive_unique. now apply H3. rewrite interp_set_nth. apply: locally_2d_impl H1. specialize (HexD H11 _ (conj (Rmin_l _ _) (Rmax_l _ _))). apply: locally_2d_impl_strong HexD. apply locally_2d_forall => u v H. rewrite nth_set_nth /= eqtype.eq_refl. apply continuity_2d_pt_ext_loc. apply: locally_2d_impl H. apply locally_2d_forall => u' v' H. apply sym_eq. apply is_derive_unique. now rewrite set_set_nth eqtype.eq_refl. rewrite interp_set_nth. apply: locally_2d_impl H2. specialize (HexD H11 _ (conj (Rmin_r _ _) (Rmax_r _ _))). apply: locally_2d_impl_strong HexD. apply locally_2d_forall => u v H. rewrite nth_set_nth /= eqtype.eq_refl. apply continuity_2d_pt_ext_loc. apply: locally_2d_impl H. apply locally_2d_forall => u' v' H. apply sym_eq. apply is_derive_unique. now rewrite set_set_nth eqtype.eq_refl. rewrite interp_set_nth. apply locally_singleton in H5. apply: continuity_pt_ext H5. intros t. apply sym_eq. apply (interp_set_nth (S n) (t :: l)). rewrite interp_set_nth. apply locally_singleton in H7. apply: continuity_pt_ext H7. intros t. apply sym_eq. apply (interp_set_nth (S n) (t :: l)). intros t Ht. apply is_derive_unique. apply (IHe1 (t :: l)). destruct H11 as (e,H11). specialize (H11 t (nth 0 l n)). rewrite -(interp_domain_set_nth (S n)) /=. apply H11. apply Htw. now split ; apply Rlt_le. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. Qed. Fixpoint simplify_domain (d : domain) : domain := match d with | And ld => let l := foldr (fun d acc => let d' := simplify_domain d in match d' with | Always => acc | And l => cat l acc | Never => Never :: nil | _ => d' :: acc end) nil ld in match l with | nil => Always | d :: nil => d | _ => And l end | Forall e1 e2 d => let d' := simplify_domain d in match d' with | Always => Always | Never => Never | _ => Forall e1 e2 d' end | Forone e d => let d' := simplify_domain d in match d' with | Always => Always | Never => Never | _ => Forone e d' end | Locally n d => let d' := simplify_domain d in match d' with | Always => Always | Never => Never | _ => Locally n d' end | Locally2 m n d => let d' := simplify_domain d in match d' with | Always => Always | Never => Never | _ => Locally2 m n d' end | ForallWide n e1 e2 d => let d' := simplify_domain d in match d' with | Always => Always | Never => Never | _ => ForallWide n e1 e2 d' end | _ => d end. Lemma simplify_domain_correct : forall d l, interp_domain l (simplify_domain d) -> interp_domain l d. Proof. intros d. induction d using domain_ind' => l ; try easy ; simpl. (* And *) set (f := fun (d : domain) (acc : seq domain) => match simplify_domain d with | Never => Never :: nil | Always => acc | And l0 => l0 ++ acc | _ => simplify_domain d :: acc end). intros H'. have: (foldr (fun d acc => interp_domain l d /\ acc) True (foldr f nil ld)). by move: (foldr f nil ld) H' => [|h [|s]]. clear H'. revert H. induction ld as [|t] => H. easy. simpl in H |- *. destruct H as (Ha,Hb). revert Ha. rewrite /f -/f. case (simplify_domain t) ; simpl. (* . *) now intros _ (H,_). (* . *) exact (fun H1 H2 => conj (H1 l I) (IHld Hb H2)). (* . *) intros df e H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros n k f' le H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros m n k f' le H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros n e H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros m n e H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros e0 e1 e2 H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros n e0 e1 e2 H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros n e0 e1 H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros ls H1 H2. rewrite foldr_cat in H2. refine ((fun H => conj (H1 l (proj1 H)) (IHld Hb (proj2 H))) _). revert H2. generalize (foldr f nil ld). clear. induction ls. done. simpl. split. split. apply H2. eapply (fun s H => proj1 (IHls s H)). apply H2. now apply IHls. (* . *) intros e1 e2 d H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros e d H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros n d H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros m n d H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* . *) intros n e1 e2 d H1 (H2,H3). exact (conj (H1 l H2) (IHld Hb H3)). (* Forall *) revert IHd. assert (HH: forall d', (forall l, interp_domain l d' -> interp_domain l d) -> interp_domain l (Forall e1 e2 d') -> interp_domain l (Forall e1 e2 d)). simpl. intros d' H1 H2 t Ht. apply H1. now apply H2. destruct (simplify_domain d) ; try (apply HH ; fail). easy. simpl. intros H _ t Ht. now apply H. (* Forone *) revert IHd. assert (HH: forall d', (forall l, interp_domain l d' -> interp_domain l d) -> interp_domain l (Forone e d') -> interp_domain l (Forone e d)). simpl. intros d' H1 H2. apply H1. now apply H2. destruct (simplify_domain d) ; apply HH. (* Locally *) revert IHd. assert (HH: forall d', (forall l, interp_domain l d' -> interp_domain l d) -> interp_domain l (Locally n d') -> interp_domain l (Locally n d)). simpl. intros d' H1 (eps,H2). exists eps => t Ht. apply H1. now apply H2. destruct (simplify_domain d) ; try (apply HH ; fail). easy. simpl. intros H _. exists (mkposreal _ Rlt_0_1) => t Ht. now apply H. (* Locally2 *) revert IHd. assert (HH: forall d', (forall l, interp_domain l d' -> interp_domain l d) -> interp_domain l (Locally2 m n d') -> interp_domain l (Locally2 m n d)). simpl. intros d' H1 (eps,H2). exists eps => u v Hu Hv. apply H1. now apply H2. destruct (simplify_domain d) ; try (apply HH ; fail). easy. simpl. intros H _. exists (mkposreal _ Rlt_0_1) => u v Hu Hv. now apply H. (* ForallWide *) revert IHd. assert (HH: forall d', (forall l, interp_domain l d' -> interp_domain l d) -> interp_domain l (ForallWide n e1 e2 d') -> interp_domain l (ForallWide n e1 e2 d)). simpl. intros d' H1 (e,H2). exists e => t u Ht Hu. apply H1. now apply H2. destruct (simplify_domain d) ; try (apply HH ; fail). easy. simpl. intros H _. exists (mkposreal _ Rlt_0_1) => u v Hu Hv. now apply H. Qed. Class UnaryDiff f := {UnaryDiff_f' : R -> R ; UnaryDiff_H : forall x, is_derive f x (UnaryDiff_f' x)}. Class UnaryDiff' f := {UnaryDiff'_f' : R -> R ; UnaryDiff'_df : R -> Prop ; UnaryDiff'_H : forall x, UnaryDiff'_df x -> is_derive f x (UnaryDiff'_f' x)}. Global Instance UnaryDiff_exp : UnaryDiff exp. Proof. exists exp. move => x ; by apply is_derive_Reals, derivable_pt_lim_exp. Defined. Global Instance UnaryDiff_pow : forall n : nat, UnaryDiff (fun x => pow x n). Proof. intro n. exists (fun x => INR n * x ^ (Peano.pred n)). move => x ; by apply is_derive_Reals, derivable_pt_lim_pow. Defined. Global Instance UnaryDiff_Rabs : UnaryDiff' Rabs. Proof. exists (fun x => sign x) (fun x => x <> 0). move => x Hx0 ; by apply filterdiff_Rabs. Defined. Global Instance UnaryDiff_Rsqr : UnaryDiff Rsqr. Proof. exists (fun x => 2 * x). move => x ; by apply is_derive_Reals, derivable_pt_lim_Rsqr. Defined. Global Instance UnaryDiff_cosh : UnaryDiff cosh. Proof. exists sinh. move => x ; by apply is_derive_Reals, derivable_pt_lim_cosh. Defined. Global Instance UnaryDiff_sinh : UnaryDiff sinh. Proof. exists (fun x => cosh x). move => x ; by apply is_derive_Reals, derivable_pt_lim_sinh. Defined. Global Instance UnaryDiff_ps_atan : UnaryDiff' ps_atan. Proof. exists (fun x => /(1+x^2)) (fun x => -1 < x < 1). move => x Hx ; by apply is_derive_Reals, derivable_pt_lim_ps_atan. Defined. Global Instance UnaryDiff_atan : UnaryDiff atan. Proof. exists (fun x => /(1+x^2)). move => x ; by apply is_derive_Reals, derivable_pt_lim_atan. Defined. Global Instance UnaryDiff_ln : UnaryDiff' ln. Proof. exists (fun x => /x) (fun x => 0 < x). move => x Hx ; by apply is_derive_Reals, derivable_pt_lim_ln. Defined. Global Instance UnaryDiff_cos : UnaryDiff cos. Proof. exists (fun x => - sin x ). move => x ; by apply is_derive_Reals, derivable_pt_lim_cos. Defined. Global Instance UnaryDiff_sin : UnaryDiff sin. Proof. exists cos. move => x ; by apply is_derive_Reals, derivable_pt_lim_sin. Defined. Global Instance UnaryDiff_sqrt : UnaryDiff' sqrt. Proof. exists (fun x => / (2 * sqrt x)) (fun x => 0 < x). move => x Hx ; by apply is_derive_Reals, derivable_pt_lim_sqrt. Defined. Definition var : nat -> R. exact (fun _ => R0). Qed. Ltac reify_helper a b z d := match a with | Cst _ => match b with | Cst _ => constr:(Cst d) | _ => z end | _ => z end. Ltac reify fct nb := let rec reify_aux fct l i := match fct with | ?f ?a => let e := reify a nb in reify_aux f (e :: l) (S i) | _ => constr:((fct, rev l, i)) end in match fct with | var ?i => eval vm_compute in (Var (nb - i)) | Rplus ?a ?b => let a' := reify a nb in let b' := reify b nb in reify_helper a' b' (Binary Eplus a' b') fct | Ropp ?a => let a' := reify a nb in match a' with | Cst _ => constr:(Cst fct) | _ => constr:(Unary Eopp a') end | Rminus ?a ?b => let a' := reify a nb in let b' := reify b nb in reify_helper a' b' (Binary Eplus a' (Unary Eopp b')) fct | Rmult ?a ?b => let a' := reify a nb in let b' := reify b nb in reify_helper a' b' (Binary Emult a' b') fct | Rinv ?a => let a' := reify a nb in match a' with | Cst _ => constr:(Cst fct) | _ => constr:(Unary Einv a') end | Rdiv ?a ?b => let a' := reify a nb in let b' := reify b nb in reify_helper a' b' (Binary Emult a' (Unary Einv b')) fct | RInt ?f ?a ?b => let f := eval cbv beta in (f (var (S nb))) in let f' := reify f (S nb) in let a' := reify a nb in let b' := reify b nb in constr:(Int f' a' b') | pow ?f ?n => reify ((fun x => pow x n) f) nb | context [var ?i] => match fct with | ?f ?a => let e := reify a nb in let ud := constr:(_ : UnaryDiff f) in constr:(Unary (Efct f (@UnaryDiff_f' f ud) (@UnaryDiff_H f ud)) e) | ?f ?a => let e := reify a nb in let ud := constr:(_ : UnaryDiff' f) in constr:(Unary (Efct' f (@UnaryDiff'_f' f ud) (@UnaryDiff'_df f ud) (@UnaryDiff'_H f ud)) e) | _ => match reify_aux fct (Nil expr) O with | (?f,?le,?k) => constr:(AppExt k f le) end end | _ => constr:(Cst fct) end. Lemma auto_derive_helper : forall (e : expr) l n, let '(a,b) := D e n in interp_domain l (simplify_domain b) -> is_derive (fun x => interp (set_nth R0 l n x) e) (nth R0 l n) (interp l a). Proof. intros e l n. generalize (D_correct e l n). destruct (D e n) as (d1,d2). intros H1 H2. apply H1. now apply simplify_domain_correct. Qed. Ltac auto_derive_fun f := let f := eval cbv beta in (f (var O)) in let e := reify f O in let H := fresh "H" in assert (H := fun x => auto_derive_helper e (x :: nil) 0) ; simpl in H ; unfold Derive_Rn, ex_derive_Rn in H ; simpl in H ; revert H. Ltac auto_derive := match goal with | |- is_derive ?f ?v ?l => auto_derive_fun f ; let H := fresh "H" in intro H ; refine (@eq_ind R _ (is_derive f v) (H v _) l _) ; clear H | |- ex_derive ?f ?v => eexists ; auto_derive_fun f ; let H := fresh "H" in intro H ; apply (H v) ; clear H | |- derivable_pt_lim ?f ?v ?l => apply is_derive_Reals ; auto_derive | |- derivable_pt ?f ?v => apply ex_derive_Reals_0 ; auto_derive end. coquelicot-coquelicot-3.4.1/theories/Compactness.v000066400000000000000000000232531455143432500223360ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals List ssreflect. (** This file describes compactness results: finite covering of opens, finite covering based on a gauge function, specific instances for 1D and 2D spaces. *) (* This enables a compatibility with Coq 8.4, which didn't have the right lemmas Rplus_lt_reg_l and Rplus_lt_reg_r. So this Import should disappear in the future. A better solution would be to have the fix in a specific compatibility file, rather than in Rcomplements.v. *) Require Import Rcomplements. Open Scope R_scope. Lemma completeness_any : forall P : R -> Prop, ( forall x y, x <= y -> P y -> P x ) -> forall He : (exists x, P x), forall Hb : (bound P), forall x, x < proj1_sig (completeness _ Hb He) -> ~ ~ P x. Proof. intros P HP He Hb x. case completeness => y [Hy1 Hy2] /= Hxy Px. apply Rle_not_lt with (2 := Hxy). apply Hy2 => t Pt. apply Rnot_lt_le => Hxt. apply Px. apply: HP Pt. now apply Rlt_le. Qed. Lemma false_not_not : forall P Q : Prop, (P -> ~Q) -> (~~P -> ~Q). Proof. intros P Q H HP HQ. apply HP. intros H'. now apply H. Qed. Section Compactness. Fixpoint Tn n T : Type := match n with | O => unit | S n => (T * Tn n T)%type end. Fixpoint bounded_n n : Tn n R -> Tn n R -> Tn n R -> Prop := match n return Tn n R -> Tn n R -> Tn n R -> Prop with | O => fun a b x : Tn O R => True | S n => fun a b x : Tn (S n) R => let '(a1,a2) := a in let '(b1,b2) := b in let '(x1,x2) := x in a1 <= x1 <= b1 /\ bounded_n n a2 b2 x2 end. Fixpoint close_n n d : Tn n R -> Tn n R -> Prop := match n return Tn n R -> Tn n R -> Prop with | O => fun x t : Tn O R => True | S n => fun x t : Tn (S n) R => let '(x1,x2) := x in let '(t1,t2) := t in Rabs (x1 - t1) < d /\ close_n n d x2 t2 end. (** * Compactness: there is a finite covering of opens *) Lemma compactness_list : forall n a b (delta : Tn n R -> posreal), ~~ exists l, forall x, bounded_n n a b x -> exists t, In t l /\ bounded_n n a b t /\ close_n n (delta t) x t. Proof. induction n. intros a b delta. intros H. apply H. exists (tt :: nil). intros x Hx. exists tt. repeat split. now left. simpl. (* *) intros (a,a') (b,b') delta. destruct (Rlt_le_dec b a) as [Hab|Hab]. intros H. apply H. exists nil. intros (x,x') (Hx,_). elim (Rlt_irrefl a). apply Rle_lt_trans with (2 := Hab). now apply Rle_trans with x. (* *) set (P y := y <= b /\ ~~exists l, forall x, bounded_n (S n) (a,a') (y,b') x -> exists t, In t l /\ bounded_n (S n) (a,a') (b,b') t /\ close_n (S n) (delta t) x t). (* . *) assert (P1': P a). split. apply Hab. simpl. specialize (IHn a' b' (fun x' => delta (a,x'))). contradict IHn. contradict IHn. destruct IHn as (l,Hl). exists (fold_right (fun x' acc => (a,x')::acc) nil l). intros (x,x') (Hx,Hx'). replace x with a by now apply Rle_antisym. destruct (Hl x' Hx') as (t',(Ht1,Ht2)). exists (a,t'). split. clear -Ht1. induction l. easy. simpl in Ht1 |- *. destruct Ht1 as [Ht1|Ht1]. left. now apply f_equal2. right. now apply IHl. repeat split. apply Rle_refl. exact Hab. apply Ht2. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. apply Ht2. (* . *) assert (P2: bound P). exists b => y Hy. apply Hy. (* . *) assert (P3: forall x y, x <= y -> P y -> P x). intros x y Hxy (Py1,Py2). split. now apply Rle_trans with y. contradict Py2. contradict Py2. destruct Py2 as (l,Py2). exists l => [[z z']] Hz. apply Py2. split. split. apply Hz. now apply Rle_trans with (1 := proj2 (proj1 Hz)). apply Hz. assert (P1: exists x, P x). now exists a. (* . *) set (y := proj1_sig (completeness _ P2 P1)). assert (P4: ~~exists d : posreal, P (Rmin b (y + d))). specialize (IHn a' b' (fun x' => delta (y,x'))). contradict IHn. contradict IHn. destruct IHn as (l, Hl). set (d := fold_right (fun t acc => mkposreal _ (Rmin_stable_in_posreal (delta (y,t)) acc)) (mkposreal _ Rlt_0_1) l). assert (Hd: 0 < d/2). apply Fourier_util.Rlt_mult_inv_pos. apply cond_pos. apply Rlt_R0_R2. exists (mkposreal _ Hd). split. apply Rmin_l. refine (_ (completeness_any _ P3 P1 P2 (y - d) _)). intros Hy. apply: false_not_not Hy => Hy. destruct Hy as (Hy1,Hy2). apply: false_not_not Hy2 => Hy2. apply. destruct Hy2 as (l',Hl'). exists (app (fold_right (fun x' acc => (y,x')::acc) nil l) l'). simpl. intros (x,x') (Hx,Hx'). destruct (Rle_or_lt x (y - d)) as [Hxy|Hxy]. destruct (Hl' (x,x') (conj (conj (proj1 Hx) Hxy) Hx')) as (t,(Ht1,Ht2)). exists t. split. apply in_or_app. now right. exact Ht2. destruct (Hl x' Hx') as (t',(Ht1,Ht2)). exists (y, t'). split. apply in_or_app. left. clear -Ht1. induction l. easy. simpl in Ht1 |- *. destruct Ht1 as [Ht1|Ht1]. left. now apply f_equal2. right. now apply IHl. do 2 split. unfold y. case completeness => /= z [Hz1 Hz2]. split. now apply Hz1. apply Hz2. intros w Hw. apply Hw. apply Ht2. apply Rlt_le_trans with d. apply Rabs_def1. apply Rplus_lt_reg_r with y. ring_simplify. apply Rle_lt_trans with (y + d/2). now apply Rle_trans with (2 := Rmin_r b _). apply Rplus_lt_compat_l. rewrite -(Rplus_0_r (d/2)). rewrite {2}(double_var d). now apply Rplus_lt_compat_l. apply Rplus_lt_reg_l with y. now ring_simplify (y + (x - y)). clearbody y. clear -Ht1. induction l. easy. simpl in Ht1. destruct Ht1 as [Ht1|Ht1]. rewrite -Ht1. apply: Rmin_l. unfold d. simpl. apply Rle_trans with (1 := Rmin_r _ _). now apply IHl. apply Ht2. fold y. rewrite -{2}(Rplus_0_r y) -Ropp_0. apply Rplus_lt_compat_l. apply Ropp_lt_contravar. apply cond_pos. (* . *) apply: false_not_not P4 => P4. destruct P4 as (d,P4). destruct (Rle_or_lt b y) as [Hby|Hby]. rewrite Rmin_left in P4. apply P4. rewrite -(Rplus_0_r b). apply Rplus_le_compat with (1 := Hby). apply Rlt_le. apply cond_pos. exfalso. unfold y in *. clear y. revert P4 Hby. case completeness => /= y [Hy1 Hy2] P4 Hby. apply Rle_not_lt with (1 := Hy1 (Rmin b (y + d)) P4). apply Rmin_case. exact Hby. rewrite -{1}(Rplus_0_r y). apply Rplus_lt_compat_l. apply cond_pos. Qed. (** * Compactness: there is a covering based on a gauge function *) Lemma compactness_value : forall n a b (delta : Tn n R -> posreal), { d : posreal | forall x, bounded_n n a b x -> ~~ exists t, bounded_n n a b t /\ close_n n (delta t) x t /\ d <= delta t }. Proof. intros n a b delta. set (P d := d <= 1 /\ forall x, bounded_n n a b x -> exists t, bounded_n n a b t /\ close_n n (delta t) x t /\ d <= delta t). assert (P1 : exists d, P d). exists 0. split. apply Rle_0_1. intros x Hx. exists x. split. exact Hx. split. clear. induction n. easy. destruct x as (x,x'). split. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. apply (IHn (fun x' => delta (x,x'))). apply Rlt_le. apply cond_pos. assert (P2 : bound P). exists 1. now intros d (Hd,_). set (d := completeness P P2 P1). (* *) assert (P3 : 0 < proj1_sig d). revert d. case completeness. intros d (Hd1,Hd2). simpl. apply Rnot_le_lt. intros Hd3. apply (compactness_list n a b delta). intros (l,Hl). set (v := fold_right (fun t acc => mkposreal _ (Rmin_stable_in_posreal (delta t) acc)) (mkposreal _ Rlt_0_1) l). apply (Rlt_not_le _ _ (cond_pos v)). apply Rle_trans with (2 := Hd3). apply Hd1. split. unfold v. clear. induction l. apply Rle_refl. simpl. apply Rle_trans with (2 := IHl). apply Rmin_r. intros x Hx. destruct (Hl x Hx) as (t,(Ht1,Ht2)). exists t. split. apply Ht2. split. apply Ht2. clear -Ht1. induction l. easy. simpl in Ht1. destruct Ht1 as [Ht1|Ht1]. simpl. rewrite Ht1. apply Rmin_l. simpl. eapply Rle_trans with (1 := Rmin_r _ _). now apply IHl. (* *) exists (mkposreal _ (Fourier_util.Rlt_mult_inv_pos _ _ P3 Rlt_R0_R2)). intros x Hx. simpl. refine (_ (completeness_any P _ P1 P2 (proj1_sig d / 2) _)). intros HP. contradict HP. contradict HP. destruct HP as (_,HP). now apply HP. intros u v Huv (Pv1,Pv2). split. now apply Rle_trans with v. intros z Hz. destruct (Pv2 z Hz) as (t,Ht). exists t. split. apply Ht. split. apply Ht. apply Rle_trans with (1 := Huv). apply Ht. fold d. rewrite -(Rplus_0_r (proj1_sig d / 2)). rewrite {2}(double_var (proj1_sig d)). apply Rplus_lt_compat_l. apply Fourier_util.Rlt_mult_inv_pos. exact P3. apply Rlt_R0_R2. Qed. End Compactness. (** * Specific instances of compactness for 1D and 2D spaces *) Lemma compactness_value_1d : forall a b (delta : R -> posreal), { d : posreal | forall x, a <= x <= b -> ~~ exists t, a <= t <= b /\ Rabs (x - t) < delta t /\ d <= delta t }. Proof. intros a b delta. destruct (compactness_value 1 (a,tt) (b,tt) (fun t => let '(t,_) := t in delta t)) as (d, Hd). exists d. intros x Hx. specialize (Hd (x,tt) (conj Hx I)). do 2 contradict Hd. destruct Hd as ((t,t'),Ht). exists t. repeat split ; apply Ht. Qed. Lemma compactness_value_2d : forall a b a' b' (delta : R -> R -> posreal), { d : posreal | forall x y, a <= x <= b -> a' <= y <= b' -> ~~ exists u, exists v, a <= u <= b /\ a' <= v <= b' /\ Rabs (x - u) < delta u v /\ Rabs (y - v) < delta u v /\ d <= delta u v }. Proof. intros a b a' b' delta. destruct (compactness_value 2 (a,(a',tt)) (b,(b',tt)) (fun t => let '(u,(v,_)) := t in delta u v)) as (d, Hd). exists d. intros x y Hx Hy. specialize (Hd (x,(y,tt)) (conj Hx (conj Hy I))). do 2 contradict Hd. destruct Hd as ((u,(v,w)),Ht). exists u. exists v. simpl in Ht. repeat split ; apply Ht. Qed. coquelicot-coquelicot-3.4.1/theories/Complex.v000066400000000000000000000622721455143432500214720ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect. Require Import Rcomplements Rbar Continuity Derive Hierarchy. (** This file defines complex numbers [C] as [R * R]. Operations are given, and [C] is proved to be a field, a normed module, and a complete space. *) (** * The set of complex numbers *) Definition C := (R * R)%type. Definition RtoC (x : R) : C := (x,0). Coercion RtoC : R >-> C. Lemma RtoC_inj : forall (x y : R), RtoC x = RtoC y -> x = y. Proof. intros x y H. now apply (f_equal (@fst R R)) in H. Qed. Lemma Ceq_dec (z1 z2 : C) : { z1 = z2 } + { z1 <> z2 }. Proof. destruct z1 as [x1 y1]. destruct z2 as [x2 y2]. case: (Req_EM_T x1 x2) => [ -> | Hx ]. case: (Req_EM_T y1 y2) => [ -> | Hy ]. by left. right ; contradict Hy. now apply (f_equal (@snd R R)) in Hy ; simpl in Hy. right ; contradict Hx. now apply (f_equal (@fst R R)) in Hx ; simpl in Hx. Qed. (** ** Constants and usual functions *) (** 0 and 1 for complex are defined as [RtoC 0] and [RtoC 1] *) Definition Ci : C := (0,1). (** *** Arithmetic operations *) Definition Cplus (x y : C) : C := (fst x + fst y, snd x + snd y). Definition Copp (x : C) : C := (-fst x, -snd x). Definition Cminus (x y : C) : C := Cplus x (Copp y). Definition Cmult (x y : C) : C := (fst x * fst y - snd x * snd y, fst x * snd y + snd x * fst y). Definition Cinv (x : C) : C := (fst x / (fst x ^ 2 + snd x ^ 2), - snd x / (fst x ^ 2 + snd x ^ 2)). Definition Cdiv (x y : C) : C := Cmult x (Cinv y). Delimit Scope C_scope with C. Bind Scope C_scope with C. Local Open Scope C_scope. Infix "+" := Cplus : C_scope. Notation "- x" := (Copp x) : C_scope. Infix "-" := Cminus : C_scope. Infix "*" := Cmult : C_scope. Notation "/ x" := (Cinv x) : C_scope. Infix "/" := Cdiv : C_scope. (** *** Other usual functions *) Definition Re (z : C) : R := fst z. Definition Im (z : C) : R := snd z. Definition Cmod (x : C) : R := sqrt (fst x ^ 2 + snd x ^ 2). Definition Cconj (x : C) : C := (fst x, (- snd x)%R). Lemma Cmod_0 : Cmod 0 = 0. Proof. unfold Cmod. simpl. rewrite Rmult_0_l Rplus_0_l. apply sqrt_0. Qed. Lemma Cmod_1 : Cmod 1 = 1. Proof. unfold Cmod. simpl. rewrite Rmult_0_l Rplus_0_r 2!Rmult_1_l. apply sqrt_1. Qed. Lemma Cmod_Ci : Cmod Ci = 1. Proof. unfold Cmod, Ci. simpl. rewrite !Rmult_1_l !Rmult_0_l Rplus_0_l. apply sqrt_1. Qed. Lemma Cmod_opp : forall x, Cmod (-x) = Cmod x. Proof. unfold Cmod. simpl. intros x. apply f_equal. ring. Qed. Lemma Cmod_triangle : forall x y, Cmod (x + y) <= Cmod x + Cmod y. Proof. intros x y ; rewrite /Cmod. apply Rsqr_incr_0_var. apply Rminus_le_0. unfold Rsqr ; simpl ; ring_simplify. rewrite /pow ?Rmult_1_r. rewrite ?sqrt_sqrt ; ring_simplify. replace (-2 * fst x * fst y - 2 * snd x * snd y)%R with (- (2 * (fst x * fst y + snd x * snd y)))%R by ring. rewrite Rmult_assoc -sqrt_mult. rewrite Rplus_comm. apply -> Rminus_le_0. apply Rmult_le_compat_l. apply Rlt_le, Rlt_0_2. apply Rsqr_incr_0_var. apply Rminus_le_0. rewrite /Rsqr ?sqrt_sqrt ; ring_simplify. replace (fst x ^ 2 * snd y ^ 2 - 2 * fst x * snd x * fst y * snd y + snd x ^ 2 * fst y ^ 2)%R with ( (fst x * snd y - snd x * fst y)^2)%R by ring. apply pow2_ge_0. repeat apply Rplus_le_le_0_compat ; apply Rmult_le_pos ; apply pow2_ge_0. apply sqrt_pos. apply Rplus_le_le_0_compat ; apply Rle_0_sqr. apply Rplus_le_le_0_compat ; apply Rle_0_sqr. replace (fst x ^ 2 + 2 * fst x * fst y + fst y ^ 2 + snd x ^ 2 + 2 * snd x * snd y + snd y ^ 2)%R with ((fst x + fst y)^2 + (snd x + snd y)^2)%R by ring. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply sqrt_pos. Qed. Lemma Cmod_mult : forall x y, Cmod (x * y) = (Cmod x * Cmod y)%R. Proof. intros x y. unfold Cmod. rewrite -sqrt_mult. apply f_equal ; simpl ; ring. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply pow2_ge_0. Qed. Lemma Rmax_Cmod : forall x, Rmax (Rabs (fst x)) (Rabs (snd x)) <= Cmod x. Proof. case => x y /=. rewrite -!sqrt_Rsqr_abs. apply Rmax_case ; apply sqrt_le_1_alt, Rminus_le_0 ; rewrite /Rsqr /= ; ring_simplify ; by apply pow2_ge_0. Qed. Lemma Cmod_2Rmax : forall x, Cmod x <= sqrt 2 * Rmax (Rabs (fst x)) (Rabs (snd x)). Proof. case => x y /= ; apply Rmax_case_strong => H0 ; rewrite -!sqrt_Rsqr_abs ; rewrite -?sqrt_mult ; try (by apply Rle_0_sqr) ; try (by apply Rlt_le, Rlt_0_2) ; apply sqrt_le_1_alt ; simpl ; [ rewrite Rplus_comm | ] ; rewrite /Rsqr ; apply Rle_minus_r ; ring_simplify ; apply Rsqr_le_abs_1 in H0 ; by rewrite /pow !Rmult_1_r. Qed. (** ** C is a field *) Lemma RtoC_plus (x y : R) : RtoC (x + y) = RtoC x + RtoC y. Proof. unfold RtoC, Cplus ; simpl. by rewrite Rplus_0_r. Qed. Lemma RtoC_opp (x : R) : RtoC (- x) = - RtoC x. Proof. unfold RtoC, Copp ; simpl. by rewrite Ropp_0. Qed. Lemma RtoC_minus (x y : R) : RtoC (x - y) = RtoC x - RtoC y. Proof. by rewrite /Cminus -RtoC_opp -RtoC_plus. Qed. Lemma RtoC_mult (x y : R) : RtoC (x * y) = RtoC x * RtoC y. Proof. unfold RtoC, Cmult ; simpl. apply injective_projections ; simpl ; ring. Qed. Lemma RtoC_inv (x : R) : (x <> 0)%R -> RtoC (/ x) = / RtoC x. Proof. intros Hx. by apply injective_projections ; simpl ; field. Qed. Lemma RtoC_div (x y : R) : (y <> 0)%R -> RtoC (x / y) = RtoC x / RtoC y. Proof. intros Hy. by apply injective_projections ; simpl ; field. Qed. Lemma Cplus_comm (x y : C) : x + y = y + x. Proof. apply injective_projections ; simpl ; apply Rplus_comm. Qed. Lemma Cplus_assoc (x y z : C) : x + (y + z) = (x + y) + z. Proof. apply injective_projections ; simpl ; apply sym_eq, Rplus_assoc. Qed. Lemma Cplus_0_r (x : C) : x + 0 = x. Proof. apply injective_projections ; simpl ; apply Rplus_0_r. Qed. Lemma Cplus_0_l (x : C) : 0 + x = x. Proof. apply injective_projections ; simpl ; apply Rplus_0_l. Qed. Lemma Cplus_opp_r (x : C) : x + -x = 0. Proof. apply injective_projections ; simpl ; apply Rplus_opp_r. Qed. Lemma Copp_plus_distr (z1 z2 : C) : - (z1 + z2) = (- z1 + - z2). Proof. apply injective_projections ; by apply Ropp_plus_distr. Qed. Lemma Copp_minus_distr (z1 z2 : C) : - (z1 - z2) = z2 - z1. Proof. apply injective_projections ; by apply Ropp_minus_distr. Qed. Lemma Cmult_comm (x y : C) : x * y = y * x. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cmult_assoc (x y z : C) : x * (y * z) = (x * y) * z. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cmult_0_r (x : C) : x * 0 = 0. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cmult_0_l (x : C) : 0 * x = 0. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cmult_1_r (x : C) : x * 1 = x. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cmult_1_l (x : C) : 1 * x = x. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cinv_r (r : C) : r <> 0 -> r * /r = 1. Proof. move => H. apply injective_projections ; simpl ; field. contradict H. apply Rplus_sqr_eq_0 in H. apply injective_projections ; simpl ; by apply H. contradict H. apply Rplus_sqr_eq_0 in H. apply injective_projections ; simpl ; by apply H. Qed. Lemma Cinv_l (r : C) : r <> 0 -> /r * r = 1. Proof. intros Zr. rewrite Cmult_comm. now apply Cinv_r. Qed. Lemma Cmult_plus_distr_l (x y z : C) : x * (y + z) = x * y + x * z. Proof. apply injective_projections ; simpl ; ring. Qed. Lemma Cmult_plus_distr_r (x y z : C) : (x + y) * z = x * z + y * z. Proof. apply injective_projections ; simpl ; ring. Qed. Definition C_AbelianMonoid_mixin := AbelianMonoid.Mixin _ _ _ Cplus_comm Cplus_assoc Cplus_0_r. Canonical C_AbelianMonoid := AbelianMonoid.Pack C C_AbelianMonoid_mixin C. Definition C_AbelianGroup_mixin := AbelianGroup.Mixin _ _ Cplus_opp_r. Canonical C_AbelianGroup := AbelianGroup.Pack C (AbelianGroup.Class _ _ C_AbelianGroup_mixin) C. Lemma Copp_0 : Copp 0 = 0. Proof. apply: opp_zero. Qed. Definition C_Ring_mixin := Ring.Mixin _ _ _ Cmult_assoc Cmult_1_r Cmult_1_l Cmult_plus_distr_r Cmult_plus_distr_l. Canonical C_Ring := Ring.Pack C (Ring.Class _ _ C_Ring_mixin) C. Lemma Cmod_m1 : Cmod (Copp 1) = 1. Proof. rewrite Cmod_opp. apply Cmod_1. Qed. Lemma Cmod_eq_0 : forall x, Cmod x = 0 -> x = 0. Proof. intros x H. unfold Cmod, pow in H. rewrite 2!Rmult_1_r -sqrt_0 in H. apply sqrt_inj in H. apply Rplus_sqr_eq_0 in H. now apply injective_projections. apply Rplus_le_le_0_compat ; apply Rle_0_sqr. apply Rle_refl. Qed. Definition C_AbsRing_mixin := AbsRing.Mixin _ _ Cmod_0 Cmod_m1 Cmod_triangle (fun x y => Req_le _ _ (Cmod_mult x y)) Cmod_eq_0. Canonical C_AbsRing := AbsRing.Pack C (AbsRing.Class _ _ C_AbsRing_mixin) C. Lemma Cmod_ge_0 : forall x, 0 <= Cmod x. Proof. intros x. apply sqrt_pos. Qed. Lemma Cmod_gt_0 : forall (x : C), x <> 0 <-> 0 < Cmod x. Proof. intros x ; split => Hx. destruct (Cmod_ge_0 x) => //. by apply sym_eq, Cmod_eq_0 in H. contradict Hx. apply Rle_not_lt, Req_le. by rewrite Hx Cmod_0. Qed. Lemma Cmod_norm : forall x : C, Cmod x = (@norm R_AbsRing _ x). Proof. intros [u v]. unfold Cmod. simpl. apply (f_equal2 (fun x y => sqrt (x + y))) ; rewrite /norm /= !Rmult_1_r ; apply Rsqr_abs. Qed. Lemma Cmod_R : forall x : R, Cmod x = Rabs x. Proof. intros x. unfold Cmod. simpl. rewrite Rmult_0_l Rplus_0_r Rmult_1_r. apply sqrt_Rsqr_abs. Qed. Lemma Cmod_inv : forall x : C, x <> 0 -> Cmod (/ x) = Rinv (Cmod x). Proof. intros x Zx. apply Rmult_eq_reg_l with (Cmod x). rewrite -Cmod_mult. rewrite Rinv_r. rewrite Cinv_r. rewrite Cmod_R. apply Rabs_R1. exact Zx. contradict Zx. now apply Cmod_eq_0. contradict Zx. now apply Cmod_eq_0. Qed. Lemma Cmod_div (x y : C) : y <> 0 -> Cmod (x / y) = Rdiv (Cmod x) (Cmod y). Proof. move => Hy. rewrite /Cdiv. rewrite Cmod_mult. by rewrite Cmod_inv. Qed. Lemma Cmult_neq_0 (z1 z2 : C) : z1 <> 0 -> z2 <> 0 -> z1 * z2 <> 0. Proof. intros Hz1 Hz2 => Hz. assert (Cmod (z1 * z2) = 0). by rewrite Hz Cmod_0. rewrite Cmod_mult in H. apply Rmult_integral in H ; destruct H. now apply Hz1, Cmod_eq_0. now apply Hz2, Cmod_eq_0. Qed. Lemma Ceq_minus (c c' : C) : c = c' <-> c-c' = 0. Proof. split; intros H. - subst c. apply Cplus_opp_r. - destruct c as (x,y), c' as (x',y'). compute in H. injection H as Hx Hy. apply Rminus_diag_uniq_sym in Hx. apply Rminus_diag_uniq_sym in Hy. now f_equal. Qed. Lemma Cminus_eq_contra : forall r1 r2 : C, r1 <> r2 -> r1 - r2 <> 0. Proof. intros ; contradict H ; apply injective_projections ; apply Rminus_diag_uniq. now apply (f_equal (@fst R R)) in H. now apply (f_equal (@snd R R)) in H. Qed. Lemma C1_nz : RtoC 1 <> 0. Proof. injection. apply R1_neq_R0. Qed. Lemma Ci_nz : Ci <> 0. injection. apply R1_neq_R0. Qed. (** A power function : c^n *) Fixpoint Cpow (c : C) n : C := match n with | O => 1 | S n => c * Cpow c n end. Infix "^" := Cpow : C_scope. Lemma Cpow_1_l n : 1^n = 1. Proof. induction n; simpl; auto. now rewrite IHn Cmult_1_l. Qed. Lemma Cpow_1_r c : c^1 = c. Proof. simpl. apply Cmult_1_r. Qed. Lemma Cpow_S c n : c^(S n) = c*c^n. Proof. reflexivity. Qed. Lemma Cpow_add_r c n m : c^(n+m) = c^n*c^m. Proof. induction n; simpl. now rewrite Cmult_1_l. now rewrite IHn Cmult_assoc. Qed. Lemma Cpow_mult_l a b n : (a*b)^n = a^n * b^n. Proof. induction n; simpl. now rewrite Cmult_1_l. rewrite IHn. rewrite Cmult_assoc. rewrite <- (Cmult_assoc a b _). rewrite (Cmult_comm b _). now rewrite !Cmult_assoc. Qed. Lemma Cpow_mult_r c n m : c^(n*m) = (c^n)^m. Proof. induction n; simpl. now rewrite Cpow_1_l. now rewrite !Cpow_add_r IHn Cpow_mult_l. Qed. Lemma Cpow_nz (c:C) n : c <> 0 -> c^n <> 0. Proof. induction n; simpl; intro H. - injection. apply R1_neq_R0. - apply Cmult_neq_0; auto. Qed. Lemma Cmod_pow (c:C) n : Cmod (c^n) = (Cmod c ^n)%R. Proof. induction n; simpl; auto. - apply Cmod_1. - now rewrite Cmod_mult IHn. Qed. (** ** Ring and Field *) Definition C_ring_morph : ring_morph (RtoC 0) (RtoC 1) Cplus Cmult Cminus Copp (@eq C) 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Z.eqb (fun z => RtoC (IZR z)). Proof. constructor; try reflexivity; intros. - now rewrite plus_IZR RtoC_plus. - now rewrite minus_IZR RtoC_minus. - now rewrite mult_IZR RtoC_mult. - now rewrite opp_IZR RtoC_opp. - f_equal. f_equal. now apply Z.eqb_eq. Qed. Lemma C_power_theory : @power_theory C 1 Cmult (@eq C) _ N.to_nat Cpow. Proof. constructor. destruct n. reflexivity. simpl. induction p. - rewrite Pos2Nat.inj_xI. simpl. now rewrite Nat.add_0_r Cpow_add_r IHp. - rewrite Pos2Nat.inj_xO. simpl. now rewrite Nat.add_0_r Cpow_add_r IHp. - simpl. now rewrite Cmult_1_r. Qed. Ltac RtoC_IZR_tac t := match t with | RtoC ?x => IZR_tac x | _ => constr:(NotConstant) end. Lemma C_ring_theory : ring_theory (RtoC 0) (RtoC 1) Cplus Cmult Cminus Copp eq. Proof. constructor. exact Cplus_0_l. exact Cplus_comm. exact Cplus_assoc. exact Cmult_1_l. exact Cmult_comm. exact Cmult_assoc. exact Cmult_plus_distr_r. easy. exact Cplus_opp_r. Qed. Add Ring C_ring_ring : C_ring_theory (morphism C_ring_morph, constants [RtoC_IZR_tac], power_tac C_power_theory [Rpow_tac]). Lemma C_field_theory : field_theory (RtoC 0) (RtoC 1) Cplus Cmult Cminus Copp Cdiv Cinv eq. Proof. constructor. constructor. exact Cplus_0_l. exact Cplus_comm. exact Cplus_assoc. exact Cmult_1_l. exact Cmult_comm. exact Cmult_assoc. exact Cmult_plus_distr_r. easy. exact Cplus_opp_r. intros H. injection H. exact R1_neq_R0. easy. apply Cinv_l. Qed. Lemma Zeqb_Ccomplete z z' : RtoC (IZR z) = RtoC (IZR z') -> Z.eqb z z' = true. Proof. intros H. apply Z.eqb_eq. now apply eq_IZR, RtoC_inj. Qed. Add Field C_field_field : C_field_theory (morphism C_ring_morph, completeness Zeqb_Ccomplete, constants [RtoC_IZR_tac], power_tac C_power_theory [Rpow_tac]). (** Some other basic properties *) Lemma Cpow_inv (c:C) n : c<>0 -> (/c)^n = /(c^n). Proof. intros Hc. induction n; simpl; auto. - symmetry. rewrite <-(Cmult_1_l (/1)). apply Cinv_r, C1_nz. - rewrite IHn. field. auto using Cpow_nz. Qed. Lemma Cmod2_alt (c:C) : (Cmod c ^2 = Re c ^2 + Im c ^2)%R. Proof. unfold Cmod. rewrite <-Rsqr_pow2, Rsqr_sqrt. trivial. apply Rplus_le_le_0_compat; apply pow2_ge_0. Qed. Lemma Cmod2_conj (c:C) : RtoC (Cmod c ^2) = c * Cconj c. Proof. rewrite Cmod2_alt. destruct c as (x,y). unfold Cconj, Cmult, RtoC. simpl. f_equal; ring. Qed. Lemma re_alt (c:C) : RtoC (Re c) = (c + Cconj c)/2. Proof. destruct c as (x,y). unfold Cconj, RtoC, Cplus, Cdiv, Cmult. simpl. f_equal; field. Qed. Lemma im_alt (c:C) : RtoC (Im c) = (c - Cconj c)/(2*Ci). Proof. destruct c as (x,y). unfold Cconj, RtoC, Ci, Cminus, Cplus, Cdiv, Cmult. simpl. f_equal; field. Qed. Lemma im_alt' (c:C) : c - Cconj c = 2*Ci*Im c. Proof. rewrite im_alt. field. apply Ci_nz. Qed. Lemma re_conj (c:C) : Re (Cconj c) = Re c. Proof. now destruct c. Qed. Lemma im_conj (c:C) : Im (Cconj c) = (- Im c)%R. Proof. now destruct c. Qed. Lemma re_plus a b : (Re (a+b) = Re a + Re b)%R. Proof. now destruct a as (xa,ya), b as (xb,yb). Qed. Lemma re_opp a : (Re (-a) = - Re a)%R. Proof. now destruct a as (xa,ya). Qed. Lemma re_mult a b : (Re (a*b) = Re a * Re b - Im a * Im b)%R. Proof. now destruct a as (xa,ya), b as (xb,yb). Qed. Lemma im_plus a b : (Im (a+b) = Im a + Im b)%R. Proof. now destruct a as (xa,ya), b as (xb,yb). Qed. Lemma im_opp a : (Im (-a) = - Im a)%R. Proof. now destruct a as (xa,ya). Qed. Lemma im_mult a b : (Im (a*b) = Re a * Im b + Im a * Re b)%R. Proof. now destruct a as (xa,ya), b as (xb,yb). Qed. Lemma re_RtoC (r:R) : Re (RtoC r) = r. Proof. reflexivity. Qed. Lemma im_RtoC (r:R) : Im (RtoC r) = 0. Proof. reflexivity. Qed. Lemma re_scal_l (r:R)(c:C) : (Re (r*c) = r * Re c)%R. Proof. destruct c as (x,y); simpl. ring. Qed. Lemma re_scal_r (c:C)(r:R) : (Re (c*r) = Re c * r)%R. Proof. destruct c as (x,y); simpl. ring. Qed. Lemma im_scal_l (r:R)(c:C) : (Im (r*c) = r * Im c)%R. Proof. destruct c as (x,y); simpl. ring. Qed. Lemma im_scal_r (c:C)(r:R) : (Im (c*r) = Im c * r)%R. Proof. destruct c as (x,y); simpl. ring. Qed. Lemma Cconj_conj (c:C) : Cconj (Cconj c) = c. Proof. unfold Cconj. simpl. destruct c; simpl; f_equal; ring. Qed. Lemma Cplus_conj a b : Cconj (a+b) = Cconj a + Cconj b. Proof. destruct a as (xa,ya), b as (xb,yb). unfold Cplus, Cconj. simpl. f_equal. ring. Qed. Lemma Cmult_conj a b : Cconj (a*b) = Cconj a * Cconj b. Proof. destruct a as (xa,ya), b as (xb,yb). unfold Cmult, Cconj. simpl. f_equal; ring. Qed. Lemma Copp_conj a : Cconj (-a) = - Cconj a. Proof. reflexivity. Qed. Lemma Cminus_conj a b : Cconj (a-b) = Cconj a - Cconj b. Proof. apply Cplus_conj. Qed. Lemma Cinv_conj (a:C) : a<>0 -> Cconj (/a) = /Cconj a. Proof. intros H. assert (H' := H). apply Cmod_gt_0 in H'. rewrite <- sqrt_0 in H'. apply sqrt_lt_0_alt in H'. destruct a as (xa,ya). simpl in *. unfold Cinv, Cconj. simpl. rewrite !Rmult_1_r in H'. apply Rlt_not_eq in H'. f_equal; field; rewrite Rmult_opp_opp; now contradict H'. Qed. Lemma Cdiv_conj (a b : C) : b<>0 -> Cconj (a/b) = Cconj a / Cconj b. Proof. intros H. unfold Cdiv. now rewrite Cmult_conj Cinv_conj. Qed. Lemma Cpow_conj a n : Cconj (a^n) = (Cconj a)^n. Proof. induction n; simpl. - unfold RtoC, Cconj. simpl. f_equal. ring. - rewrite Cmult_conj. now f_equal. Qed. Lemma Cmod_conj (c:C) : Cmod (Cconj c) = Cmod c. Proof. unfold Cmod. destruct c as (x,y); simpl. f_equal. ring. Qed. Lemma RtoC_pow (a:R)(n:nat) : RtoC (a^n) = (RtoC a)^n. Proof. induction n; simpl; auto. rewrite RtoC_mult. now f_equal. Qed. Lemma Ci_inv : /Ci = -Ci. Proof. unfold Cinv, Ci, Copp. simpl. f_equal; field. Qed. Lemma re_mult_Ci (c:C) : (Re (c*Ci) = - Im c)%R. Proof. destruct c as (x,y). compute. ring. Qed. Lemma re_le_Cmod (c:C) : Rabs (Re c) <= Cmod c. Proof. rewrite <- (Rabs_right (Cmod c)) by (apply Rle_ge; apply Cmod_ge_0). apply Rsqr_le_abs_0. rewrite !Rsqr_pow2 Cmod2_alt. rewrite <- (Rplus_0_r (Re c ^2)) at 1. apply Rplus_le_compat_l. rewrite <- Rsqr_pow2. apply Rle_0_sqr. Qed. (** * C is a NormedModule *) Canonical C_UniformSpace := UniformSpace.Pack C (UniformSpace.class (prod_UniformSpace _ _)) C. (** on C (with the balls of R^2) *) Canonical C_ModuleSpace := ModuleSpace.Pack C_Ring C (ModuleSpace.class _ (Ring_ModuleSpace C_Ring)) C. Canonical C_NormedModuleAux := NormedModuleAux.Pack C_AbsRing C (NormedModuleAux.Class C_AbsRing _ (ModuleSpace.class _ C_ModuleSpace) (UniformSpace.class C_UniformSpace)) C. Lemma C_NormedModule_mixin_compat1 : forall (x y : C) (eps : R), Cmod (minus y x) < eps -> ball x eps y. Proof. intros x y eps. rewrite Cmod_norm. apply: prod_norm_compat1. Qed. Lemma C_NormedModule_mixin_compat2 : forall (x y : C_NormedModuleAux) (eps : posreal), ball x eps y -> Cmod (minus y x) < sqrt 2 * eps. Proof. intros x y eps H. rewrite Cmod_norm. replace (sqrt 2) with (sqrt 2 * Rmax 1 1)%R. apply: prod_norm_compat2 H. rewrite -> Rmax_left by apply Rle_refl. apply Rmult_1_r. Qed. Definition C_NormedModule_mixin := NormedModule.Mixin _ C_NormedModuleAux _ _ Cmod_triangle (fun x y => Req_le _ _ (Cmod_mult x y)) C_NormedModule_mixin_compat1 C_NormedModule_mixin_compat2 Cmod_eq_0. Canonical C_NormedModule := NormedModule.Pack C_AbsRing C (NormedModule.Class _ _ _ C_NormedModule_mixin) C. (** on R *) Canonical C_R_ModuleSpace := ModuleSpace.Pack R_Ring C (ModuleSpace.class _ (prod_ModuleSpace R_Ring R_ModuleSpace R_ModuleSpace)) C. Canonical C_R_NormedModuleAux := NormedModuleAux.Pack R_AbsRing C (NormedModuleAux.Class R_AbsRing _ (ModuleSpace.class _ C_R_ModuleSpace) (UniformSpace.class _)) C. Canonical C_R_NormedModule := NormedModule.Pack R_AbsRing C (NormedModule.class _ (prod_NormedModule _ _ _)) C. Lemma scal_R_Cmult : forall (x : R) (y : C), scal (V := C_R_ModuleSpace) x y = Cmult x y. Proof. intros x y. apply injective_projections ; rewrite /scal /= /scal /= /mult /= ; ring. Qed. (** * C is a CompleteSpace *) Definition C_complete_lim (F : (C -> Prop) -> Prop) := (R_complete_lim (fun P => F (fun z => P (Re z))), R_complete_lim (fun P => F (fun z => P (Im z)))). Lemma C_complete_ax1 : forall F : (C -> Prop) -> Prop, ProperFilter F -> (forall eps : posreal, exists x : C, F (ball x eps)) -> forall eps : posreal, F (ball (C_complete_lim F) eps). Proof. intros. apply filter_and ; simpl ; revert eps. apply (R_complete (fun P => F (fun z => P (Re z)))). split ; intros. destruct (filter_ex _ H1). by exists (Re x). split. by apply filter_true. intros ; by apply filter_and. intros ; eapply filter_imp, H2. intros ; by apply H1. intros ; destruct (H0 eps). exists (Re x). move: H1 ; apply filter_imp. intros ; by apply H1. apply (R_complete (fun P => F (fun z => P (Im z)))). split ; intros. destruct (filter_ex _ H1). by exists (Im x). split. by apply filter_true. intros ; by apply filter_and. intros ; eapply filter_imp, H2. intros ; by apply H1. intros ; destruct (H0 eps). exists (Im x). move: H1 ; apply filter_imp. intros ; by apply H1. Qed. Lemma C_complete_ax2 : forall F1 F2 : (C -> Prop) -> Prop, filter_le F1 F2 -> filter_le F2 F1 -> close (C_complete_lim F1) (C_complete_lim F2). Proof. intros F1 F2 H12 H21 eps. split ; apply R_complete_close ; intros P. apply H12. apply H21. apply H12. apply H21. Qed. Definition C_CompleteSpace_mixin := CompleteSpace.Mixin _ C_complete_lim C_complete_ax1 C_complete_ax2. (* on C *) Canonical C_CompleteNormedModule := CompleteNormedModule.Pack _ C (CompleteNormedModule.Class C_AbsRing _ (NormedModule.class _ C_NormedModule) C_CompleteSpace_mixin) C. (* on R *) Canonical C_R_CompleteNormedModule := CompleteNormedModule.Pack _ C (CompleteNormedModule.Class R_AbsRing _ (NormedModule.class _ C_R_NormedModule) C_CompleteSpace_mixin) C. (** * Locally compat *) Lemma locally_C x P : locally (T := C_UniformSpace) x P <-> locally (T := AbsRing_UniformSpace C_AbsRing) x P. Proof. split => [[e He] | [e He]]. - exists e => /= y Hy. apply He. split. eapply Rle_lt_trans, Hy. eapply Rle_trans, Rmax_Cmod. apply Rmax_l. eapply Rle_lt_trans, Hy. eapply Rle_trans, Rmax_Cmod. apply Rmax_r. - assert (Hd : 0 < e / sqrt 2). apply Rdiv_lt_0_compat. by apply e. apply Rlt_sqrt2_0. exists (mkposreal _ Hd) => /= y [Hy1 Hy2]. apply He. eapply Rle_lt_trans. apply Cmod_2Rmax. rewrite Rmult_comm ; apply Rlt_div_r. apply Rlt_sqrt2_0. apply Rmax_case. by apply Hy1. by apply Hy2. Qed. (** * Limits *) Definition C_lim (f : C -> C) (z : C) : C := (real (Lim (fun x => fst (f (x, snd z))) (fst z)), real (Lim (fun x => snd (f (x, snd z))) (fst z))). Lemma is_C_lim_unique (f : C -> C) (z l : C) : filterlim f (locally' z) (locally l) -> C_lim f z = l. Proof. case: l => lx ly H. apply injective_projections ; simpl. apply (f_equal real (y := Finite lx)). apply is_lim_unique => /= P [eps Hp]. destruct (H (fun z => P (fst z))) as [delta Hd] ; clear H. exists eps => y Hy. apply Hp, Hy. exists delta. intros y By Hy. apply Hd. split ; simpl. apply By. apply ball_center. contradict Hy. clear -Hy. destruct z as [z1 z2]. now injection Hy. apply (f_equal real (y := Finite ly)). apply is_lim_unique => /= P [eps Hp]. destruct (H (fun z => P (snd z))) as [delta Hd] ; clear H. exists eps => y Hy. apply Hp. apply Hy. exists delta. intros y By Hy. apply Hd. split ; simpl. apply By. apply ball_center. contradict Hy. clear -Hy. destruct z as [z1 z2]. now injection Hy. Qed. (** * Derivatives *) Definition C_derive (f : C -> C) (z : C) := C_lim (fun x => (f x - f z) / (x - z)) z. Lemma is_C_derive_unique (f : C -> C) (z l : C) : is_derive f z l -> C_derive f z = l. Proof. intros [_ Df]. specialize (Df _ (fun P H => H)). apply is_C_lim_unique. intros P HP. destruct HP as [eps HP]. destruct (Df (pos_div_2 eps)) as [eps' Df']. unfold filtermap, locally', within. apply locally_C. exists eps'. intros y Hy Hyz. apply HP. assert (y - z <> 0). contradict Hyz. replace y with (y - z + z) by ring. rewrite Hyz. apply Cplus_0_l. apply: norm_compat1. rewrite /minus /plus /opp /=. replace ((f y - f z) / (y - z) + - l) with ((f y + - f z + - ((y + - z) * l)) / (y + - z)). 2: by field. rewrite /norm /= Cmod_div => //. apply Rlt_div_l. by apply Cmod_gt_0. eapply Rle_lt_trans. apply (Df' y Hy). simpl. rewrite /Rdiv Rmult_assoc. apply Rmult_lt_compat_l. by apply eps. rewrite Rmult_comm Rlt_div_l. rewrite /norm /minus /plus /opp /= /abs /=. apply Rminus_lt_0 ; ring_simplify. by apply Cmod_gt_0. by apply Rlt_0_2. Qed. Lemma C_derive_correct (f : C -> C) (z l : C) : ex_derive f z -> is_derive f z (C_derive f z). Proof. case => df Hf. replace (C_derive f z) with df => //. by apply sym_eq, is_C_derive_unique. Qed. coquelicot-coquelicot-3.4.1/theories/Continuity.v000066400000000000000000001457061455143432500222340ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect. Require Import Rcomplements Rbar Hierarchy Compactness Lim_seq. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). (** This file describes defineitions and properties of continuity on [R] and on uniform spaces. It also contains many results about the limit of a real function (predicates [is_lim] and [ex_lim] and total function [Lim]). This limit may be either a real or an extended real. *) (** * Limit of fonctions *) (** ** Definition *) Definition is_lim (f : R -> R) (x l : Rbar) := filterlim f (Rbar_locally' x) (Rbar_locally l). Definition is_lim' (f : R -> R) (x l : Rbar) := match l with | Finite l => forall eps : posreal, Rbar_locally' x (fun y => Rabs (f y - l) < eps) | p_infty => forall M : R, Rbar_locally' x (fun y => M < f y) | m_infty => forall M : R, Rbar_locally' x (fun y => f y < M) end. Definition ex_lim (f : R -> R) (x : Rbar) := exists l : Rbar, is_lim f x l. Definition ex_finite_lim (f : R -> R) (x : Rbar) := exists l : R, is_lim f x l. Definition Lim (f : R -> R) (x : Rbar) := Lim_seq (fun n => f (Rbar_loc_seq x n)). Lemma is_lim_spec : forall f x l, is_lim' f x l <-> is_lim f x l. Proof. destruct l as [l| |] ; split. - intros H P [eps LP]. unfold filtermap. generalize (H eps). apply filter_imp. intros u. apply LP. - intros H eps. apply (H (fun y => Rabs (y - l) < eps)). now exists eps. - intros H P [M LP]. unfold filtermap. generalize (H M). apply filter_imp. intros u. apply LP. - intros H M. apply (H (fun y => M < y)). now exists M. - intros H P [M LP]. unfold filtermap. generalize (H M). apply filter_imp. intros u. apply LP. - intros H M. apply (H (fun y => y < M)). now exists M. Qed. (** Equivalence with standard library Reals *) Lemma is_lim_Reals_0 (f : R -> R) (x l : R) : is_lim f x l -> limit1_in f (fun y => y <> x) l x. Proof. intros H e He. apply is_lim_spec in H. destruct (H (mkposreal e He)) as [d Hd]. exists d ; split. apply cond_pos. intros y [H1 H2]. now apply (Hd y). Qed. Lemma is_lim_Reals_1 (f : R -> R) (x l : R) : limit1_in f (fun y => y <> x) l x -> is_lim f x l. Proof. intros H. apply is_lim_spec. intros [e He]. destruct (H e He) as [d [Hd H']]. exists (mkposreal d Hd). intros y Hy Hxy. apply (H' y). now split. Qed. Lemma is_lim_Reals (f : R -> R) (x l : R) : is_lim f x l <-> limit1_in f (fun y => y <> x) l x. Proof. split ; [apply is_lim_Reals_0|apply is_lim_Reals_1]. Qed. (** Composition *) Lemma is_lim_comp' : forall {T} {F} {FF : @Filter T F} (f : T -> R) (g : R -> R) (x l : Rbar), filterlim f F (Rbar_locally x) -> is_lim g x l -> F (fun y => Finite (f y) <> x) -> filterlim (fun y => g (f y)) F (Rbar_locally l). Proof. intros T F FF f g x l Lf Lg Hf. revert Lg. apply filterlim_comp. intros P HP. destruct x as [x| |] ; try now apply Lf. specialize (Lf _ HP). unfold filtermap in Lf |- *. generalize (filter_and _ _ Hf Lf). apply filter_imp. intros y [H Hi]. apply Hi. contradict H. now apply f_equal. Qed. Lemma is_lim_comp_seq (f : R -> R) (u : nat -> R) (x l : Rbar) : is_lim f x l -> eventually (fun n => Finite (u n) <> x) -> is_lim_seq u x -> is_lim_seq (fun n => f (u n)) l. Proof. intros Lf Hu Lu. exact (is_lim_comp' u f x l Lu Lf Hu). Qed. (** Uniqueness *) Lemma is_lim_unique (f : R -> R) (x l : Rbar) : is_lim f x l -> Lim f x = l. Proof. intros. unfold Lim. rewrite (is_lim_seq_unique _ l) //. apply (is_lim_comp_seq f _ x l H). exists 1%nat => n Hn. case: x {H} => [x | | ] //=. apply Rbar_finite_neq, Rgt_not_eq, Rminus_lt_0. ring_simplify. by apply RinvN_pos. by apply is_lim_seq_Rbar_loc_seq. Qed. Lemma Lim_correct (f : R -> R) (x : Rbar) : ex_lim f x -> is_lim f x (Lim f x). Proof. intros (l,H). replace (Lim f x) with l. apply H. apply sym_eq, is_lim_unique, H. Qed. Lemma ex_finite_lim_correct (f : R -> R) (x : Rbar) : ex_finite_lim f x <-> ex_lim f x /\ is_finite (Lim f x). Proof. split. case => l Hf. move: (is_lim_unique f x l Hf) => Hf0. split. by exists l. by rewrite Hf0. case ; case => l Hf Hf0. exists (real l). rewrite -(is_lim_unique _ _ _ Hf). rewrite Hf0. by rewrite (is_lim_unique _ _ _ Hf). Qed. Lemma Lim_correct' (f : R -> R) (x : Rbar) : ex_finite_lim f x -> is_lim f x (real (Lim f x)). Proof. intro Hf. apply ex_finite_lim_correct in Hf. rewrite (proj2 Hf). by apply Lim_correct, Hf. Qed. (** ** Operations and order *) (** Extensionality *) Lemma is_lim_ext_loc (f g : R -> R) (x l : Rbar) : Rbar_locally' x (fun y => f y = g y) -> is_lim f x l -> is_lim g x l. Proof. apply filterlim_ext_loc. Qed. Lemma ex_lim_ext_loc (f g : R -> R) (x : Rbar) : Rbar_locally' x (fun y => f y = g y) -> ex_lim f x -> ex_lim g x. Proof. move => H [l Hf]. exists l. by apply is_lim_ext_loc with f. Qed. Lemma Lim_ext_loc (f g : R -> R) (x : Rbar) : Rbar_locally' x (fun y => f y = g y) -> Lim g x = Lim f x. Proof. move => H. apply sym_eq. apply Lim_seq_ext_loc. apply: filterlim_Rbar_loc_seq H. Qed. Lemma is_lim_ext (f g : R -> R) (x l : Rbar) : (forall y, f y = g y) -> is_lim f x l -> is_lim g x l. Proof. move => H. apply is_lim_ext_loc. by apply filter_forall. Qed. Lemma ex_lim_ext (f g : R -> R) (x : Rbar) : (forall y, f y = g y) -> ex_lim f x -> ex_lim g x. Proof. move => H [l Hf]. exists l. by apply is_lim_ext with f. Qed. Lemma Lim_ext (f g : R -> R) (x : Rbar) : (forall y, f y = g y) -> Lim g x = Lim f x. Proof. move => H. apply Lim_ext_loc. by apply filter_forall. Qed. (** Composition *) Lemma is_lim_comp (f g : R -> R) (x k l : Rbar) : is_lim f l k -> is_lim g x l -> Rbar_locally' x (fun y => Finite (g y) <> l) -> is_lim (fun x => f (g x)) x k. Proof. intros Lf Lg Hg. by apply (is_lim_comp' g f l k Lg Lf Hg). Qed. Lemma ex_lim_comp (f g : R -> R) (x : Rbar) : ex_lim f (Lim g x) -> ex_lim g x -> Rbar_locally' x (fun y => Finite (g y) <> Lim g x) -> ex_lim (fun x => f (g x)) x. Proof. intros. exists (Lim f (Lim g x)). apply is_lim_comp with (Lim g x). by apply Lim_correct. by apply Lim_correct. by apply H1. Qed. Lemma Lim_comp (f g : R -> R) (x : Rbar) : ex_lim f (Lim g x) -> ex_lim g x -> Rbar_locally' x (fun y => Finite (g y) <> Lim g x) -> Lim (fun x => f (g x)) x = Lim f (Lim g x). Proof. intros. apply is_lim_unique. apply is_lim_comp with (Lim g x). by apply Lim_correct. by apply Lim_correct. by apply H1. Qed. (** Identity *) Lemma is_lim_id (x : Rbar) : is_lim (fun y => y) x x. Proof. intros P HP. apply filterlim_id. now apply Rbar_locally'_le. Qed. Lemma ex_lim_id (x : Rbar) : ex_lim (fun y => y) x. Proof. exists x. by apply is_lim_id. Qed. Lemma Lim_id (x : Rbar) : Lim (fun y => y) x = x. Proof. apply is_lim_unique. by apply is_lim_id. Qed. (** Constant *) Lemma is_lim_const (a : R) (x : Rbar) : is_lim (fun _ => a) x a. Proof. intros P HP. now apply filterlim_const. Qed. Lemma ex_lim_const (a : R) (x : Rbar) : ex_lim (fun _ => a) x. Proof. exists a. by apply is_lim_const. Qed. Lemma Lim_const (a : R) (x : Rbar) : Lim (fun _ => a) x = a. Proof. apply is_lim_unique. by apply is_lim_const. Qed. (** *** Additive operators *) (** Opposite *) Lemma is_lim_opp (f : R -> R) (x l : Rbar) : is_lim f x l -> is_lim (fun y => - f y) x (Rbar_opp l). Proof. intros Cf. eapply filterlim_comp. apply Cf. apply filterlim_Rbar_opp. Qed. Lemma ex_lim_opp (f : R -> R) (x : Rbar) : ex_lim f x -> ex_lim (fun y => - f y) x. Proof. case => l Hf. exists (Rbar_opp l). by apply is_lim_opp. Qed. Lemma Lim_opp (f : R -> R) (x : Rbar) : Lim (fun y => - f y) x = Rbar_opp (Lim f x). Proof. rewrite -Lim_seq_opp. by apply Lim_seq_ext. Qed. (** Addition *) Lemma is_lim_plus (f g : R -> R) (x lf lg l : Rbar) : is_lim f x lf -> is_lim g x lg -> is_Rbar_plus lf lg l -> is_lim (fun y => f y + g y) x l. Proof. intros Cf Cg Hp. eapply filterlim_comp_2 ; try eassumption. by apply filterlim_Rbar_plus. Qed. Lemma is_lim_plus' (f g : R -> R) (x : Rbar) (lf lg : R) : is_lim f x lf -> is_lim g x lg -> is_lim (fun y => f y + g y) x (lf + lg). Proof. intros Hf Hg. eapply is_lim_plus. by apply Hf. by apply Hg. by []. Qed. Lemma ex_lim_plus (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> ex_Rbar_plus (Lim f x) (Lim g x) -> ex_lim (fun y => f y + g y) x. Proof. move => /Lim_correct Hf /Lim_correct Hg Hl. exists (Rbar_plus (Lim f x) (Lim g x)). eapply is_lim_plus ; try eassumption. by apply Rbar_plus_correct. Qed. Lemma Lim_plus (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> ex_Rbar_plus (Lim f x) (Lim g x) -> Lim (fun y => f y + g y) x = Rbar_plus (Lim f x) (Lim g x). Proof. move => /Lim_correct Hf /Lim_correct Hg Hl. apply is_lim_unique. eapply is_lim_plus ; try eassumption. by apply Rbar_plus_correct. Qed. (** Subtraction *) Lemma is_lim_minus (f g : R -> R) (x lf lg l : Rbar) : is_lim f x lf -> is_lim g x lg -> is_Rbar_minus lf lg l -> is_lim (fun y => f y - g y) x l. Proof. move => Hf Hg Hl. eapply is_lim_plus ; try eassumption. now apply is_lim_opp. Qed. Lemma is_lim_minus' (f g : R -> R) (x : Rbar) (lf lg : R) : is_lim f x lf -> is_lim g x lg -> is_lim (fun y => f y - g y) x (lf - lg). Proof. intros Hf Hg. eapply is_lim_minus ; try eassumption. by []. Qed. Lemma ex_lim_minus (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> ex_Rbar_minus (Lim f x) (Lim g x) -> ex_lim (fun y => f y - g y) x. Proof. move => Hf Hg Hl. apply ex_lim_plus. by apply Hf. apply ex_lim_opp. by apply Hg. rewrite Lim_opp. by apply Hl. Qed. Lemma Lim_minus (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> ex_Rbar_minus (Lim f x) (Lim g x) -> Lim (fun y => f y - g y) x = Rbar_minus (Lim f x) (Lim g x). Proof. move => Hf Hg Hl. rewrite Lim_plus. by rewrite Lim_opp. by apply Hf. apply ex_lim_opp. by apply Hg. rewrite Lim_opp. by apply Hl. Qed. (** ** Multiplicative operators *) (** Multiplicative inverse *) Lemma is_lim_inv (f : R -> R) (x l : Rbar) : is_lim f x l -> l <> 0 -> is_lim (fun y => / f y) x (Rbar_inv l). Proof. intros Hf Hl. apply filterlim_comp with (1 := Hf). now apply filterlim_Rbar_inv. Qed. Lemma ex_lim_inv (f : R -> R) (x : Rbar) : ex_lim f x -> Lim f x <> 0 -> ex_lim (fun y => / f y) x. Proof. move => /Lim_correct Hf Hlf. exists (Rbar_inv (Lim f x)). by apply is_lim_inv. Qed. Lemma Lim_inv (f : R -> R) (x : Rbar) : ex_lim f x -> Lim f x <> 0 -> Lim (fun y => / f y) x = Rbar_inv (Lim f x). Proof. move => /Lim_correct Hf Hlf. apply is_lim_unique. by apply is_lim_inv. Qed. (** Multiplication *) Lemma is_lim_mult (f g : R -> R) (x lf lg : Rbar) : is_lim f x lf -> is_lim g x lg -> ex_Rbar_mult lf lg -> is_lim (fun y => f y * g y) x (Rbar_mult lf lg). Proof. intros Cf Cg Hp. eapply filterlim_comp_2 ; try eassumption. by apply filterlim_Rbar_mult, Rbar_mult_correct. Qed. Lemma ex_lim_mult (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> ex_Rbar_mult (Lim f x) (Lim g x) -> ex_lim (fun y => f y * g y) x. Proof. move => /Lim_correct Hf /Lim_correct Hg Hl. exists (Rbar_mult (Lim f x) (Lim g x)). now apply is_lim_mult. Qed. Lemma Lim_mult (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> ex_Rbar_mult (Lim f x) (Lim g x) -> Lim (fun y => f y * g y) x = Rbar_mult (Lim f x) (Lim g x). Proof. move => /Lim_correct Hf /Lim_correct Hg Hl. apply is_lim_unique. now apply is_lim_mult. Qed. (** Scalar multiplication *) Lemma is_lim_scal_l (f : R -> R) (a : R) (x l : Rbar) : is_lim f x l -> is_lim (fun y => a * f y) x (Rbar_mult a l). Proof. move => Hf. case: (Req_dec 0 a) => [<- {a} | Ha]. rewrite Rbar_mult_0_l. apply is_lim_ext with (fun _ => 0). move => y ; by rewrite Rmult_0_l. by apply is_lim_const. apply is_lim_mult. by apply is_lim_const. by apply Hf. apply sym_not_eq in Ha. case: l {Hf} => [l | | ] //=. Qed. Lemma ex_lim_scal_l (f : R -> R) (a : R) (x : Rbar) : ex_lim f x -> ex_lim (fun y => a * f y) x. Proof. case => l Hf. exists (Rbar_mult a l). by apply is_lim_scal_l. Qed. Lemma Lim_scal_l (f : R -> R) (a : R) (x : Rbar) : Lim (fun y => a * f y) x = Rbar_mult a (Lim f x). Proof. apply Lim_seq_scal_l. Qed. Lemma is_lim_scal_r (f : R -> R) (a : R) (x l : Rbar) : is_lim f x l -> is_lim (fun y => f y * a) x (Rbar_mult l a). Proof. move => Hf. rewrite Rbar_mult_comm. apply is_lim_ext with (fun y => a * f y). move => y ; by apply Rmult_comm. by apply is_lim_scal_l. Qed. Lemma ex_lim_scal_r (f : R -> R) (a : R) (x : Rbar) : ex_lim f x -> ex_lim (fun y => f y * a) x. Proof. case => l Hf. exists (Rbar_mult l a). by apply is_lim_scal_r. Qed. Lemma Lim_scal_r (f : R -> R) (a : R) (x : Rbar) : Lim (fun y => f y * a) x = Rbar_mult (Lim f x) a. Proof. rewrite Rbar_mult_comm -Lim_seq_scal_l. apply Lim_seq_ext. move => y ; by apply Rmult_comm. Qed. (** Division *) Lemma is_lim_div (f g : R -> R) (x lf lg : Rbar) : is_lim f x lf -> is_lim g x lg -> lg <> 0 -> ex_Rbar_div lf lg -> is_lim (fun y => f y / g y) x (Rbar_div lf lg). Proof. move => Hf Hg Hlg Hl. apply is_lim_mult ; try assumption. now apply is_lim_inv. Qed. Lemma ex_lim_div (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> Lim g x <> 0 -> ex_Rbar_div (Lim f x) (Lim g x) -> ex_lim (fun y => f y / g y) x. Proof. move => Hf Hg Hlg Hl. apply ex_lim_mult ; try assumption. now apply ex_lim_inv. now rewrite Lim_inv. Qed. Lemma Lim_div (f g : R -> R) (x : Rbar) : ex_lim f x -> ex_lim g x -> Lim g x <> 0 -> ex_Rbar_div (Lim f x) (Lim g x) -> Lim (fun y => f y / g y) x = Rbar_div (Lim f x) (Lim g x). Proof. move => Hf Hg Hlg Hl. apply is_lim_unique. apply is_lim_div ; try apply Lim_correct ; assumption. Qed. (** Composition by linear functions *) Lemma is_lim_comp_lin (f : R -> R) (a b : R) (x l : Rbar) : is_lim f (Rbar_plus (Rbar_mult a x) b) l -> a <> 0 -> is_lim (fun y => f (a * y + b)) x l. Proof. move => Hf Ha. apply is_lim_comp with (Rbar_plus (Rbar_mult a x) b). by apply Hf. eapply is_lim_plus. apply is_lim_scal_l. apply is_lim_id. apply is_lim_const. apply Rbar_plus_correct. case: (Rbar_mult a x) => //. case: x {Hf} => [x | | ] //=. exists (mkposreal _ Rlt_0_1) => y _ Hy. apply Rbar_finite_neq, Rminus_not_eq ; ring_simplify (a * y + b - (a * x + b)). rewrite -Rmult_minus_distr_l. apply Rmult_integral_contrapositive ; split. by []. by apply Rminus_eq_contra. exists 0 => x Hx. apply sym_not_eq in Ha. case: Rle_dec => // H. case: Rle_lt_or_eq_dec => //. exists 0 => x Hx. apply sym_not_eq in Ha. case: Rle_dec => // H. case: Rle_lt_or_eq_dec => //. Qed. Lemma ex_lim_comp_lin (f : R -> R) (a b : R) (x : Rbar) : ex_lim f (Rbar_plus (Rbar_mult a x) b) -> ex_lim (fun y => f (a * y + b)) x. Proof. case => l Hf. case: (Req_dec a 0) => [-> {a Hf} | Ha]. apply ex_lim_ext with (fun _ => f b). move => y ; by rewrite Rmult_0_l Rplus_0_l. by apply ex_lim_const. exists l ; by apply is_lim_comp_lin. Qed. Lemma Lim_comp_lin (f : R -> R) (a b : R) (x : Rbar) : ex_lim f (Rbar_plus (Rbar_mult a x) b) -> a <> 0 -> Lim (fun y => f (a * y + b)) x = Lim f (Rbar_plus (Rbar_mult a x) b). Proof. move => Hf Ha. apply is_lim_unique. apply is_lim_comp_lin. by apply Lim_correct. exact: Ha. Qed. (** Continuity and limit *) Lemma is_lim_continuity (f : R -> R) (x : R) : continuity_pt f x -> is_lim f x (f x). Proof. intros cf. now apply continuity_pt_filterlim'. Qed. Lemma ex_lim_continuity (f : R -> R) (x : R) : continuity_pt f x -> ex_finite_lim f x. Proof. move => Hf. exists (f x). by apply is_lim_continuity. Qed. Lemma Lim_continuity (f : R -> R) (x : R) : continuity_pt f x -> Lim f x = f x. Proof. move => Hf. apply is_lim_unique. by apply is_lim_continuity. Qed. Lemma C0_extension_right {T : UniformSpace} (f : R -> T) lb (a b : R) : a < b -> (forall c : R, a < c < b -> filterlim f (locally c) (locally (f c))) -> (filterlim f (at_left b) (locally lb)) -> {g : R -> T | (forall c, a < c -> filterlim g (locally c) (locally (g c))) /\ (forall c : R, c < b -> g c = f c) /\ g b = lb}. Proof. intros Hab ; intros. set g := fun x => match Rlt_dec x b with | left _ => f x | right _ => lb end. assert (Gab : forall c : R, c < b -> g c = f c). intros c Hcb. unfold g. by (case: Rlt_dec). assert (Gb : forall c : R, b <= c -> g c = lb). intros c Hbc. unfold g. case: Rlt_dec (Rle_not_lt _ _ Hbc) => //. exists g ; split. intros c Hac. case: (Rlt_le_dec c b) ; (try case) => Hbc. - apply filterlim_ext_loc with f. apply locally_interval with m_infty b => //= y _ Hyb. by apply sym_eq, Gab. rewrite Gab //. apply H ; by split. - rewrite Gb. 2: by apply Rlt_le. eapply filterlim_ext_loc. 2: by apply filterlim_const. apply locally_interval with b p_infty => //= y Hby _. apply sym_eq, Gb. by apply Rlt_le. - rewrite -Hbc => {c Hbc Hac}. rewrite Gb. 2: by apply Rle_refl. apply filterlim_locally => eps /= {H}. destruct (proj1 (filterlim_locally _ _) H0 eps) as [d Hd]. simpl in Hd. exists d => x Hx. case: (Rlt_le_dec x b) => Hxb. rewrite Gab //. by apply Hd. rewrite Gb //. by apply ball_center. - split. by apply Gab. apply Gb ; by apply Rle_refl. Qed. Lemma filterlim_Ropp_left (x : R) : filterlim Ropp (at_left x) (at_right (- x)). Proof. move => P [d /= Hd]. exists d => y /= Hy Hy'. apply Hd. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. rewrite -Ropp_plus_distr Rabs_Ropp. by apply Hy. by apply Ropp_lt_contravar. Qed. Lemma filterlim_Ropp_right (x : R) : filterlim Ropp (at_right x) (at_left (- x)). Proof. move => P [d /= Hd]. exists d => y /= Hy Hy'. apply Hd. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. rewrite -Ropp_plus_distr Rabs_Ropp. by apply Hy. by apply Ropp_lt_contravar. Qed. Lemma C0_extension_left {T : UniformSpace} (f : R -> T) la (a b : R) : a < b -> (forall c : R, a < c < b -> filterlim f (locally c) (locally (f c))) -> (filterlim f (at_right a) (locally la)) -> {g : R -> T | (forall c, c < b -> filterlim g (locally c) (locally (g c))) /\ (forall c : R, a < c -> g c = f c) /\ g a = la}. Proof. intros. destruct (C0_extension_right (fun x => f (- x)) la (-b) (-a)) as [g Hg]. by apply Ropp_lt_contravar. intros. eapply filterlim_comp. apply (filterlim_opp c). apply H0. split ; apply Ropp_lt_cancel ; rewrite Ropp_involutive ; by apply H2. eapply filterlim_comp. apply filterlim_Ropp_left. by rewrite Ropp_involutive. exists (fun x => g (- x)) ; split. intros c Hc. eapply filterlim_comp. apply (filterlim_opp c). by apply Hg, Ropp_lt_contravar. split. intros c Hc. rewrite (proj1 (proj2 Hg)). by rewrite Ropp_involutive. by apply Ropp_lt_contravar. by apply Hg. Qed. Lemma C0_extension_lt {T : UniformSpace} (f : R -> T) la lb (a b : R) : a < b -> (forall c : R, a < c < b -> filterlim f (locally c) (locally (f c))) -> (filterlim f (at_right a) (locally la)) -> (filterlim f (at_left b) (locally lb)) -> {g : R -> T | (forall c, filterlim g (locally c) (locally (g c))) /\ (forall c : R, a < c < b -> g c = f c) /\ g a = la /\ g b = lb}. Proof. intros. destruct (C0_extension_left f la a b) as [g [Cg [Gab Ga]]] => //. destruct (C0_extension_right g lb a b) as [h [Ch [Hab Hb]]] => //. intros. apply Cg, H3. eapply filterlim_ext_loc. 2: by apply H2. apply Rminus_lt_0 in H. exists (mkposreal _ H) => y /= Hy Hy'. apply sym_eq, Gab. apply Ropp_lt_cancel, (Rplus_lt_reg_l b). eapply Rle_lt_trans, Hy. rewrite -abs_opp opp_minus. apply Rle_abs. exists h ; repeat split. intros c. case: (Rlt_le_dec a c) => Hac. by apply Ch. rewrite Hab. eapply filterlim_ext_loc. 2: apply Cg. apply locally_interval with m_infty b => //. by eapply Rle_lt_trans, H. intros y _ Hy ; by apply sym_eq, Hab. by eapply Rle_lt_trans, H. by eapply Rle_lt_trans, H. intros c [Hac Hcb]. rewrite Hab => //. by apply Gab. by rewrite Hab. by []. Qed. Lemma C0_extension_le {T : UniformSpace} (f : R -> T) (a b : R) : (forall c : R, a <= c <= b -> filterlim f (locally c) (locally (f c))) -> {g : R -> T | (forall c, filterlim g (locally c) (locally (g c))) /\ (forall c : R, a <= c <= b -> g c = f c)}. Proof. intros. case: (Rlt_le_dec a b) => Hab. destruct (C0_extension_lt f (f a) (f b) a b Hab) as [g [Cg [Gab [Ga Gb]]]]. intros c Hc. apply H ; split ; apply Rlt_le, Hc. eapply filterlim_filter_le_1, H. by apply filter_le_within. intuition. eapply filterlim_filter_le_1, H. by apply filter_le_within. intuition. exists g ; repeat split => //. intros c [Hac Hcb]. case: Hac => [ Hac | <-] //. case: Hcb => [ Hcb | ->] //. apply Gab ; by split. exists (fun _ => f a) ; split ; simpl. move => c. by apply filterlim_const. intros c [Hac Hca]. case: Hab => Hab. contradict Hab ; apply Rle_not_lt. by apply Rle_trans with c. rewrite Hab in Hca. by apply f_equal, Rle_antisym. Qed. Lemma bounded_continuity {K : AbsRing} {V : NormedModule K} (f : R -> V) a b : (forall x, a <= x <= b -> filterlim f (locally x) (locally (f x))) -> {M : R | forall x, a <= x <= b -> norm (f x) < M}. Proof. destruct (Rle_dec b a) as [Hab|Hab]. exists (norm (f a) + 1). intros x [Hax Hxb]. replace x with a. rewrite -{1}(Rplus_0_r (norm (f a))). apply Rplus_lt_compat_l, Rlt_0_1. apply Rle_antisym with (1 := Hax). now apply Rle_trans with b. apply Rnot_le_lt in Hab. wlog: f / (forall x, filterlim f (locally x) (locally (f x))) => [ Hw Cf | Cf _ ]. destruct (C0_extension_le f a b) as [g [Cg Hg]]. by apply Cf. destruct (Hw g) as [M HM] => //. exists M ; intros. rewrite -Hg //. by apply HM. assert (forall x : R, locally x (fun y : R => Rabs (norm (f y) - norm (f x)) < 1)). intro x. generalize (proj1 (filterlim_locally_ball_norm _ _) (Cf x)) => {} Cf. apply: filter_imp (Cf (mkposreal _ Rlt_0_1)) => y Hy. apply Rle_lt_trans with (2 := Hy). apply norm_triangle_inv. assert (forall x y : R, Rabs (norm (f y) - norm (f x)) < 1 \/ ~ Rabs (norm (f y) - norm (f x)) < 1). intros x y ; edestruct Rlt_dec. left ; by apply r. by right. set delta := (fun (x : R) => proj1_sig (locally_ex_dec x _ (H0 x) (H x))). destruct (compactness_value_1d a b delta) as [d Hd]. destruct (nfloor_ex ((b - a) / d)) as [N HN]. apply Rdiv_le_0_compat. now apply Rlt_le, Rlt_Rminus. apply cond_pos. set (M := (fix g n := match n with O => 0 | S n => Rmax (norm (f (a + INR n * d)) + 3) (g n) end) (S N)). exists M => x Hx. apply Rnot_le_lt => H2. apply (Hd x Hx) ; case => t. unfold delta. case: locally_ex_dec => e /= He [Ht [Hxt Hde]]. contradict H2 ; apply Rlt_not_le. move: (fun (y : R) Hy => He y (norm_compat1 _ _ _ Hy)) => {} He. apply He in Hxt. rewrite -(Rabs_pos_eq (norm _) (norm_ge_0 _)). replace (norm (f x)) with ((norm (f x) - norm (f t)) + norm (f t))%R by ring. eapply Rle_lt_trans. apply Rabs_triang. eapply Rlt_trans. apply Rplus_lt_compat_r. by apply Hxt. rewrite Rplus_comm ; apply Rlt_minus_r. clear x Hx Hxt. destruct (nfloor_ex ((t - a) / d)) as [n Hn]. apply Rdiv_le_0_compat. apply Rplus_le_reg_r with a. now ring_simplify. apply cond_pos. set (y := a + INR n * d). replace (norm (f t)) with (-(norm (f y) - norm (f t)) + norm (f y))%R by ring. eapply Rle_lt_trans. apply Rabs_triang. eapply Rlt_trans. apply Rplus_lt_compat_r. rewrite Rabs_Ropp. apply He. change (Rabs (a + INR n * d - t) < e). replace (a + INR n * d - t) with (-((t - a) / d - INR n) * d). rewrite Rabs_mult (Rabs_pos_eq d). 2: apply Rlt_le, cond_pos. apply Rlt_le_trans with (1 * d). apply Rmult_lt_compat_r with (1 := cond_pos d). rewrite Rabs_Ropp Rabs_pos_eq. apply Rplus_lt_reg_r with (INR n). now rewrite /Rminus Rplus_assoc Rplus_opp_l Rplus_0_r (Rplus_comm 1). apply Rplus_le_reg_r with (INR n). now ring_simplify. now rewrite Rmult_1_l. field. apply Rgt_not_eq, cond_pos. apply Rplus_lt_reg_l with 1. ring_simplify. rewrite -> Rabs_pos_eq by apply norm_ge_0. assert (n < S N)%nat. apply INR_lt. apply Rle_lt_trans with (1 := proj1 Hn). rewrite S_INR. apply Rle_lt_trans with (2 := proj2 HN). apply Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat, cond_pos. now apply Rplus_le_compat_r. unfold M, y. clear -H1. induction N. apply Rlt_le_trans with (2 := Rmax_l _ _). destruct n. apply Rplus_lt_compat_l, Rplus_lt_compat_l. now apply (IZR_lt 1 2). now apply <-Nat.succ_lt_mono in H1. destruct (le_lt_eq_dec _ _ H1) as [H2%Nat.succ_lt_mono | [= ->]]. - now apply Rlt_le_trans with (2 := Rmax_r _ _), IHN. - apply Rlt_le_trans with (2 := Rmax_l _ _). now apply Rplus_lt_compat_l, IZR_lt. Qed. (** *** Order *) Lemma is_lim_le_loc (f g : R -> R) (x lf lg : Rbar) : Rbar_locally' x (fun y => f y <= g y) -> is_lim f x lf -> is_lim g x lg -> Rbar_le lf lg. Proof. apply filterlim_le. Qed. Lemma is_lim_le_p_loc (f g : R -> R) (x : Rbar) : Rbar_locally' x (fun y => f y <= g y) -> is_lim f x p_infty -> is_lim g x p_infty. Proof. apply filterlim_ge_p_infty. Qed. Lemma is_lim_le_m_loc (f g : R -> R) (x : Rbar) : Rbar_locally' x (fun y => g y <= f y) -> is_lim f x m_infty -> is_lim g x m_infty. Proof. apply filterlim_le_m_infty. Qed. Lemma is_lim_le_le_loc (f g h : R -> R) (x : Rbar) (l : Rbar) : Rbar_locally' x (fun y => f y <= h y <= g y) -> is_lim f x l -> is_lim g x l -> is_lim h x l. Proof. apply filterlim_le_le. Qed. (** ** Generalized intermediate value theorem *) Lemma IVT_gen (f : R -> R) (a b y : R) : Ranalysis1.continuity f -> Rmin (f a) (f b) <= y <= Rmax (f a) (f b) -> { x : R | Rmin a b <= x <= Rmax a b /\ f x = y }. Proof. case: (Req_EM_T a b) => [ <- {b} | Hab]. rewrite /Rmin /Rmax ; case: Rle_dec (Rle_refl a) (Rle_refl (f a)) ; case: Rle_dec => // _ _ _ _ Cf Hy. exists a ; split. split ; by apply Rle_refl. apply Rle_antisym ; by apply Hy. wlog: a b Hab / (a < b) => [Hw | {} Hab]. case: (Rle_lt_dec a b) => Hab'. case: (Rle_lt_or_eq_dec _ _ Hab') => {Hab'} // Hab'. by apply Hw. rewrite (Rmin_comm (f a)) (Rmin_comm a) (Rmax_comm (f a)) (Rmax_comm a) ; apply Hw => //. by apply Rlt_not_eq. rewrite /(Rmin a) /(Rmax a) ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. wlog: f y / (f a <= f b) => [Hw |]. case: (Rle_lt_dec (f a) (f b)) => Hf' Hf Hy. by apply Hw. case: (Hw (fun y => - f y) (- y)). by apply Ropp_le_contravar, Rlt_le. by apply Ranalysis1.continuity_opp. rewrite Rmin_opp_Rmax Rmax_opp_Rmin ; split ; apply Ropp_le_contravar, Hy. move => x [Hx Hfx]. exists x ; intuition. by rewrite -(Ropp_involutive y) -Hfx Ropp_involutive. rewrite /Rmin /Rmax ; case: Rle_dec => // _ _. wlog: y / (f a < y < f b) => [Hw Hf Hy | Hy Hf _]. case: Hy => Hay Hyb. case: (Rle_lt_or_eq_dec _ _ Hay) => {Hay} [Hay | <- ]. case: (Rle_lt_or_eq_dec _ _ Hyb) => {Hyb} [Hyb | -> ]. apply Hw ; intuition. exists b ; intuition. exists a ; intuition. case (IVT (fun x => f x - y) a b). apply Ranalysis1.continuity_minus. exact Hf. apply continuity_const. intros _ _ ; reflexivity. exact Hab. apply Rlt_minus_l ; rewrite Rplus_0_l ; apply Hy. apply Rlt_minus_r ; rewrite Rplus_0_l ; apply Hy. intros x [Hx Hfx]. apply Rminus_diag_uniq in Hfx. by exists x. Qed. Lemma IVT_Rbar_incr (f : R -> R) (a b la lb : Rbar) (y : R) : is_lim f a la -> is_lim f b lb -> (forall (x : R), Rbar_lt a x -> Rbar_lt x b -> continuity_pt f x) -> Rbar_lt a b -> Rbar_lt la y /\ Rbar_lt y lb -> {x : R | Rbar_lt a x /\ Rbar_lt x b /\ f x = y}. Proof. intros Hfa Hfb Cf Hab Hy. assert (Hb' : exists b' : R, Rbar_lt b' b /\ is_upper_bound (fun x => Rbar_lt a x /\ Rbar_lt x b /\ f x <= y) b'). { assert (Hfb' : Rbar_locally' b (fun x => y < f x)). apply Hfb. now apply (open_Rbar_gt' _ y). clear -Hab Hfb'. destruct b as [b| |]. - destruct Hfb' as [eps He]. exists (b - eps). split. apply Rminus_lt_0. replace (b - (b - eps)) with (pos eps) by ring. apply cond_pos. intros u [_ [H1 H2]]. apply Rnot_lt_le. intros Hu. apply Rle_not_lt with (1 := H2). apply He. apply Rabs_lt_between'. split. exact Hu. apply Rlt_le_trans with (1 := H1). apply Rlt_le. apply Rminus_lt_0. replace (b + eps - b) with (pos eps) by ring. apply cond_pos. now apply Rlt_not_eq. - destruct Hfb' as [M HM]. exists M. repeat split. intros u [_ [H1 H2]]. apply Rnot_lt_le. intros Hu. apply Rle_not_lt with (1 := H2). now apply HM. - now destruct a. } assert (Hex : exists x : R, Rbar_lt a x /\ Rbar_lt x b /\ f x <= y). { assert (Hfa' : Rbar_locally' a (fun x => Rbar_lt x b /\ f x < y)). apply filter_and. apply Rbar_locally'_le. now apply open_Rbar_lt'. apply (Hfa (fun u => u < y)). now apply (open_Rbar_lt' _ y). clear -Hab Hfa'. destruct a as [a| |]. - destruct Hfa' as [eps He]. exists (a + eps / 2). assert (Ha : a < a + eps / 2). apply Rminus_lt_0. replace (a + eps / 2 - a) with (eps / 2) by ring. apply is_pos_div_2. split. exact Ha. assert (H : Rbar_lt (a + eps / 2) b /\ (f (a + eps / 2) < y)). apply He. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. replace (a + eps / 2 + - a) with (eps / 2) by ring. rewrite Rabs_pos_eq. apply Rlt_eps2_eps. apply cond_pos. apply Rlt_le. apply is_pos_div_2. now apply Rgt_not_eq. destruct H as [H1 H2]. split. exact H1. now apply Rlt_le. - easy. - destruct Hfa' as [M HM]. exists (M - 1). assert (H : Rbar_lt (M - 1) b /\ f (M - 1) < y). apply HM. apply Rminus_lt_0. replace (M - (M - 1)) with 1 by ring. apply Rlt_0_1. destruct H as [H1 H2]. repeat split. exact H1. now apply Rlt_le. } destruct (completeness (fun x => Rbar_lt a x /\ Rbar_lt x b /\ f x <= y)) as [x [Hub Hlub]]. destruct Hb' as [b' Hb']. now exists b'. exact Hex. exists x. destruct Hb' as [b' [Hb Hb']]. destruct Hex as [x' Hx']. assert (Hax : Rbar_lt a x). apply Rbar_lt_le_trans with x'. apply Hx'. now apply Hub. assert (Hxb : Rbar_lt x b). apply Rbar_le_lt_trans with b'. now apply Hlub. exact Hb. repeat split ; try assumption. specialize (Cf _ Hax Hxb). apply continuity_pt_filterlim in Cf. destruct (total_order_T (f x) y) as [[H|H]|H]. - assert (H': locally x (fun u => (Rbar_lt a u /\ Rbar_lt u b) /\ f u < y)). apply filter_and. apply filter_and. now apply open_Rbar_gt. now apply open_Rbar_lt. apply (Cf (fun u => u < y)). now apply open_lt. destruct H' as [eps H']. elim Rle_not_lt with x (x + eps / 2). apply Hub. destruct (H' (x + eps / 2)) as [[H1 H2] H3]. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. replace (x + eps / 2 + - x) with (eps / 2) by ring. rewrite Rabs_pos_eq. apply Rlt_eps2_eps. apply cond_pos. apply Rlt_le. apply is_pos_div_2. split. exact H1. split. exact H2. now apply Rlt_le. apply Rminus_lt_0. replace (x + eps / 2 - x) with (eps / 2) by ring. apply is_pos_div_2. - exact H. - assert (H': locally x (fun u => y < f u)). apply (Cf (fun u => y < u)). now apply open_gt. destruct H' as [eps H']. elim Rle_not_lt with (x - eps) x. apply Hlub. intros u Hfu. apply Rnot_lt_le. intros Hu. apply Rle_not_lt with (1 := proj2 (proj2 Hfu)). apply H'. apply Rabs_lt_between'. split. exact Hu. apply Rle_lt_trans with (1 := Hub u Hfu). apply Rminus_lt_0. replace (x + eps - x) with (pos eps) by ring. apply cond_pos. apply Rminus_lt_0. replace (x - (x - eps)) with (pos eps) by ring. apply cond_pos. Qed. Lemma IVT_Rbar_decr (f : R -> R) (a b la lb : Rbar) (y : R) : is_lim f a la -> is_lim f b lb -> (forall (x : R), Rbar_lt a x -> Rbar_lt x b -> continuity_pt f x) -> Rbar_lt a b -> Rbar_lt lb y /\ Rbar_lt y la -> {x : R | Rbar_lt a x /\ Rbar_lt x b /\ f x = y}. Proof. move => Hla Hlb Cf Hab Hy. case: (IVT_Rbar_incr (fun x => - f x) a b (Rbar_opp la) (Rbar_opp lb) (-y)). by apply is_lim_opp. by apply is_lim_opp. move => x Hax Hxb. by apply continuity_pt_opp, Cf. by apply Hab. split ; apply Rbar_opp_lt ; rewrite Rbar_opp_involutive /Rbar_opp Ropp_involutive ; by apply Hy. move => x Hx ; exists x ; intuition. by rewrite -(Ropp_involutive y) -H4 Ropp_involutive. Qed. (** * 2D-continuity *) (** ** Definitions *) Definition continuity_2d_pt f x y := forall eps : posreal, locally_2d (fun u v => Rabs (f u v - f x y) < eps) x y. Lemma continuity_2d_pt_filterlim : forall f x y, continuity_2d_pt f x y <-> filterlim (fun z : R * R => f (fst z) (snd z)) (locally (x,y)) (locally (f x y)). Proof. split. - intros Cf P [eps He]. specialize (Cf eps). apply locally_2d_locally in Cf. apply filter_imp with (2 := Cf). intros [u v]. apply He. - intros Cf eps. apply locally_2d_locally. specialize (Cf (fun z => Rabs (z - f x y) < eps)). unfold filtermap in Cf. apply Cf. now exists eps. Qed. Lemma uniform_continuity_2d : forall f a b c d, (forall x y, a <= x <= b -> c <= y <= d -> continuity_2d_pt f x y) -> forall eps : posreal, exists delta : posreal, forall x y u v, a <= x <= b -> c <= y <= d -> a <= u <= b -> c <= v <= d -> Rabs (u - x) < delta -> Rabs (v - y) < delta -> Rabs (f u v - f x y) < eps. Proof. intros f a b c d Cf eps. set (P x y u v := Rabs (f u v - f x y) < pos_div_2 eps). refine (_ (fun x y Hx Hy => locally_2d_ex_dec (P x y) x y _ (Cf x y Hx Hy _))). intros delta1. set (delta2 x y := match Rle_dec a x, Rle_dec x b, Rle_dec c y, Rle_dec y d with left Ha, left Hb, left Hc, left Hd => pos_div_2 (proj1_sig (delta1 x y (conj Ha Hb) (conj Hc Hd))) | _, _, _, _ => mkposreal _ Rlt_0_1 end). destruct (compactness_value_2d a b c d delta2) as (delta,Hdelta). exists (pos_div_2 delta) => x y u v Hx Hy Hu Hv Hux Hvy. specialize (Hdelta x y Hx Hy). apply Rnot_le_lt. apply: false_not_not Hdelta => Hdelta. apply Rlt_not_le. destruct Hdelta as (p&q&(Hap,Hpb)&(Hcq,Hqd)&Hxp&Hyq&Hd). replace (f u v - f x y) with (f u v - f p q + (f p q - f x y)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite (double_var eps). revert Hxp Hyq Hd. unfold delta2. case Rle_dec => Hap' ; try easy. case Rle_dec => Hpb' ; try easy. case Rle_dec => Hcq' ; try easy. case Rle_dec => Hqd' ; try easy. clear delta2. case delta1 => /= r Hr Hxp Hyq Hd. apply Rplus_lt_compat. apply Hr. replace (u - p) with (u - x + (x - p)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite (double_var r). apply Rplus_lt_compat with (2 := Hxp). apply Rlt_le_trans with (2 := Hd). apply Rlt_trans with (1 := Hux). apply: Rlt_eps2_eps. apply cond_pos. replace (v - q) with (v - y + (y - q)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite (double_var r). apply Rplus_lt_compat with (2 := Hyq). apply Rlt_le_trans with (2 := Hd). apply Rlt_trans with (1 := Hvy). apply: Rlt_eps2_eps. apply cond_pos. rewrite Rabs_minus_sym. apply Hr. apply Rlt_trans with (1 := Hxp). apply Rlt_eps2_eps. apply cond_pos. apply Rlt_trans with (1 := Hyq). apply Rlt_eps2_eps. apply cond_pos. intros u v. unfold P. destruct (Rlt_dec (Rabs (f u v - f x y)) (pos_div_2 eps)) ; [left|right]; assumption. Qed. Lemma uniform_continuity_2d_1d : forall f a b c, (forall x, a <= x <= b -> continuity_2d_pt f x c) -> forall eps : posreal, exists delta : posreal, forall x y u v, a <= x <= b -> c - delta <= y <= c + delta -> a <= u <= b -> c - delta <= v <= c + delta -> Rabs (u - x) < delta -> Rabs (f u v - f x y) < eps. Proof. intros f a b c Cf eps. set (P x y u v := Rabs (f u v - f x y) < pos_div_2 eps). refine (_ (fun x Hx => locally_2d_ex_dec (P x c) x c _ (Cf x Hx _))). intros delta1. set (delta2 x := match Rle_dec a x, Rle_dec x b with left Ha, left Hb => pos_div_2 (proj1_sig (delta1 x (conj Ha Hb))) | _, _ => mkposreal _ Rlt_0_1 end). destruct (compactness_value_1d a b delta2) as (delta,Hdelta). exists (pos_div_2 delta) => x y u v Hx Hy Hu Hv Hux. specialize (Hdelta x Hx). apply Rnot_le_lt. apply: false_not_not Hdelta => Hdelta. apply Rlt_not_le. destruct Hdelta as (p&(Hap,Hpb)&Hxp&Hd). replace (f u v - f x y) with (f u v - f p c + (f p c - f x y)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite (double_var eps). revert Hxp Hd. unfold delta2. case Rle_dec => Hap' ; try easy. case Rle_dec => Hpb' ; try easy. clear delta2. case delta1 => /= r Hr Hxp Hd. apply Rplus_lt_compat. apply Hr. replace (u - p) with (u - x + (x - p)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite (double_var r). apply Rplus_lt_compat with (2 := Hxp). apply Rlt_le_trans with (2 := Hd). apply Rlt_trans with (1 := Hux). apply: Rlt_eps2_eps. apply cond_pos. apply Rle_lt_trans with (pos_div_2 delta). now apply Rabs_le_between'. apply Rlt_le_trans with(1 := Rlt_eps2_eps _ (cond_pos delta)). apply Rle_trans with (1 := Hd). apply Rlt_le. apply Rlt_eps2_eps. apply cond_pos. rewrite Rabs_minus_sym. apply Hr. apply Rlt_trans with (1 := Hxp). apply Rlt_eps2_eps. apply cond_pos. apply Rle_lt_trans with (pos_div_2 delta). now apply Rabs_le_between'. apply Rlt_le_trans with(1 := Rlt_eps2_eps _ (cond_pos delta)). apply Rle_trans with (1 := Hd). apply Rlt_le. apply Rlt_eps2_eps. apply cond_pos. intros u v. unfold P. destruct (Rlt_dec (Rabs (f u v - f x c)) (pos_div_2 eps)); [left|right] ; assumption. Qed. Lemma uniform_continuity_2d_1d' : forall f a b c, (forall x, a <= x <= b -> continuity_2d_pt f c x) -> forall eps : posreal, exists delta : posreal, forall x y u v, a <= x <= b -> c - delta <= y <= c + delta -> a <= u <= b -> c - delta <= v <= c + delta -> Rabs (u - x) < delta -> Rabs (f v u - f y x) < eps. Proof. intros f a b c Cf eps. assert (T:(forall x : R, a <= x <= b -> continuity_2d_pt (fun x0 y : R => f y x0) x c) ). intros x Hx e. destruct (Cf x Hx e) as (d,Hd). exists d. intros; now apply Hd. destruct (uniform_continuity_2d_1d (fun x y => f y x) a b c T eps) as (d,Hd). exists d; intros. now apply Hd. Qed. Lemma continuity_2d_pt_neq_0 : forall f x y, continuity_2d_pt f x y -> f x y <> 0 -> locally_2d (fun u v => f u v <> 0) x y. Proof. intros f x y Cf H. apply continuity_2d_pt_filterlim in Cf. apply locally_2d_locally. apply (Cf (fun y => y <> 0)). now apply open_neq. Qed. (** ** Operations *) (** Identity *) Lemma continuity_pt_id : forall x, continuity_pt (fun x => x) x. Proof. intros x. apply continuity_pt_filterlim. now intros P. Qed. Lemma continuity_2d_pt_id1 : forall x y, continuity_2d_pt (fun u v => u) x y. Proof. intros x y eps; exists eps; tauto. Qed. Lemma continuity_2d_pt_id2 : forall x y, continuity_2d_pt (fun u v => v) x y. Proof. intros x y eps; exists eps; tauto. Qed. (** Constant functions *) Lemma continuity_2d_pt_const : forall x y c, continuity_2d_pt (fun u v => c) x y. Proof. intros x y c eps; exists eps; rewrite Rminus_eq_0 Rabs_R0. intros; apply cond_pos. Qed. (** *** Extensionality *) Lemma continuity_pt_ext_loc : forall f g x, locally x (fun x => f x = g x) -> continuity_pt f x -> continuity_pt g x. Proof. intros f g x Heq Cf. apply continuity_pt_filterlim in Cf. apply continuity_pt_filterlim. rewrite -(locally_singleton _ _ Heq). by apply filterlim_ext_loc with f. Qed. Lemma continuity_pt_ext : forall f g x, (forall x, f x = g x) -> continuity_pt f x -> continuity_pt g x. Proof. intros f g x Heq. apply continuity_pt_ext_loc. by apply filter_forall. Qed. Lemma continuity_2d_pt_ext_loc : forall f g x y, locally_2d (fun u v => f u v = g u v) x y -> continuity_2d_pt f x y -> continuity_2d_pt g x y. Proof. intros f g x y Heq Cf. apply locally_2d_locally in Heq. apply continuity_2d_pt_filterlim in Cf. apply continuity_2d_pt_filterlim. rewrite -(locally_singleton _ _ Heq). apply filterlim_ext_loc with (2 := Cf). by apply Heq. Qed. Lemma continuity_2d_pt_ext : forall f g x y, (forall x y, f x y = g x y) -> continuity_2d_pt f x y -> continuity_2d_pt g x y. Proof. intros f g x y Heq. apply continuity_2d_pt_ext_loc. apply locally_2d_locally. apply filter_forall. now intros [u v]. Qed. (** *** Composition *) Lemma continuity_1d_2d_pt_comp : forall f g x y, continuity_pt f (g x y) -> continuity_2d_pt g x y -> continuity_2d_pt (fun x y => f (g x y)) x y. Proof. intros f g x y Cf Cg. apply continuity_pt_filterlim in Cf. apply continuity_2d_pt_filterlim in Cg. apply continuity_2d_pt_filterlim. apply: filterlim_comp Cg Cf. Qed. (** *** Additive operators *) Lemma continuity_2d_pt_opp (f : R -> R -> R) (x y : R) : continuity_2d_pt f x y -> continuity_2d_pt (fun u v => - f u v) x y. Proof. apply continuity_1d_2d_pt_comp. apply continuity_pt_opp. apply continuity_pt_id. Qed. Lemma continuity_2d_pt_plus (f g : R -> R -> R) (x y : R) : continuity_2d_pt f x y -> continuity_2d_pt g x y -> continuity_2d_pt (fun u v => f u v + g u v) x y. Proof. intros Cf Cg. apply continuity_2d_pt_filterlim in Cf. apply continuity_2d_pt_filterlim in Cg. apply continuity_2d_pt_filterlim. eapply filterlim_comp_2. apply Cf. apply Cg. apply: filterlim_plus. Qed. Lemma continuity_2d_pt_minus (f g : R -> R -> R) (x y : R) : continuity_2d_pt f x y -> continuity_2d_pt g x y -> continuity_2d_pt (fun u v => f u v - g u v) x y. Proof. move => Cf Cg. apply continuity_2d_pt_plus. exact: Cf. by apply continuity_2d_pt_opp. Qed. (** *** Multiplicative operators *) Lemma continuity_2d_pt_inv (f : R -> R -> R) (x y : R) : continuity_2d_pt f x y -> f x y <> 0 -> continuity_2d_pt (fun u v => / f u v) x y. Proof. intros Cf Df. apply continuity_2d_pt_filterlim in Cf. apply continuity_2d_pt_filterlim. apply filterlim_comp with (1 := Cf). apply (filterlim_Rbar_inv (f x y)). contradict Df. now injection Df. Qed. Lemma continuity_2d_pt_mult (f g : R -> R -> R) (x y : R) : continuity_2d_pt f x y -> continuity_2d_pt g x y -> continuity_2d_pt (fun u v => f u v * g u v) x y. Proof. intros Cf Cg. apply continuity_2d_pt_filterlim in Cf. apply continuity_2d_pt_filterlim in Cg. apply continuity_2d_pt_filterlim. eapply filterlim_comp_2. apply Cf. apply Cg. by apply (filterlim_Rbar_mult (f x y) (g x y) (f x y * g x y)). Qed. (** * Continuity in Uniform Spaces *) (** ** Continuity *) Section Continuity. Context {T U : UniformSpace}. Definition continuous_on (D : T -> Prop) (f : T -> U) := forall x, D x -> filterlim f (within D (locally x)) (locally (f x)). Definition continuous (f : T -> U) (x : T) := filterlim f (locally x) (locally (f x)). Lemma continuous_continuous_on : forall (D : T -> Prop) (f : T -> U) (x : T), locally x D -> continuous_on D f -> continuous f x. Proof. intros D f x Dx CD P Pfx. assert (Dx' := locally_singleton _ _ Dx). generalize (filter_and _ _ Dx (CD x Dx' P Pfx)). unfold filtermap, within. apply filter_imp. intros t [H1 H2]. now apply H2. Qed. Lemma continuous_on_subset : forall (D E : T -> Prop) (f : T -> U), (forall x, E x -> D x) -> continuous_on D f -> continuous_on E f. Proof. intros D E f H CD x Ex P Pfx. generalize (CD x (H x Ex) P Pfx). unfold filtermap, within. apply filter_imp. intros t H' Et. now apply H', H. Qed. Lemma continuous_on_forall : forall (D : T -> Prop) (f : T -> U), (forall x, D x -> continuous f x) -> continuous_on D f. Proof. intros D f H x Dx P Pfx. generalize (H x Dx P Pfx). unfold filtermap, within. now apply filter_imp. Qed. Lemma continuous_ext_loc (f g : T -> U) (x : T) : locally x (fun y : T => g y = f y) -> continuous g x -> continuous f x. Proof. intros. eapply filterlim_ext_loc. by apply H. by rewrite -(locally_singleton _ _ H). Qed. Lemma continuous_ext : forall (f g : T -> U) (x : T), (forall x, f x = g x) -> continuous f x -> continuous g x. Proof. intros f g x H Cf. apply filterlim_ext with (1 := H). now rewrite <- H. Qed. Lemma continuous_on_ext : forall (D : T -> Prop) (f g : T -> U), (forall x, D x -> f x = g x) -> continuous_on D f -> continuous_on D g. Proof. intros D f g H Cf x Dx. apply filterlim_within_ext with (1 := H). rewrite <- H with (1 := Dx). now apply Cf. Qed. End Continuity. Lemma continuous_comp {U V W : UniformSpace} (f : U -> V) (g : V -> W) (x : U) : continuous f x -> continuous g (f x) -> continuous (fun x => g (f x)) x. Proof. by apply filterlim_comp. Qed. Lemma continuous_comp_2 {U V W X : UniformSpace} (f : U -> V) (g : U -> W) (h : V -> W -> X) (x : U) : continuous f x -> continuous g x -> continuous (fun (x : V * W) => h (fst x) (snd x)) (f x,g x) -> continuous (fun x => h (f x) (g x)) x. Proof. intros Cf Cg Ch. eapply filterlim_comp_2. by apply Cf. by apply Cg. apply filterlim_locally => eps. case: (proj1 (filterlim_locally _ _) Ch eps) => /= del Hdel. rewrite {1}/ball /= /prod_ball /= in Hdel. exists (fun y => ball (f x) (pos del) y) (fun y => ball (g x) (pos del) y). apply locally_ball. apply locally_ball. move => y z /= Hy Hz. apply (Hdel (y,z)). by split. Qed. Lemma is_lim_comp_continuous (f g : R -> R) (x : Rbar) (l : R) : is_lim f x l -> continuous g l -> is_lim (fun x => g (f x)) x (g l). Proof. intros Hf Hg. apply filterlim_locally => eps. destruct (proj1 (filterlim_locally _ _) Hg eps) as [e He] ; clear Hg. eapply filter_imp. intros y Hy. apply He, Hy. by apply Hf, locally_ball. Qed. Lemma continuous_fst {U V : UniformSpace} (x : U) (y : V) : continuous (fst (B:=V)) (x, y). Proof. intros P [d Hd]. exists d => z [/= Hz1 Hz2]. by apply Hd => /=. Qed. Lemma continuous_snd {U V : UniformSpace} (x : U) (y : V) : continuous (snd (B:=V)) (x, y). Proof. intros P [d Hd]. exists d => z [/= Hz1 Hz2]. by apply Hd => /=. Qed. Lemma continuous_const {U V : UniformSpace} (c : V) (x : U) : continuous (fun _ => c) x. Proof. apply filterlim_const. Qed. Lemma continuous_id {U : UniformSpace} (x : U) : continuous (fun y => y) x. Proof. apply filterlim_id. Qed. Section Continuity_op. Context {U : UniformSpace} {K : AbsRing} {V : NormedModule K}. Lemma continuous_opp (f : U -> V) (x : U) : continuous f x -> continuous (fun x : U => opp (f x)) x. Proof. intros. eapply filterlim_comp. by apply H. apply (filterlim_opp (f x)). Qed. Lemma continuous_plus (f g : U -> V) (x : U) : continuous f x -> continuous g x -> continuous (fun x : U => plus (f x) (g x)) x. Proof. intros. eapply filterlim_comp_2. by apply H. by apply H0. apply (filterlim_plus (f x) (g x)). Qed. Lemma continuous_minus (f g : U -> V) (x : U) : continuous f x -> continuous g x -> continuous (fun x : U => minus (f x) (g x)) x. Proof. intros. apply continuous_plus. apply H. by apply continuous_opp. Qed. Lemma continuous_scal (k : U -> K) (f : U -> V) (x : U) : continuous k x -> continuous f x -> continuous (fun y => scal (k y) (f y)) x. Proof. intros. by eapply filterlim_comp_2, filterlim_scal. Qed. Lemma continuous_scal_r (k : K) (f : U -> V) (x : U) : continuous f x -> continuous (fun y => scal k (f y)) x. Proof. intros. by apply continuous_comp, filterlim_scal_r. Qed. Lemma continuous_scal_l (f : U -> K) (k : V) (x : U) : continuous f x -> continuous (fun y => scal (f y) k) x. Proof. intros. apply (continuous_comp f (fun y => scal y k)) => //. apply filterlim_scal_l. Qed. End Continuity_op. Lemma continuous_mult {U : UniformSpace} {K : AbsRing} (f g : U -> K) (x : U) : continuous f x -> continuous g x -> continuous (fun y => mult (f y) (g y)) x. Proof. intros. by eapply filterlim_comp_2, filterlim_mult. Qed. Section UnifCont. Context {V : UniformSpace}. Lemma unifcont_1d (f : R -> V) a b : (forall x, a <= x <= b -> continuous f x) -> forall eps : posreal, {delta : posreal | forall x y, a <= x <= b -> a <= y <= b -> ball x delta y -> ~~ ball (f x) eps (f y)}. Proof. intros Cf eps. wlog: f Cf / (forall z : R, continuous f z) => [ Hw | {} Cf ]. destruct (C0_extension_le f a b) as [g [Cg Hg]]. by apply Cf. destruct (Hw g) as [d Hd]. intros x Hx ; apply Cg. apply Cg. exists d => x y Hx Hy Hxy. rewrite -!Hg //. by apply Hd. assert (forall (x : R), {delta : posreal | forall y : R, ball x delta y -> ~~ ball (f x) (pos_div_2 eps) (f y)}). move: (pos_div_2 eps) => {} eps x. assert (Rbar_lt 0 (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y)))). case: (Lub.Lub_Rbar_correct (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))). move: (Lub.Lub_Rbar _) => l H1 H2. case: (proj1 (filterlim_locally _ _) (Cf x) eps) => d Hd. eapply Rbar_lt_le_trans, H1. by apply d. by apply Hd. assert (0 < Rbar_min 1 (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y)))). move: H ; case: (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))) => [l | | ] //= H0. apply Rmin_case => //. by apply Rlt_0_1. by apply Rlt_0_1. set d := mkposreal _ H0. exists d. unfold d ; clear d ; simpl. case: (Lub.Lub_Rbar_correct (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))). move: (Lub.Lub_Rbar (fun d => forall y : R, ball x d y -> ball (f x) eps (f y))) H => {H0} l H0 H1 H2 y Hy. contradict Hy. apply Rle_not_lt. apply (Rbar_le_trans (Finite _) l (Finite _)). case: (l) H0 => [r | | ] //= H0. apply Rmin_r. apply H2 => d /= Hd. apply Rnot_lt_le ; contradict Hy. by apply Hd. destruct (compactness_value_1d a b (fun x => pos_div_2 (proj1_sig (H x)))) as [d Hd]. exists d => x y Hx Hy Hxy Hf. apply (Hd x Hx). case => {Hd} t [Ht]. case: H => /= delta Hdelta [Htx Hdt]. apply (Hdelta x). eapply ball_le, Htx. rewrite {2}(double_var delta). apply Rminus_le_0 ; ring_simplify. apply Rlt_le, is_pos_div_2. intro Hftx. apply (Hdelta y). rewrite (double_var delta). apply ball_triangle with x. apply Htx. by eapply ball_le, Hxy. contradict Hf. rewrite (double_var eps). eapply ball_triangle, Hf. by apply ball_sym. Qed. End UnifCont. Section UnifCont_N. Context {K : AbsRing} {V : NormedModule K}. Lemma unifcont_normed_1d (f : R -> V) a b : (forall x, a <= x <= b -> continuous f x) -> forall eps : posreal, {delta : posreal | forall x y, a <= x <= b -> a <= y <= b -> ball x delta y -> ball_norm (f x) eps (f y)}. Proof. intros H eps. assert (0 < eps / (@norm_factor _ V)). apply Rdiv_lt_0_compat. apply cond_pos. exact norm_factor_gt_0. destruct (unifcont_1d f a b H (mkposreal _ H0)) as [d Hd]. exists d => x y Hx Hy Hxy. specialize (Hd x y Hx Hy Hxy). apply Rnot_le_lt. contradict Hd ; contradict Hd. apply Rlt_not_le. evar_last. apply norm_compat2, Hd. simpl ; field. apply Rgt_not_eq, norm_factor_gt_0. Qed. End UnifCont_N. coquelicot-coquelicot-3.4.1/theories/Coquelicot.v000066400000000000000000000301161455143432500221620ustar00rootroot00000000000000(** This library provides vernacular files containing a formalization of real analysis for Coq. It is a conservative extension of the standard library Reals with a focus on usability. It has been developed by Sylvie Boldo, Catherine Lelay, and Guillaume Melquiond. The goal of Coquelicot is to ease the writing of formulas and theorem statements for real analysis. This is achieved by using total functions in place of dependent types for limits, derivatives, integrals, power series, and so on. To help with the proof process, the library comes with a comprehensive set of theorems that cover not only these notions, but also some extensions such as parametric integrals, two-dimensional differentiability, asymptotic properties. It also offers some automations for performing differentiability proofs. Since Coquelicot is a conservative extension of Coq's standard library, we provide correspondence theorems between the two libraries. * Main types - [R]: the set of real numbers defined by Coq's standard library. - [Rbar]: [R] extended with signed infinities [p_infty] and [m_infty]. There is a coercion from [R] to [Rbar]. - [C]: the set of complex numbers, defined as pairs of real numbers. There is a coercion from [R] to [C]. - [@matrix T m n]: matrices with m rows and n columns of coefficients of type T. * Main classes - [UniformSpace]: a uniform space with a predicate [ball] defining an ecart. - [CompleteSpace]: a [UniformSpace] that is also complete. - [AbelianMonoid]: a type with a commutative operator [plus] and a neutral element [zero]. - [AbelianGroup]: an [AbelianMonoid] in which elements are invertible ([opp], [minus]). - [Ring]: an [AbelianGroup] with a noncommutative operator [mult] that is distributive with respect to [plus]; [one] is the neutral element of [mult]. - [AbsRing]: a [Ring] with an operator [abs] that is subdistributive with respect to [plus] and [mult]. - [ModuleSpace]: an [AbelianGroup] with an operator [scal] that defines a left module over a [Ring]. - [NormedModule]: a [ModuleSpace] that is also a [UniformSpace]; it provides an operator [norm] that defines the same topology as [ball]. - [CompleteNormedModule]: a [NormedModule] that is also a [CompleteSpace]. In the following definitions, K will designate either a [Ring] or an [AbsRing], while U and V will designate a [ModuleSpace], a [NormedModule], or a [CompleteNormedModule]. * Low-level concepts of topology Limits and neighborhoods are expressed in terms of filters, that is, predicates of type [(T -> Prop) -> Prop]. Sets from a filter are stable by intersection and extension. Filters are used to describe limit points and how they are approached. The properties of a filter are described by the [Filter] record. If a filter does not contain the empty set, it is also a [PerfectFilter]. In a [UniformSpace], [ball x eps y] states that y lies in a ball of center x and radius eps. [locally x] is the filter generated by all the balls of center x. As such, its single limit point is x. Thus [locally x] matches the traditional notion of convergence toward [x] in a metric space. Note: [locally x] is also the set of neighborhoods of x. The supported filters are as follows: - [locally x]. - [locally' x] is similar to [locally x], except that x is missing from every set. Thus, while its limit point is x too, properties at point x do not matter. - [Rbar_locally x] is defined for x in [Rbar]. It is [locally x] if x is finite, otherwise it is the set of half-bounded open intervals extending to either [m_infty] or [p_infty], depending on which infinity x is. In the latter case, the limit described by the filter is plus or minus infinity. - [Rbar_locally' x] is to [Rbar_locally x] what [locally' x] is to [locally x]. - [at_left x] restricts the balls of [locally x] to points strictly less than x, thus properties of points on the right of x do not matter. - [at_right x] is analogous to [at_left x] and is used to take limits on the right. - [filter_prod G H] is a filter describing the neighborhoods of point (g,h) if G describes the neighborhoods of g while H describes the neighborhoods of h. - [eventually] is a filter on natural numbers that converges to plus infinity. - [within dom F] weakens a filter F by only considering points that satisfy dom. Examples: - [locally x P] can be interpreted in several ways depending on the meaning of P. As a set, it means that P contains a ball centered at x, that is, P is a neighborhood of x. As a predicate, it means that P holds on a neighborhood of x. - [locally 2 (fun x => 0 < ln x)] means that [ln] has positive values in a neighborhood of 2. - [at_left 1 (fun x => -1 < ln x < 0)] means that [ln] has values between -1 and 0 in the left part of a neighborhood of 1. Open sets are described by the [open] predicate. It states that a set is open if it is a neighborhood of any of its points (in terms of [locally]). Closed sets are described by [closed]. * Limits and continuity Limits and continuity are expressed with filters using predicate [filterlim : (S -> T) -> ((S -> Prop) -> Prop) -> ((T -> Prop) -> Prop)]. Property [filterlim f K L] means that the preimage of any set of L by f is a set of K. In other words, function f, at the limit point described by filter K tends to the limit point described by filter L. Examples: - [filterlim f (locally x) (locally (f x))] means that f is continuous at point x. [filterlim f (locally' x) (locally (f x))] is another way to state it, since x is necessarily in the preimage of f x and thus can be ignored. - [filterlim f (at_right x) (locally y)] means that f t tends to y when t tends to x from the right. - [filterlim exp (Rbar_locally m_infty) (at_right 0)] means that [exp] tends to 0 at minus infinity but only takes positive values there. - [forall x y : R, filterlim (fun z => fst z + snd z) (filter_prod (locally x) (locally y)) (locally (x + y))] states that [Rplus] is continuous. Lemma [filterlim_locally] gives the traditional epsilon-delta definition of continuity. Compatibility with the [continuity_pt] predicate from the standard library is provided by lemmas such as [continuity_pt_filterlim]. The following predicates specialize [filterlim] to the usual cases of real-valued sequences and functions: - [is_lim_seq : (nat -> R) -> Rbar -> Prop], e.g. [is_lim_seq (fun n => 1 + / INR n) 1]. - [is_lim : (R -> R) -> Rbar -> Rbar -> Prop], e.g. [is_lim exp p_infty p_infty]. The unicity of the limits is given by lemmas [is_lim_seq_unique] and [is_lim_unique]. The compatibility with the arithmetic operators is given by lemmas such as [is_lim_seq_plus] and [is_lim_seq_plus']. They are derived from the generic lemmas [filterlim_plus] and [filterlim_comp_2]. Lemmas [is_lim_seq_spec] and [is_lim_sprec] gives the traditional epsilon-delta definition of convergence. Compatibility with the [Un_cv] and [limit1_in] predicates from the standard library is provided by lemmas [is_lim_seq_Reals] and [is_lim_Reals]. When only the convergence matters but not the actual value of the limit, the following predicates can be used instead, depending on whether the value can be infinite or not: - [ex_lim_seq : (nat -> R) -> Prop]. - [ex_lim : (R -> R) -> Rbar -> Prop]. - [ex_finite_lim_seq : (nat -> R) -> Prop]. - [ex_finite_lim : (R -> R) -> Rbar -> Prop]. Finally, there are also some total functions that are guaranteed to return the proper limits if the sequences or functions actually converge: - [Lim_seq : (nat -> R) -> Rbar], e.g. [Lim_seq (fun n => 1 + / INR n)] is equal to 1. - [Lim : (R -> R) -> Rbar -> Rbar]. If they do not converge, the returned value is arbitrary and no interesting results can be derived. These functions are related to the previous predicates by lemmas [Lim_seq_correct] and [Lim_correct]. As with predicates [filterlim], [is_lim_seq], and [is_lim], compatibility with the arithmetic operators is given by lemmas such as [ex_lim_seq_mult] and [Lim_inv]. Compatibility with predicates [Un_cv] and [limit1_in] from the standard library is provided by lemmas [is_lim_seq_Reals] and [is_lim_Reals]. * Derivability and differentiability The predicate of differentiability is [filterdiff : (U -> V) -> ((U -> Prop) -> Prop) -> (U -> V) -> Prop]. Property [filterdiff f K l] means that, at the limit point described by filter K, the differential of function f is the linear function l. Linearity is described by the predicate [is_linear]. While [filterdiff_ext] states that two functions extensionally equal have the same differential, [filterdiff_ext_lin] states that the differential can be replaced by any linear function that is extensionally equal. When the domain space of the function is an [AbsRing] rather than just a [NormedModule] and the filter is [locally], the following specialized predicates can be used instead: - [is_derive : (K -> V) -> K -> V -> Prop]. - [ex_derive : (K -> V) -> K -> V -> Prop]. For real-valued functions, the following total function gives the value of the derivative, if it exists: [Derive : (R -> R) -> R -> R]. The specification of this function is given by lemma [Derive_correct]. Compatibility of the predicates with [derivable_pt_lim] from the standard library is given by [is_derive_Reals]. Tactic [auto_derive] can be used to automatically solve goals about [is_derive], [ex_derive], [derivable_pt_lim], and [derivable_pt]. * Riemann integrals The main predicate is [is_RInt : (R -> V) -> R -> R -> V -> Prop]. [is_RInt f a b l] means that the Riemann sums of function f between a and b converge and their limit is equal to l. This is a specialization of [filterlim] for a function built using [Riemann_sum] and the [Riemann_fine] filter. As before, there are a predicate and a total function related to it: - [ex_RInt : (R -> V) -> R -> R -> Prop]. - [RInt : (R -> R) -> R -> R -> R]. Compatibility with predicate [Riemann_integrable] from the standard library is provided by lemmas [ex_RInt_Reals_0] and [ex_RInt_Reals_1]. * Series and power series The main predicates are [is_series : (nat -> V) -> V -> Prop] and [is_pseries : (nat -> V) -> K -> V -> Prop]. The associated predicates and functions are as follows: - [ex_series : (nat -> V) -> Prop]. - [ex_pseries : (nat -> V) -> K -> Prop]. - [Series : (nat -> R) -> R]. - [PSeries : (nat -> R) -> R -> R]. There is also a function [CV_radius : (nat -> R) -> Rbar] that returns the possibly infinite convergence radius. Compatibility with predicates [infinite_sum] and [Pser] from the standard library is provided by lemmas [is_series_Reals] and [is_pseries_Reals]. * Naming conventions - Theorems about a given predicate start with its name, generally followed by the name of the object it is applied to, e.g. [is_RInt_plus], or a property of the object, e.g. [filterdiff_linear]. - Correspondence theorems with the standard library end with [_Reals]. - Extensionality theorems end with [_ext]. If the equality only needs to be local, they end with [_ext_loc] instead. - Uniqueness theorems end with [_unique]. - Theorems about asymptotic properties at plus, resp. minus, infinity end with [_p], resp. [_m]. if they are at infinite points. - Theorems about constant functions, resp. identity, end with [_const], resp. [_id]. *) Require Export AutoDerive Compactness Complex Continuity Derive. Require Export Derive_2d Equiv ElemFct Hierarchy Lim_seq. Require Export Lub Markov PSeries Rbar Rcomplements. Require Export RInt RInt_gen RInt_analysis Seq_fct Series SF_seq. (** ## *) (** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) coquelicot-coquelicot-3.4.1/theories/Derive.v000066400000000000000000003055221455143432500212770ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond #
# Copyright (C) 2016-2016 Thomas Sibut-Pinote This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Rbar Lim_seq Iter Hierarchy Continuity Equiv. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). Open Scope R_scope. (** This file describes results about differentiability on a generic normed module. Specific results are also given on [R] with a total function [Derive]. It ends with the Taylor-Lagrange formula. *) Section LinearFct. (** * Linear functions *) Context {K : AbsRing} {U V : NormedModule K}. Record is_linear (l : U -> V) := { linear_plus : forall (x y : U), l (plus x y) = plus (l x) (l y) ; linear_scal : forall (k : K) (x : U), l (scal k x) = scal k (l x) ; linear_norm : exists M : R, 0 < M /\ (forall x : U, norm (l x) <= M * norm x) }. Lemma linear_zero (l : U -> V) : is_linear l -> l zero = zero. Proof. intros Hl. rewrite -(scal_zero_l zero). rewrite linear_scal. exact (scal_zero_l (l zero)). exact Hl. Qed. Lemma linear_opp (l : U -> V) (x : U) : is_linear l -> l (opp x) = opp (l x). Proof. intros Hl. apply plus_reg_r with (l x). rewrite <- linear_plus. rewrite !plus_opp_l. by apply linear_zero. exact Hl. Qed. Lemma linear_minus (l : U -> V) (x y : U) : is_linear l -> l (minus x y) = minus (l x) (l y). Proof. intros Hl. rewrite /minus linear_plus // linear_opp //. Qed. Lemma linear_cont (l : U -> V) (x : U) : is_linear l -> continuous l x. Proof. intros Hl. apply filterlim_locally_ball_norm => eps. apply locally_le_locally_norm. case: (linear_norm _ Hl) => M Hn. assert (0 < eps / M). apply Rdiv_lt_0_compat. apply cond_pos. apply Hn. exists (mkposreal _ H) => y Hy. rewrite /ball_norm -linear_minus //. eapply Rle_lt_trans. by apply Hn. evar_last. apply Rmult_lt_compat_l with (2 := Hy). apply Hn. simpl. field. apply Rgt_not_eq, Hn. Qed. Lemma is_linear_ext (l1 l2 : U -> V) : (forall x, l1 x = l2 x) -> is_linear l1 -> is_linear l2. Proof. intros Hl Hl1. split. intros ; rewrite -!Hl ; apply Hl1. intros ; rewrite -!Hl ; apply Hl1. case: Hl1 => _ _ [M Hl1]. exists M ; split. by apply Hl1. intros ; rewrite -!Hl ; apply Hl1. Qed. (** zero in a linear function *) Lemma is_linear_zero : is_linear (fun _ => zero). Proof. repeat split. - move => _ _ ; by rewrite plus_zero_l. - move => k _ ; by rewrite scal_zero_r. - exists 1 ; split. exact Rlt_0_1. move => x ; rewrite Rmult_1_l norm_zero. apply norm_ge_0. Qed. End LinearFct. Lemma is_linear_comp {K : AbsRing} {U V W : NormedModule K} (l1 : U -> V) (l2 : V -> W) : is_linear l1 -> is_linear l2 -> is_linear (fun x => l2 (l1 x)). Proof. intros Hl1 Hl2. split. - move => x y. by rewrite !linear_plus. - move => k x. by rewrite !linear_scal. - destruct (linear_norm _ Hl1) as [M1 Hn1]. destruct (linear_norm _ Hl2) as [M2 Hn2]. exists (M2 * M1) ; split. now apply Rmult_lt_0_compat. move => x. eapply Rle_trans. by apply Hn2. rewrite Rmult_assoc. apply Rmult_le_compat_l. now apply Rlt_le. apply Hn1. Qed. Section Op_LinearFct. Context {K : AbsRing} {V : NormedModule K}. (** id is a linear function *) Lemma is_linear_id : is_linear (fun (x : V) => x). Proof. repeat split. - exists 1 ; split. exact Rlt_0_1. move => x ; rewrite Rmult_1_l. by apply Rle_refl. Qed. (** opp is a linear function *) Lemma is_linear_opp : is_linear (@opp V). Proof. repeat split. - move => x y. apply (opp_plus x y). - move => k x. apply sym_eq. apply: scal_opp_r. - exists 1 ; split. exact Rlt_0_1. move => x ; rewrite norm_opp Rmult_1_l. by apply Rle_refl. Qed. (** plus is a linear function *) Lemma is_linear_plus : is_linear (fun x : V * V => plus (fst x) (snd x)). Proof. repeat split. - move => x y. rewrite -!plus_assoc ; apply f_equal. rewrite plus_comm -!plus_assoc. by apply f_equal, @plus_comm. - move => k x. now rewrite scal_distr_l. - exists 2 ; split. exact Rlt_0_2. move => x /= ; eapply Rle_trans. by apply @norm_triangle. rewrite Rmult_plus_distr_r Rmult_1_l ; apply Rplus_le_compat. apply Rle_trans with (2 := proj1 (sqrt_plus_sqr _ _)). rewrite -> Rabs_pos_eq by apply norm_ge_0. by apply Rmax_l. apply Rle_trans with (2 := proj1 (sqrt_plus_sqr _ _)). rewrite -> (Rabs_pos_eq (norm (snd x))) by apply norm_ge_0. by apply Rmax_r. Qed. (** [fun k => scal k x] is a linear function *) Lemma is_linear_scal_l (x : V) : is_linear (fun k : K => scal k x). Proof. split. - move => u v ; by apply @scal_distr_r. - move => u v /= ; apply sym_eq, @scal_assoc. - exists (norm x + 1) ; split. apply Rplus_le_lt_0_compat. apply norm_ge_0. exact Rlt_0_1. move => k /=. rewrite Rmult_plus_distr_r Rmult_1_l -(Rplus_0_r (norm (scal k x))). apply Rplus_le_compat. now rewrite Rmult_comm ; apply norm_scal. apply norm_ge_0. Qed. (** [fun x => scal k x] is a linear function if [mult] is commutative *) Lemma is_linear_scal_r (k : K) : (forall n m : K, mult n m = mult m n) -> is_linear (fun x : V => scal k x). Proof. split. - move => u v ; by apply @scal_distr_l. - move => u v /= ; apply sym_eq ; rewrite !@scal_assoc. by rewrite H. - exists (abs k + 1) ; split. apply Rplus_le_lt_0_compat. apply abs_ge_0. exact Rlt_0_1. move => x /=. rewrite Rmult_plus_distr_r Rmult_1_l -(Rplus_0_r (norm (scal k x))). apply Rplus_le_compat. apply norm_scal. apply norm_ge_0. Qed. End Op_LinearFct. Lemma is_linear_prod {K : AbsRing} {T U V : NormedModule K} (l1 : T -> U) (l2 : T -> V) : is_linear l1 -> is_linear l2 -> is_linear (fun t : T => (l1 t, l2 t)). Proof. intros H1 H2. split. - intros x y. apply injective_projections ; simpl. by apply H1. by apply H2. - intros k x. apply injective_projections ; simpl. by apply H1. by apply H2. - destruct (linear_norm l1 H1) as [M1 [HM1 Hn1]]. destruct (linear_norm l2 H2) as [M2 [HM2 Hn2]]. exists (sqrt 2 * Rmax M1 M2)%R ; split. apply Rmult_lt_0_compat. apply sqrt_lt_R0, Rlt_0_2. by apply Rmax_case. intros x. eapply Rle_trans. apply norm_prod. rewrite Rmult_assoc. apply Rmult_le_compat_l. by apply sqrt_pos. rewrite Rmult_max_distr_r. apply Rmax_case. by eapply Rle_trans, Rmax_l. by eapply Rle_trans, Rmax_r. by apply norm_ge_0. Qed. Lemma is_linear_fst {K : AbsRing} {U V : NormedModule K} : is_linear (fun t : U * V => fst t). Proof. split. - intros [x1 x2] [y1 y2] ; by simpl. - intros k [x1 x2] ; by simpl. - exists 1 ; split. exact Rlt_0_1. intros [x1 x2] ; simpl fst ; rewrite Rmult_1_l. eapply Rle_trans. 2: by apply norm_prod. by apply Rmax_l. Qed. Lemma is_linear_snd {K : AbsRing} {U V : NormedModule K} : is_linear (fun t : U * V => snd t). Proof. split. - intros [x1 x2] [y1 y2] ; by simpl. - intros k [x1 x2] ; by simpl. - exists 1 ; split. exact Rlt_0_1. intros [x1 x2] ; simpl snd ; rewrite Rmult_1_l. eapply Rle_trans. 2: by apply norm_prod. by apply Rmax_r. Qed. Section Linear_domin. Context {T : Type} {Kw K : AbsRing} {W : NormedModule Kw} {U V : NormedModule K}. Lemma is_domin_linear {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> W) (g : T -> U) (l : U -> V) : is_linear l -> is_domin F f g -> is_domin F f (fun t => l (g t)). Proof. intros [_ _ [M [Hm Hn]]] H eps. assert (He : 0 < eps / M). apply Rdiv_lt_0_compat with (2 := Hm). apply cond_pos. specialize (H (mkposreal _ He)). move: H ; apply filter_imp => /= x Hx. apply Rle_trans with (1 := Hn _). evar_last. apply Rmult_le_compat_l with (2 := Hx). now apply Rlt_le. field. now apply Rgt_not_eq. Qed. End Linear_domin. (** * Differentiability using filters *) Section Diff. Context {K : AbsRing} {U : NormedModule K} {V : NormedModule K}. Definition filterdiff (f : U -> V) F (l : U -> V) := is_linear l /\ forall x, is_filter_lim F x -> is_domin F (fun y : U => minus y x) (fun y => minus (minus (f y) (f x)) (l (minus y x))). Definition ex_filterdiff (f : U -> V) F := exists (l : U -> V), filterdiff f F l. Lemma filterdiff_continuous_aux {F} {FF : Filter F} (f : U -> V) : ex_filterdiff f F -> forall x, is_filter_lim F x -> filterlim f F (locally (f x)). Proof. intros [l [Hl Df]] x Hx. specialize (Df x Hx). apply filterlim_locally_ball_norm => eps. specialize (Df (mkposreal _ Rlt_0_1)) ; simpl in Df. destruct (linear_norm _ Hl) as [M Hm]. assert (F (fun y => norm (minus (f y) (f x)) <= (M + 1) * norm (minus y x))). move: Df ; apply filter_imp => y Hy. rewrite Rmult_1_l in Hy. apply Rle_trans with (1 := norm_triangle_inv _ _) in Hy. apply Rabs_le_between' in Hy. eapply Rle_trans. by apply Hy. apply Rle_minus_r ; ring_simplify. by apply Hm. move: H => {} Df. assert (Hm': 0 < M + 1). apply Rplus_le_lt_0_compat. apply Rlt_le, Hm. exact Rlt_0_1. assert (0 < eps / (M+1)). apply Rdiv_lt_0_compat with (2 := Hm'). apply cond_pos. specialize (Hx _ (locally_ball_norm x (mkposreal _ H))). generalize (filter_and _ _ Hx Df) => /=. apply filter_imp => y [Hy Hy'] {Hx Df}. apply Rle_lt_trans with (1 := Hy'). evar_last. now apply Rmult_lt_compat_l with (2 := Hy). field. now apply Rgt_not_eq. Qed. Lemma filterdiff_continuous (f : U -> V) x : ex_filterdiff f (locally x) -> continuous f x. Proof. intros. by apply filterdiff_continuous_aux. Qed. Lemma filterdiff_locally {F} {FF : ProperFilter F} (f : U -> V) x l : is_filter_lim F x -> filterdiff f (locally x) l -> filterdiff f F l. Proof. intros Fx [Hl Df]. split. exact Hl. intros z Fz. specialize (Df _ (fun P H => H)). generalize (is_filter_lim_unique _ _ Fx Fz). intros ->. now apply is_domin_le with (2 := Fz). Qed. Lemma ex_filterdiff_locally {F} {FF : ProperFilter F} (f : U -> V) x : is_filter_lim F x -> ex_filterdiff f (locally x) -> ex_filterdiff f F. Proof. intros Fx [l Df]. eexists. apply filterdiff_locally with x. by []. by apply Df. Qed. (** ** Operations *) Lemma filterdiff_ext_lin {F} {FF : Filter F} (f : U -> V) (l1 l2 : U -> V) : filterdiff f F l1 -> (forall y, l1 y = l2 y) -> filterdiff f F l2. Proof. intros [Hl1 Hf1] Hl ; split => [ | x Hx eps]. + split. - intros x y ; rewrite -!Hl. by apply linear_plus. - intros k x ; rewrite -!Hl. by apply linear_scal. - destruct (linear_norm _ Hl1) as [M Hm]. exists M ; split. by apply Hm. move => x ; now rewrite -Hl. + move: (Hf1 x Hx eps). apply filter_imp => y. by rewrite !Hl. Qed. Lemma filterdiff_ext_loc {F} {FF : Filter F} (f g : U -> V) (l : U -> V) : F (fun y => f y = g y) -> (forall x, is_filter_lim F x -> f x = g x) -> filterdiff f F l -> filterdiff g F l. Proof. move => H H0 [Hl Df]. split => //. move => x Hx eps. specialize (H0 x Hx). specialize (Df x Hx eps). apply filter_and with (1 := H) in Df. move: Df ; apply filter_imp => y [Hy]. apply Rle_trans. by apply Req_le ; rewrite Hy H0. Qed. Lemma ex_filterdiff_ext_loc {F} {FF : Filter F} (f g : U -> V) : F (fun y => f y = g y) -> (forall x, is_filter_lim F x -> f x = g x) -> ex_filterdiff f F -> ex_filterdiff g F. Proof. intros H H0 [l Hl]. exists l ; by apply filterdiff_ext_loc with f. Qed. Lemma filterdiff_ext_locally (f g : U -> V) (x : U) (l : U -> V) : locally x (fun y => f y = g y) -> filterdiff f (locally x) l -> filterdiff g (locally x) l. Proof. move => H. apply filterdiff_ext_loc with (1 := H). move => y Hy. destruct H as [d Hd]. apply Hd. replace y with x. apply ball_center. by apply is_filter_lim_locally_unique. Qed. Lemma ex_filterdiff_ext_locally (f g : U -> V) x : locally x (fun y => f y = g y) -> ex_filterdiff f (locally x) -> ex_filterdiff g (locally x). Proof. intros H [l Hl]. exists l ; by apply filterdiff_ext_locally with f. Qed. Lemma filterdiff_ext {F} {FF : Filter F} (f g : U -> V) (l : U -> V) : (forall y , f y = g y) -> filterdiff f F l -> filterdiff g F l. Proof. move => H. apply filterdiff_ext_loc => //. now apply filter_forall. Qed. Lemma ex_filterdiff_ext {F} {FF : Filter F} (f g : U -> V) : (forall y , f y = g y) -> ex_filterdiff f F -> ex_filterdiff g F. Proof. intros H [l Hl]. exists l ; by apply filterdiff_ext with f. Qed. Lemma filterdiff_const {F} {FF : Filter F} (a : V) : filterdiff (fun _ => a) F (fun _ => zero). Proof. split. by apply is_linear_zero. move => x Hx eps. apply filter_forall => y. rewrite minus_eq_zero minus_zero_r norm_zero. apply Rmult_le_pos. by apply Rlt_le, eps. by apply norm_ge_0. Qed. Lemma ex_filterdiff_const {F} {FF : Filter F} (a : V) : ex_filterdiff (fun _ => a) F. Proof. intros. exists (fun _ => zero). by apply filterdiff_const. Qed. Lemma filterdiff_linear {F} (l : U -> V) : is_linear l -> filterdiff l F l. Proof. move => Hl ; split. by []. move => x Hx eps. apply Hx. apply filter_forall => y. rewrite -linear_minus // minus_eq_zero norm_zero. apply Rmult_le_pos. apply Rlt_le, eps. by apply norm_ge_0. Qed. Lemma ex_filterdiff_linear {F} (l : U -> V) : is_linear l -> ex_filterdiff l F. Proof. intro Hl ; exists l; by apply filterdiff_linear. Qed. End Diff. Section Diff_comp. Context {K : AbsRing} {U V W : NormedModule K}. Lemma filterdiff_comp {F} {FF : Filter F} f g (lf : U -> V) (lg : V -> W) : filterdiff f F lf -> filterdiff g (filtermap f F) lg -> filterdiff (fun y => g (f y)) F (fun y => lg (lf y)). Proof. intros Df Dg. split. apply is_linear_comp. by apply Df. by apply Dg. intros x Hx. assert (Cf : filterlim f F (locally (f x))). apply filterdiff_continuous_aux with (2 := Hx). eexists ; by apply Df. assert (is_domin (filtermap f F) (fun y : V => minus y (f x)) (fun y : V => minus (minus (g y) (g (f x))) (lg (minus y (f x))))). apply Dg. move => P HP. by apply Cf. destruct Dg as [Hg _]. rename H into Dg. destruct Df as [Hf Df]. apply domin_rw_r with (fun y : U => plus (minus (minus (g (f y)) (g (f x))) (lg (minus (f y) (f x)))) (lg (minus (minus (f y) (f x)) (lf (minus y x))))). apply equiv_ext_loc. apply filter_forall => y. rewrite /minus -!plus_assoc. repeat apply f_equal. rewrite plus_assoc. rewrite (linear_plus _ Hg (plus _ _)). rewrite plus_assoc. rewrite plus_opp_l plus_zero_l. by apply linear_opp. apply domin_plus. intros eps. destruct (linear_norm _ Hf) as [mf [Hmf Hnf]]. assert (F (fun y => norm (minus (f y) (f x)) <= (1 + mf) * norm (minus y x))). specialize (Df x Hx (mkposreal _ Rlt_0_1)). move: Df ; apply filter_imp. move => y /= Hy. replace (minus (f y) (f x)) with (plus (minus (minus (f y) (f x)) (lf (minus y x))) (lf (minus y x))). eapply Rle_trans. apply @norm_triangle. rewrite Rmult_plus_distr_r. apply Rplus_le_compat. exact Hy. by apply Hnf. by rewrite {1}/minus -plus_assoc plus_opp_l plus_zero_r. clear Df ; rename H into Df. assert (He : 0 < eps / (1 + mf)). apply Rdiv_lt_0_compat. apply cond_pos. apply Rplus_lt_0_compat. exact Rlt_0_1. exact Hmf. specialize (Dg (mkposreal _ He)). unfold filtermap in Dg. generalize (filter_and _ _ Df Dg). apply filter_imp => /= y {Df Dg} [Df Dg]. apply Rle_trans with (1 := Dg). unfold Rdiv. rewrite Rmult_assoc. apply Rmult_le_compat_l. apply Rlt_le, eps. rewrite Rmult_comm ; apply Rle_div_l. apply Rplus_lt_0_compat. exact Rlt_0_1. exact Hmf. rewrite Rmult_comm ; by apply Df. specialize (Df x Hx). by apply is_domin_linear. Qed. Lemma ex_filterdiff_comp {F} {FF : Filter F} (f : U -> V) (g : V -> W) : ex_filterdiff f F -> ex_filterdiff g (filtermap f F) -> ex_filterdiff (fun y => g (f y)) F. Proof. intros [lf Df] [lg Dg]. eexists ; eapply filterdiff_comp ; eassumption. Qed. Lemma filterdiff_comp' f g x (lf : U -> V) (lg : V -> W) : filterdiff f (locally x) lf -> filterdiff g (locally (f x)) lg -> filterdiff (fun y => g (f y)) (locally x) (fun y => lg (lf y)). Proof. intros. apply filterdiff_comp. by []. apply filterdiff_locally with (f x). apply is_filter_lim_filtermap => //. apply filterdiff_continuous => //. eexists ; by apply H. by []. Qed. Lemma ex_filterdiff_comp' (f : U -> V) (g : V -> W) x : ex_filterdiff f (locally x) -> ex_filterdiff g (locally (f x)) -> ex_filterdiff (fun y => g (f y)) (locally x). Proof. intros [lf Df] [lg Dg]. eexists. apply filterdiff_comp' ; eassumption. Qed. End Diff_comp. Section Diff_comp2. Context {K : AbsRing} {T U V : NormedModule K}. Section Diff_comp2'. Context {W : NormedModule K}. Lemma filterdiff_comp_2 {F : (T -> Prop) -> Prop} {FF : Filter F} : forall (f : T -> U) (g : T -> V) (h : U -> V -> W) (lf : T -> U) (lg : T -> V) (lh : U -> V -> W), filterdiff f F lf -> filterdiff g F lg -> filterdiff (fun t => h (fst t) (snd t)) (filtermap (fun t => (f t,g t)) F) (fun t => lh (fst t) (snd t)) -> filterdiff (fun y : T => h (f y) (g y)) F (fun y : T => lh (lf y) (lg y)). Proof. intros f g h lf lg lh [Hf Df] [Hg Dg] Dh. apply (filterdiff_comp (fun t => (f t, g t)) _ (fun t => (lf t, lg t)) _) in Dh. by []. split. by apply is_linear_prod. intros x Hx eps. assert (0 < eps / sqrt 2). apply Rdiv_lt_0_compat. by apply eps. apply Rlt_sqrt2_0. generalize (filter_and _ _ (Df x Hx (mkposreal _ H)) (Dg x Hx (mkposreal _ H))). simpl pos. apply filter_imp ; intros y [Hnf Hng]. eapply Rle_trans. apply norm_prod. simpl fst ; simpl snd. eapply Rle_trans. apply Rmult_le_compat_l. by apply sqrt_pos. apply Rmax_case. apply Hnf. apply Hng. apply Req_le ; field. apply Rgt_not_eq, Rlt_sqrt2_0. Qed. Lemma ex_filterdiff_comp_2 {F : (T -> Prop) -> Prop} {FF : Filter F} : forall (f : T -> U) (g : T -> V) (h : U -> V -> W), ex_filterdiff f F -> ex_filterdiff g F -> ex_filterdiff (fun t => h (fst t) (snd t)) (filtermap (fun t => (f t,g t)) F) -> ex_filterdiff (fun y : T => h (f y) (g y)) F. Proof. intros f g h [lf Df] [lg Dg] [lh Dh]. set lh' := fun x y => lh (x,y). eexists ; eapply (filterdiff_comp_2 _ _ _ _ _ lh') ; try eassumption. eapply filterdiff_ext_lin. by apply Dh. by case. Qed. End Diff_comp2'. Context {W : NormedModule K}. Lemma filterdiff_comp'_2 : forall (f : T -> U) (g : T -> V) (h : U -> V -> W) x (lf : T -> U) (lg : T -> V) (lh : U -> V -> W), filterdiff f (locally x) lf -> filterdiff g (locally x) lg -> filterdiff (fun t => h (fst t) (snd t)) (locally (f x,g x)) (fun t => lh (fst t) (snd t)) -> filterdiff (fun y : T => h (f y) (g y)) (locally x) (fun y : T => lh (lf y) (lg y)). Proof. intros. apply filterdiff_comp_2. by []. by []. apply filterdiff_locally with (f x, g x). apply (is_filter_lim_filtermap _ _ (fun t : T => (f t, g t))) => //. apply (filterdiff_continuous (fun t : T => (f t, g t))) => //. apply ex_filterdiff_comp_2. by exists lf. by exists lg. apply ex_filterdiff_linear. apply is_linear_prod. apply is_linear_fst. by apply is_linear_snd. by []. Qed. Lemma ex_filterdiff_comp'_2 : forall (f : T -> U) (g : T -> V) (h : U -> V -> W) x, ex_filterdiff f (locally x) -> ex_filterdiff g (locally x) -> ex_filterdiff (fun t => h (fst t) (snd t)) (locally (f x,g x)) -> ex_filterdiff (fun y : T => h (f y) (g y)) (locally x). Proof. intros f g h x [lf Df] [lg Dg] [lh Dh]. exists (fun x => lh (lf x,lg x)). apply (filterdiff_comp'_2 f g h x lf lg (fun x y => lh (x,y))) ; try eassumption. eapply filterdiff_ext_lin ; try eassumption. by case. Qed. End Diff_comp2. Section Operations. Context {K : AbsRing} {V : NormedModule K}. Lemma filterdiff_id (F : (V -> Prop) -> Prop) : filterdiff (fun y => y) F (fun y => y). Proof. apply filterdiff_linear. by apply is_linear_id. Qed. Lemma ex_filterdiff_id (F : (V -> Prop) -> Prop) : ex_filterdiff (fun y => y) F. Proof. eexists. by apply filterdiff_id. Qed. Lemma filterdiff_opp (F : (V -> Prop) -> Prop) : filterdiff opp F opp. Proof. apply filterdiff_linear. by apply is_linear_opp. Qed. Lemma ex_filterdiff_opp (F : (V -> Prop) -> Prop) : ex_filterdiff opp F. Proof. eexists. by apply filterdiff_opp. Qed. Lemma filterdiff_plus (F : (V * V -> Prop) -> Prop) : filterdiff (fun u => plus (fst u) (snd u)) F (fun u => plus (fst u) (snd u)). Proof. apply filterdiff_linear. by apply is_linear_plus. Qed. Lemma ex_filterdiff_plus (F : (V * V -> Prop) -> Prop) : ex_filterdiff (fun u => plus (fst u) (snd u)) F. Proof. eexists. by apply filterdiff_plus. Qed. Lemma filterdiff_minus (F : (V * V -> Prop) -> Prop) : filterdiff (fun u => minus (fst u) (snd u)) F (fun u => minus (fst u) (snd u)). Proof. apply filterdiff_linear. apply (is_linear_comp (fun u => (fst u, opp (snd u))) (fun u => plus (fst u) (snd u))). apply is_linear_prod. by apply is_linear_fst. apply is_linear_comp. by apply is_linear_snd. by apply is_linear_opp. by apply is_linear_plus. Qed. Lemma ex_filterdiff_minus (F : (V * V -> Prop) -> Prop) : ex_filterdiff (fun u => minus (fst u) (snd u)) F. Proof. eexists. by apply filterdiff_minus. Qed. Local Ltac plus_grab e := repeat rewrite (plus_assoc _ e) -(plus_comm e) -(plus_assoc e). Lemma filterdiff_scal : forall {F : (K * V -> Prop) -> Prop} {FF : ProperFilter F} (x : K * V), is_filter_lim F x -> (forall (n m : K), mult n m = mult m n) -> filterdiff (fun t : K * V => scal (fst t) (snd t)) F (fun t => plus (scal (fst t) (snd x)) (scal (fst x) (snd t))). Proof. move => F FF [x1 x2] Hx Hcomm ; split. - apply (is_linear_comp (fun t : K * V => (scal (fst t) x2,scal x1 (snd t))) (fun t : V * V => plus (fst t) (snd t))). apply is_linear_prod. apply (is_linear_comp (fun t : K * V => fst t) (fun k : K => scal k x2)). by apply is_linear_fst. by apply is_linear_scal_l. apply is_linear_comp. by apply is_linear_snd. by apply is_linear_scal_r. apply is_linear_plus. - move => y Hy eps. replace y with (x1,x2). 2: now apply is_filter_lim_unique with (1 := Hx). clear y Hy. apply Hx ; clear Hx. apply: locally_le_locally_norm. exists eps. intros [y1 y2] H. simpl. set v := minus (minus _ _) _. replace v with (scal (minus y1 x1) (minus y2 x2)). apply Rle_trans with (1 := norm_scal _ _). generalize (proj1 (sqrt_plus_sqr (abs (minus y1 x1)) (norm (minus y2 x2)))). rewrite -> Rabs_pos_eq by apply abs_ge_0. rewrite -> Rabs_pos_eq by apply norm_ge_0. intros H'. apply Rmult_le_compat. apply abs_ge_0. apply norm_ge_0. apply Rlt_le, Rle_lt_trans with (2 := H). apply Rle_trans with (2 := H'). apply Rmax_l. apply Rle_trans with (2 := H'). apply Rmax_r. rewrite /v /minus !scal_distr_l !scal_distr_r !opp_plus !scal_opp_r !scal_opp_l !opp_opp -!plus_assoc. apply f_equal. plus_grab (opp (scal x1 y2)). apply f_equal. plus_grab (opp (scal y1 x2)). apply f_equal. by rewrite plus_assoc plus_opp_l plus_zero_l. Qed. Lemma ex_filterdiff_scal : forall {F} {FF : ProperFilter F} (x : K * V), is_filter_lim F x -> (forall (n m : K), mult n m = mult m n) -> ex_filterdiff (fun t : K * V => scal (fst t) (snd t)) F. Proof. eexists. by apply (filterdiff_scal x). Qed. Lemma filterdiff_scal_l : forall {F} {FF : Filter F} (x : V), filterdiff (fun k : K => scal k x) F (fun k => scal k x). Proof. move => F FF x. apply filterdiff_linear. by apply is_linear_scal_l. Qed. Lemma ex_filterdiff_scal_l : forall {F} {FF : Filter F} (x : V), ex_filterdiff (fun k : K => scal k x) F. Proof. eexists. by apply (filterdiff_scal_l x). Qed. Lemma filterdiff_scal_r : forall {F} {FF : Filter F} (k : K), (forall (n m : K), mult n m = mult m n) -> filterdiff (fun x : V => scal k x) F (fun x => scal k x). Proof. move => F FF x Hcomm. apply filterdiff_linear. by apply is_linear_scal_r. Qed. Lemma ex_filterdiff_scal_r : forall {F} {FF : Filter F} (k : K), (forall (n m : K), mult n m = mult m n) -> ex_filterdiff (fun x : V => scal k x) F. Proof. eexists. by apply (filterdiff_scal_r k). Qed. End Operations. Lemma filterdiff_mult {K : AbsRing} : forall {F} {FF : ProperFilter F} (x : K * K), is_filter_lim F x -> (forall (n m : K), mult n m = mult m n) -> filterdiff (fun t : K * K => mult (fst t) (snd t)) F (fun t => plus (mult (fst t) (snd x)) (mult (fst x) (snd t))). Proof. intros. generalize (filterdiff_scal x H H0) ; by simpl. Qed. Lemma ex_filterdiff_mult {K : AbsRing} : forall {F} {FF : ProperFilter F} (x : K * K), is_filter_lim F x -> (forall (n m : K), mult n m = mult m n) -> ex_filterdiff (fun t : K * K => mult (fst t) (snd t)) F. Proof. eexists. by apply (filterdiff_mult x). Qed. (** Composed operations *) Section Operations_fct. Context {K : AbsRing} {U V : NormedModule K}. Lemma filterdiff_opp_fct {F} {FF : Filter F} (f lf : U -> V) : filterdiff f F lf -> filterdiff (fun t => opp (f t)) F (fun t => opp (lf t)). Proof. intro Df. apply filterdiff_comp. by []. by apply filterdiff_opp. Qed. Lemma ex_filterdiff_opp_fct {F} {FF : Filter F} (f : U -> V) : ex_filterdiff f F -> ex_filterdiff (fun t => opp (f t)) F. Proof. intros [lf Df]. eexists. apply filterdiff_opp_fct ; eassumption. Qed. Lemma filterdiff_plus_fct {F} {FF : Filter F} (f g : U -> V) (lf lg : U -> V) : filterdiff f F lf -> filterdiff g F lg -> filterdiff (fun u => plus (f u) (g u)) F (fun u => plus (lf u) (lg u)). Proof. intros Df Dg. apply filterdiff_comp_2. by []. by []. by apply filterdiff_plus. Qed. Lemma ex_filterdiff_plus_fct {F} {FF : Filter F} (f g : U -> V) : ex_filterdiff f F -> ex_filterdiff g F -> ex_filterdiff (fun u => plus (f u) (g u)) F. Proof. intros [lf Df] [lg Dg]. eexists. apply filterdiff_plus_fct ; eassumption. Qed. Lemma filterdiff_iter_plus_fct {I} {F} {FF : Filter F} (l : list I) (f : I -> U -> V) df (x : U) : (forall (j : I), List.In j l -> filterdiff (f j) F (df j)) -> filterdiff (fun y => iter plus zero l (fun j => f j y)) F (fun x => iter plus zero l (fun j => df j x)). Proof. intros Hf. induction l ; simpl in * |- *. apply filterdiff_const. apply filterdiff_plus_fct. apply Hf. by left. apply IHl ; intros. apply Hf. by right. Qed. Lemma filterdiff_minus_fct {F} {FF : Filter F} (f g : U -> V) (lf lg : U -> V) : filterdiff f F lf -> filterdiff g F lg -> filterdiff (fun u => minus (f u) (g u)) F (fun u => minus (lf u) (lg u)). Proof. intros Df Dg. apply filterdiff_comp_2. by []. by []. by apply filterdiff_minus. Qed. Lemma ex_filterdiff_minus_fct {F} {FF : Filter F} (f g : U -> V) : ex_filterdiff f F -> ex_filterdiff g F -> ex_filterdiff (fun u => minus (f u) (g u)) F. Proof. intros [lf Df] [lg Dg]. eexists. apply filterdiff_minus_fct ; eassumption. Qed. Lemma filterdiff_scal_fct x (f : U -> K) (g : U -> V) lf lg : (forall (n m : K), mult n m = mult m n) -> filterdiff f (locally x) lf -> filterdiff g (locally x) lg -> filterdiff (fun t => scal (f t) (g t)) (locally x) (fun t => plus (scal (lf t) (g x)) (scal (f x) (lg t))). Proof. intros Hcomm Df Dg. apply (filterdiff_comp'_2 f g scal x lf lg (fun k v => plus (scal k (g x)) (scal (f x) v))) => //. by apply (filterdiff_scal (f x, g x)). Qed. Lemma ex_filterdiff_scal_fct x (f : U -> K) (g : U -> V) : (forall (n m : K), mult n m = mult m n) -> ex_filterdiff f (locally x) -> ex_filterdiff g (locally x) -> ex_filterdiff (fun t => scal (f t) (g t)) (locally x). Proof. intros Hcomm [lf Df] [lg Dg]. eexists. apply (filterdiff_scal_fct x) ; eassumption. Qed. Lemma filterdiff_scal_l_fct : forall {F} {FF : Filter F} (x : V) (f : U -> K) lf, filterdiff f F lf -> filterdiff (fun u => scal (f u) x) F (fun u => scal (lf u) x). Proof. move => F FF x f lf Df. apply (filterdiff_comp f (fun k => scal k x) lf (fun k => scal k x)). by []. apply filterdiff_linear. by apply is_linear_scal_l. Qed. Lemma ex_filterdiff_scal_l_fct : forall {F} {FF : Filter F} (x : V) (f : U -> K), ex_filterdiff f F -> ex_filterdiff (fun u => scal (f u) x) F. Proof. intros F FF x f [lf Df]. eexists. apply (filterdiff_scal_l_fct x) ; eassumption. Qed. Lemma filterdiff_scal_r_fct : forall {F} {FF : Filter F} (k : K) (f lf : U -> V), (forall (n m : K), mult n m = mult m n) -> filterdiff f F lf -> filterdiff (fun x => scal k (f x)) F (fun x => scal k (lf x)). Proof. move => F FF k f lf Hcomm Df. apply (filterdiff_comp f (fun x => scal k x) lf (fun x => scal k x)). by []. apply filterdiff_linear. by apply is_linear_scal_r. Qed. Lemma ex_filterdiff_scal_r_fct : forall {F} {FF : Filter F} (k : K) (f : U -> V), (forall (n m : K), mult n m = mult m n) -> ex_filterdiff f F -> ex_filterdiff (fun x => scal k (f x)) F. Proof. move => F FF k f Hcomm [lf Df]. eexists. apply (filterdiff_scal_r_fct k) ; eassumption. Qed. End Operations_fct. Lemma filterdiff_mult_fct {K : AbsRing} {U : NormedModule K} (f g : U -> K) x (lf lg : U -> K) : (forall (n m : K), mult n m = mult m n) -> filterdiff f (locally x) lf -> filterdiff g (locally x) lg -> filterdiff (fun t => mult (f t) (g t)) (locally x) (fun t => plus (mult (lf t) (g x)) (mult (f x) (lg t))). Proof. intros. by apply @filterdiff_scal_fct. Qed. Lemma ex_filterdiff_mult_fct {K : AbsRing} {U : NormedModule K} (f g : U -> K) x : (forall (n m : K), mult n m = mult m n) -> ex_filterdiff f (locally x) -> ex_filterdiff g (locally x) -> ex_filterdiff (fun t => mult (f t) (g t)) (locally x). Proof. intros Hcomm [lf Df] [lg Dg]. eexists. apply @filterdiff_mult_fct ; eassumption. Qed. (** * Differentiability in 1 dimentional space *) Section Derive. Context {K : AbsRing} {V : NormedModule K}. Definition is_derive (f : K -> V) (x : K) (l : V) := filterdiff f (locally x) (fun y : K => scal y l). Definition ex_derive (f : K -> V) (x : K) := exists l : V, is_derive f x l. Lemma ex_derive_filterdiff : forall (f : K -> V) (x : K), ex_derive f x <-> ex_filterdiff f (locally x). Proof. intros f x. split ; case => d Df. - eexists. exact Df. - exists (d one). split. apply is_linear_scal_l. simpl => t Ht. destruct Df as [Ld Df]. simpl in Df. apply domin_rw_r with (2 := Df t Ht). apply equiv_ext_loc. apply filter_forall => y. apply f_equal. rewrite -linear_scal //=. apply f_equal, sym_eq, mult_one_r. Qed. Lemma ex_derive_continuous (f : K -> V) (x : K) : ex_derive f x -> continuous f x. Proof. intros. apply @filterdiff_continuous. by apply ex_derive_filterdiff. Qed. End Derive. (** * Definitions on [R] *) Definition Derive (f : R -> R) (x : R) := real (Lim (fun h => (f (x+h) - f x)/h) 0). Lemma is_derive_Reals (f : R -> R) (x l : R) : is_derive f x l <-> derivable_pt_lim f x l. Proof. apply iff_sym. split => Hf. + split. apply @is_linear_scal_l. simpl => y Hy eps. rewrite -(is_filter_lim_locally_unique _ _ Hy) ; clear y Hy. case: (Hf eps (cond_pos _)) => {Hf} d Hf. exists d => y /= Hy. case: (Req_dec y x) => Hxy. rewrite Hxy /norm /scal /= /abs /minus /plus /opp /mult /=. ring_simplify (f x + - f x + - ((x + - x) * l)). ring_simplify (x + - x). rewrite Rabs_R0 Rmult_0_r. by apply Rle_refl. apply Rle_div_l. apply Rabs_pos_lt. by apply Rminus_eq_contra. rewrite -Rabs_div. 2: by apply Rminus_eq_contra. rewrite /scal /= /minus /plus /opp /mult /=. replace ((f y + - f x + - ((y + - x) * l)) / (y + - x)) with ((f (x + (y-x)) - f x) / (y-x) - l). 2: ring_simplify (x + (y - x)) ; field ; by apply Rminus_eq_contra. apply Rlt_le, Hf. by apply Rminus_eq_contra. by []. + move => e He. destruct Hf as [_ Hf]. specialize (Hf x (fun P H => H)). destruct (Hf (pos_div_2 (mkposreal _ He))) as [delta Hd]. exists delta => h Hh0 Hh. apply Rle_lt_trans with (e / 2). simpl in Hd. replace ((f (x + h) - f x) / h - l) with ((f (x + h) + - f x + - ((x + h + - x) * l)) / (x + h + - x)). 2: by field. rewrite Rabs_div. 2: by ring_simplify (x + h + - x). apply Rle_div_l. now ring_simplify (x + h + - x) ; apply Rabs_pos_lt. apply Hd. rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=. by ring_simplify (x + h + - x). apply Rlt_div_l, Rminus_lt_0 ; ring_simplify. by apply Rlt_0_2. by []. Qed. (** Derive is correct *) Lemma is_derive_unique f x l : is_derive f x l -> Derive f x = l. Proof. intros H. apply (@f_equal _ _ real _ l). apply is_lim_unique. apply is_lim_spec. apply is_derive_Reals in H. intros eps. destruct (H eps (cond_pos _)) as [d Hd]. exists d => h. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= Ropp_0 Rplus_0_r. intros Hu Zu. now apply Hd. Qed. Lemma Derive_correct f x : ex_derive f x -> is_derive f x (Derive f x). Proof. intros (l,H). cut (Derive f x = l). intros ; rewrite H0 ; apply H. apply is_derive_unique, H. Qed. (** Equivalence with standard library Reals *) Lemma ex_derive_Reals_0 (f : R -> R) (x : R) : ex_derive f x -> derivable_pt f x. Proof. move => Hf. apply Derive_correct in Hf. apply is_derive_Reals in Hf. by exists (Derive f x). Qed. Lemma ex_derive_Reals_1 (f : R -> R) (x : R) : derivable_pt f x -> ex_derive f x. Proof. case => l Hf. exists l. now apply is_derive_Reals. Qed. Lemma Derive_Reals (f : R -> R) (x : R) (pr : derivable_pt f x) : derive_pt f x pr = Derive f x. Proof. apply sym_eq, is_derive_unique. case: pr => /= l Hf. now apply is_derive_Reals. Qed. (** Extensionality *) Section Extensionality. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_ext_loc : forall (f g : K -> V) (x : K) (l : V), locally x (fun t : K => f t = g t) -> is_derive f x l -> is_derive g x l. Proof. intros f g x l Heq Hf. now apply (filterdiff_ext_locally f g _ _ Heq). Qed. Lemma ex_derive_ext_loc : forall (f g : K -> V) (x : K), locally x (fun t : K => f t = g t) -> ex_derive f x -> ex_derive g x. Proof. intros f g x Hfg (l,Hf). exists l. apply: is_derive_ext_loc Hfg Hf. Qed. Lemma is_derive_ext : forall (f g : K -> V) (x : K) (l : V), (forall t : K, f t = g t) -> is_derive f x l -> is_derive g x l. Proof. intros f g x l Heq Hf. apply: filterdiff_ext_locally Hf. by apply filter_forall. Qed. Lemma ex_derive_ext : forall (f g : K -> V) (x : K), (forall t : K, f t = g t) -> ex_derive f x -> ex_derive g x. Proof. intros f g x Heq [l Hf]. exists l ; move: Hf ; by apply is_derive_ext. Qed. End Extensionality. Lemma Derive_ext_loc : forall f g x, locally x (fun t => f t = g t) -> Derive f x = Derive g x. Proof. intros f g x Hfg. rewrite /Derive /Lim. apply f_equal, Lim_seq_ext_loc. apply (filterlim_Rbar_loc_seq 0 (fun h => (f (x + h) - f x) / h = (g (x + h) - g x) / h)). apply (filter_imp (fun h => f (x + h) = g (x + h))). intros h ->. by rewrite (locally_singleton _ _ Hfg). destruct Hfg as [eps He]. exists eps => h H Hh. apply He. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. now replace (x + h + - x) with (h - 0) by ring. Qed. Lemma Derive_ext : forall f g x, (forall t, f t = g t) -> Derive f x = Derive g x. Proof. intros f g x Hfg. apply Derive_ext_loc. by apply filter_forall. Qed. (** * Operations *) (** Constant functions *) Section Const. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_const : forall (a : V) (x : K), is_derive (fun _ : K => a) x zero. Proof. intros a x. apply filterdiff_ext_lin with (fun y : K => zero). apply filterdiff_const. intros y. apply sym_eq. apply: scal_zero_r. Qed. Lemma ex_derive_const : forall (a : V) (x : K), ex_derive (fun _ => a) x. Proof. intros a x. eexists. apply is_derive_const. Qed. End Const. Lemma Derive_const : forall (a x : R), Derive (fun _ => a) x = 0. Proof. intros a x. apply is_derive_unique. apply: is_derive_const. Qed. (** Identity function *) Section Id. Context {K : AbsRing}. Lemma is_derive_id : forall x : K, is_derive (fun t : K => t) x one. Proof. intros x. apply filterdiff_ext_lin with (fun t : K => t). apply filterdiff_id. rewrite /scal /=. intros y. apply sym_eq, mult_one_r. Qed. Lemma ex_derive_id : forall x : K, ex_derive (fun t : K => t) x. Proof. intros x. eexists. apply is_derive_id. Qed. End Id. Lemma Derive_id : forall x, Derive id x = 1. Proof. intros x. apply is_derive_unique. apply: is_derive_id. Qed. (** ** Additive operators *) (** Opposite of functions *) Section Opp. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_opp : forall (f : K -> V) (x : K) (l : V), is_derive f x l -> is_derive (fun x => opp (f x)) x (opp l). Proof. intros f x l Df. apply filterdiff_ext_lin with (fun t : K => opp (scal t l)). apply filterdiff_comp' with (1 := Df). apply filterdiff_opp. intros y. apply sym_eq. apply: scal_opp_r. Qed. Lemma ex_derive_opp : forall (f : K -> V) (x : K), ex_derive f x -> ex_derive (fun x => opp (f x)) x. Proof. intros f x [df Df]. eexists. apply is_derive_opp. exact Df. Qed. End Opp. Lemma Derive_opp : forall f x, Derive (fun x => - f x) x = - Derive f x. Proof. intros f x. unfold Derive, Lim. rewrite /Rbar_loc_seq. rewrite -Rbar.Rbar_opp_real. rewrite -Lim_seq_opp. apply f_equal, Lim_seq_ext => n. rewrite -Ropp_mult_distr_l_reverse. apply (f_equal (fun v => v / _)). ring. Qed. (** Addition of functions *) Section Plus. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_plus : forall (f g : K -> V) (x : K) (df dg : V), is_derive f x df -> is_derive g x dg -> is_derive (fun x => plus (f x) (g x)) x (plus df dg). Proof. intros f g x df dg Df Dg. eapply filterdiff_ext_lin. apply filterdiff_plus_fct ; try eassumption. simpl => y. by rewrite scal_distr_l. Qed. Lemma ex_derive_plus : forall (f g : K -> V) (x : K), ex_derive f x -> ex_derive g x -> ex_derive (fun x => plus (f x) (g x)) x. Proof. intros f g x [df Df] [dg Dg]. exists (plus df dg). now apply is_derive_plus. Qed. Lemma is_derive_sum_n : forall (f : nat -> K -> V) (n : nat) (x : K) (d : nat -> V), (forall k, (k <= n)%nat -> is_derive (f k) x (d k)) -> is_derive (fun y => sum_n (fun k => f k y) n) x (sum_n d n). Proof. intros f n x d. elim: n => /= [ | n IH] Hf. rewrite sum_O. eapply is_derive_ext, (Hf O) => //. intros t ; by rewrite sum_O. eapply is_derive_ext. intros t ; apply sym_eq, sum_Sn. rewrite sum_Sn. apply is_derive_plus. apply IH => k Hk. by apply Hf, Nat.le_trans with (1 := Hk), Nat.le_succ_diag_r. by apply Hf. Qed. Lemma ex_derive_sum_n : forall (f : nat -> K -> V) (n : nat) (x : K), (forall k, (k <= n)%nat -> ex_derive (f k) x) -> ex_derive (fun y => sum_n (fun k => f k y) n) x. Proof. intros f n x. elim: n => /= [ | n IH] Hf. eapply ex_derive_ext. intros t ; by rewrite sum_O. by apply (Hf O). eapply ex_derive_ext. intros t ; by rewrite sum_Sn. apply ex_derive_plus. apply IH => k Hk. by apply Hf, Nat.le_trans with (1 := Hk), Nat.le_succ_diag_r. by apply Hf. Qed. End Plus. Lemma Derive_plus : forall f g x, ex_derive f x -> ex_derive g x -> Derive (fun x => f x + g x) x = Derive f x + Derive g x. Proof. intros f g x Df Dg. apply is_derive_unique. apply: is_derive_plus ; now apply Derive_correct. Qed. Lemma Derive_sum_n (f : nat -> R -> R) (n : nat) (x : R) : (forall k, (k <= n)%nat -> ex_derive (f k) x) -> Derive (fun y => sum_n (fun k => f k y) n) x = sum_n (fun k => Derive (f k) x) n. Proof. move => Hf. apply is_derive_unique. apply: is_derive_sum_n. move => k Hk. by apply Derive_correct, Hf. Qed. (** Difference of functions *) Section Minus. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_minus : forall (f g : K -> V) (x : K) (df dg : V), is_derive f x df -> is_derive g x dg -> is_derive (fun x => minus (f x) (g x)) x (minus df dg). Proof. intros f g x df dg Df Dg. eapply filterdiff_ext_lin. apply filterdiff_minus_fct ; try eassumption. simpl => y. by rewrite scal_distr_l scal_opp_r. Qed. Lemma ex_derive_minus : forall (f g : K -> V) (x : K), ex_derive f x -> ex_derive g x -> ex_derive (fun x => minus (f x) (g x)) x. Proof. intros f g x [df Df] [dg Dg]. exists (minus df dg). now apply is_derive_minus. Qed. End Minus. Lemma Derive_minus : forall f g x, ex_derive f x -> ex_derive g x -> Derive (fun x => f x - g x) x = Derive f x - Derive g x. Proof. intros f g x Df Dg. apply is_derive_unique. apply: is_derive_minus ; now apply Derive_correct. Qed. (** ** Multiplicative operators *) (** Multiplication of functions *) Lemma is_derive_inv (f : R -> R) (x l : R) : is_derive f x l -> f x <> 0 -> is_derive (fun y : R => / f y) x (-l/(f x)^2). Proof. move => Hf Hl. eapply filterdiff_ext_lin. apply filterdiff_ext with (fun y => 1/f y). move => t ; by rewrite /Rdiv Rmult_1_l. apply is_derive_Reals. apply derivable_pt_lim_div. apply derivable_pt_lim_const. apply is_derive_Reals. exact Hf. exact Hl. simpl => y ; apply f_equal. rewrite /= /Rsqr ; by field. Qed. Lemma ex_derive_inv (f : R -> R) (x : R) : ex_derive f x -> f x <> 0 -> ex_derive (fun y : R => / f y) x. Proof. case => l Hf Hl. exists (-l/(f x)^2). by apply is_derive_inv. Qed. Lemma Derive_inv (f : R -> R) (x : R) : ex_derive f x -> f x <> 0 -> Derive (fun y => / f y) x = - Derive f x / (f x) ^ 2. Proof. move/Derive_correct => Hf Hl. apply is_derive_unique. by apply is_derive_inv. Qed. Lemma is_derive_scal : forall (f : R -> R) (x k df : R), is_derive f x df -> is_derive (fun x : R => k * f x) x (k * df). Proof. intros f x k df Df. change Rmult with (scal (V := R_NormedModule)). eapply filterdiff_ext_lin. apply filterdiff_scal_r_fct with (2 := Df). apply Rmult_comm. rewrite /scal /= /mult /= => y. ring. Qed. Lemma ex_derive_scal : forall (f : R -> R) (k x : R), ex_derive f x -> ex_derive (fun x : R => k * f x) x. Proof. intros f k x (df,Df). exists (k * df). now apply is_derive_scal. Qed. Lemma Derive_scal : forall f k x, Derive (fun x => k * f x) x = k * Derive f x. Proof. intros f k x. unfold Derive, Lim. have H : (forall x, k * Rbar.real x = Rbar.real (Rbar.Rbar_mult (Rbar.Finite k) x)). case: (Req_dec k 0) => [-> | Hk]. case => [l | | ] //= ; rewrite Rmult_0_l. case: Rle_dec (Rle_refl 0) => //= H _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => //= _ _. case: Rle_dec (Rle_refl 0) => //= H _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => //= _ _. case => [l | | ] //= ; rewrite Rmult_0_r. case: Rle_dec => //= H. case: Rle_lt_or_eq_dec => //=. case: Rle_dec => //= H. case: Rle_lt_or_eq_dec => //=. rewrite H. rewrite -Lim_seq_scal_l. apply f_equal, Lim_seq_ext => n. rewrite -Rmult_assoc. apply (f_equal (fun v => v / _)). ring. Qed. Section Scal_l. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_scal_l : forall (f : K -> K) (x l : K) (k : V), is_derive f x l -> is_derive (fun x => scal (f x) k) x (scal l k). Proof. intros f x l k Df. eapply filterdiff_ext_lin. apply @filterdiff_scal_l_fct ; try by apply locally_filter. exact Df. simpl => y. apply sym_eq, scal_assoc. Qed. Lemma ex_derive_scal_l : forall (f : K -> K) (x : K) (k : V), ex_derive f x -> ex_derive (fun x => scal (f x) k) x. Proof. intros f x k [df Df]. exists (scal df k). by apply is_derive_scal_l. Qed. End Scal_l. Lemma Derive_scal_l (f : R -> R) (k x : R) : Derive (fun x => f x * k) x = Derive f x * k. Proof. rewrite Rmult_comm -Derive_scal. apply Derive_ext => t ; by apply Rmult_comm. Qed. Lemma is_derive_mult : forall (f g : R -> R) (x : R) (df dg : R), is_derive f x df -> is_derive g x dg -> is_derive (fun t : R => f t * g t) x (df * g x + f x * dg) . Proof. intros f g x df dg Df Dg. eapply filterdiff_ext_lin. apply @filterdiff_mult_fct with (2 := Df) (3 := Dg). exact Rmult_comm. rewrite /scal /= /mult /plus /= => y. ring. Qed. Lemma ex_derive_mult (f g : R -> R) (x : R) : ex_derive f x -> ex_derive g x -> ex_derive (fun x : R => f x * g x) x. Proof. move => [d1 H1] [d2 H2]. exists (d1 * g x + f x * d2). now apply is_derive_mult. Qed. Lemma Derive_mult (f g : R -> R) (x : R) : ex_derive f x -> ex_derive g x -> Derive (fun x => f x * g x) x = Derive f x * g x + f x * Derive g x. Proof. move => H1 H2. apply is_derive_unique. now apply is_derive_mult ; apply Derive_correct. Qed. Lemma is_derive_pow (f : R -> R) (n : nat) (x : R) (l : R) : is_derive f x l -> is_derive (fun x : R => (f x)^n) x (INR n * l * (f x)^(pred n)). Proof. move => H. rewrite (Rmult_comm _ l) Rmult_assoc Rmult_comm. apply is_derive_Reals. apply (derivable_pt_lim_comp f (fun x => x^n)). now apply is_derive_Reals. by apply derivable_pt_lim_pow. Qed. Lemma ex_derive_pow (f : R -> R) (n : nat) (x : R) : ex_derive f x -> ex_derive (fun x : R => (f x)^n) x. Proof. case => l H. exists (INR n * l * (f x)^(pred n)). by apply is_derive_pow. Qed. Lemma Derive_pow (f : R -> R) (n : nat) (x : R) : ex_derive f x -> Derive (fun x => (f x)^n) x = (INR n * Derive f x * (f x)^(pred n)). Proof. move => H. apply is_derive_unique. apply is_derive_pow. by apply Derive_correct. Qed. Lemma is_derive_div : forall (f g : R -> R) (x : R) (df dg : R), is_derive f x df -> is_derive g x dg -> g x <> 0 -> is_derive (fun t : R => f t / g t) x ((df * g x - f x * dg) / (g x ^ 2)). Proof. intros f g x df dg Df Dg Zgx. evar_last. apply is_derive_mult. exact Df. apply is_derive_inv with (2 := Zgx). exact Dg. simpl. now field. Qed. Lemma ex_derive_div (f g : R -> R) (x : R) : ex_derive f x -> ex_derive g x -> g x <> 0 -> ex_derive (fun y => f y / g y) x. Proof. move => Hf Hg Hl. apply ex_derive_mult. apply Hf. by apply ex_derive_inv. Qed. Lemma Derive_div (f g : R -> R) (x : R) : ex_derive f x -> ex_derive g x -> g x <> 0 -> Derive (fun y => f y / g y) x = (Derive f x * g x - f x * Derive g x) / (g x) ^ 2. Proof. move => Hf Hg Hl. apply is_derive_unique. now apply is_derive_div ; try apply Derive_correct. Qed. (** Composition of functions *) Section Comp. Context {K : AbsRing} {V : NormedModule K}. Lemma is_derive_comp : forall (f : K -> V) (g : K -> K) (x : K) (df : V) (dg : K), is_derive f (g x) df -> is_derive g x dg -> is_derive (fun x => f (g x)) x (scal dg df). Proof. intros f g x df dg Df Dg. eapply filterdiff_ext_lin. apply filterdiff_comp' with (1 := Dg) (2 := Df). simpl => y. apply sym_eq, scal_assoc. Qed. Lemma ex_derive_comp : forall (f : K -> V) (g : K -> K) (x : K), ex_derive f (g x) -> ex_derive g x -> ex_derive (fun x => f (g x)) x. Proof. intros f g x [df Df] [dg Dg]. exists (scal dg df). now apply is_derive_comp. Qed. End Comp. Lemma Derive_comp (f g : R -> R) (x : R) : ex_derive f (g x) -> ex_derive g x -> Derive (fun x => f (g x)) x = Derive g x * Derive f (g x). Proof. intros Df Dg. apply is_derive_unique. apply: is_derive_comp ; now apply Derive_correct. Qed. (** * Mean value theorem *) Lemma MVT_gen (f : R -> R) (a b : R) (df : R -> R) : let a0 := Rmin a b in let b0 := Rmax a b in (forall x, a0 < x < b0 -> is_derive f x (df x)) -> (forall x, a0 <= x <= b0 -> continuity_pt f x) -> exists c, a0 <= c <= b0 /\ f b - f a = df c * (b - a). Proof. move => a0 b0 Hd Hf. case: (Req_dec a0 b0) => Hab. exists a0 ; split. split ; by apply Req_le. replace b with a. ring. move: Hab ; rewrite /a0 /b0 /Rmin /Rmax ; by case: Rle_dec => Hab. have pr1 : forall c:R, a0 < c < b0 -> derivable_pt f c. move => x Hx ; exists (df x). by apply is_derive_Reals, Hd. have pr2 : forall c:R, a0 < c < b0 -> derivable_pt id c. move => x Hx ; exists 1. by apply derivable_pt_lim_id. case: (MVT f id a0 b0 pr1 pr2). apply Rnot_le_lt ; contradict Hab ; apply Rle_antisym. by apply Rcomplements.Rmin_Rmax. by apply Hab. by apply Hf. move => x Hx ; apply derivable_continuous, derivable_id. move => /= c [Hc H]. exists c ; split. split ; by apply Rlt_le, Hc. replace (df c) with (derive_pt f c (pr1 c Hc)). move: H ; rewrite {1 2}/id /a0 /b0 /Rmin /Rmax ; case: Rle_dec => Hab0 H. rewrite Rmult_comm H -(pr_nu _ _ (derivable_pt_id _)) derive_pt_id. ring. replace (derive_pt f c (pr1 c Hc) * (b - a)) with (-((a - b) * derive_pt f c (pr1 c Hc))) by ring. rewrite H -(pr_nu _ _ (derivable_pt_id _)) derive_pt_id. ring. case: (pr1 c Hc) => /= l Hl. transitivity (Derive f c). apply sym_eq, is_derive_unique, is_derive_Reals, Hl. by apply is_derive_unique, Hd. Qed. Lemma incr_function (f : R -> R) (a b : Rbar) (df : R -> R) : (forall (x : R), Rbar_lt a x -> Rbar_lt x b -> is_derive f x (df x)) -> ((forall (x : R), Rbar_lt a x -> Rbar_lt x b -> df x > 0) -> (forall (x y : R), Rbar_lt a x -> x < y -> Rbar_lt y b -> f x < f y)). Proof. move => Df Hf x y Hax Hxy Hyb. apply Rminus_lt_0. case: (MVT_gen f x y df) => [z Hz | z Hz | c [Hc ->]]. apply Df. apply Rbar_lt_le_trans with (y := Rmin x y) (2 := Rlt_le _ _ (proj1 Hz)). rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rbar_le_lt_trans with (y := Rmax x y) (1 := Rlt_le _ _ (proj2 Hz)). rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply derivable_continuous_pt. exists (df z) ; apply is_derive_Reals, Df. apply Rbar_lt_le_trans with (y := Rmin x y) (2 := proj1 Hz). rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rbar_le_lt_trans with (y := Rmax x y) (1 := proj2 Hz). rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rmult_lt_0_compat. apply Hf. apply Rbar_lt_le_trans with (y := Rmin x y) (2 := proj1 Hc). rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rbar_le_lt_trans with (y := Rmax x y) (1 := proj2 Hc). rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hxy) => //. by apply -> Rminus_lt_0. Qed. Lemma incr_function_le (f : R -> R) (a b : Rbar) (df : R -> R) : (forall (x : R), Rbar_le a x -> Rbar_le x b -> is_derive f x (df x)) -> ((forall (x : R), Rbar_le a x -> Rbar_le x b -> df x > 0) -> (forall (x y : R), Rbar_le a x -> x < y -> Rbar_le y b -> f x < f y)). Proof. move => Df Hf x y Hax Hxy Hyb. apply Rminus_lt_0. case: (MVT_gen f x y df) => [z Hz | z Hz | c [Hc ->]]. apply Df. apply Rbar_le_trans with (y := Rmin x y) (2 := Rlt_le _ _ (proj1 Hz)). rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rbar_le_trans with (y := Rmax x y) (1 := Rlt_le _ _ (proj2 Hz)). rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply derivable_continuous_pt. exists (df z) ; apply is_derive_Reals, Df. apply Rbar_le_trans with (y := Rmin x y) (2 := proj1 Hz). rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rbar_le_trans with (y := Rmax x y) (1 := proj2 Hz). rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rmult_lt_0_compat. apply Hf. apply Rbar_le_trans with (y := Rmin x y) (2 := proj1 Hc). rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hxy) => //. apply Rbar_le_trans with (y := Rmax x y) (1 := proj2 Hc). rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hxy) => //. by apply -> Rminus_lt_0. Qed. Lemma MVT_cor4: forall (f df : R -> R) a eps, (forall c, Rabs (c - a) <= eps -> is_derive f c (df c)) -> forall b, (Rabs (b - a) <= eps) -> exists c, f b - f a = df c * (b - a) /\ (Rabs (c - a) <= Rabs (b - a)). Proof. intros f df a eps Hf' b. unfold Rabs at 1 3. case Rcase_abs; intros H1 H2. destruct (MVT_cor2 f df b a). rewrite -(Rplus_0_l a). now apply Rlt_minus_l. intros c Hc. apply is_derive_Reals, Hf'. rewrite Rabs_left1. apply Rle_trans with (2:=H2). apply Ropp_le_contravar. now apply Rplus_le_compat_r. apply Rplus_le_reg_r with a. now ring_simplify. exists x; split. rewrite -RIneq.Ropp_minus_distr (proj1 H). ring. rewrite Rabs_left. apply Ropp_le_contravar. left; now apply Rplus_lt_compat_r. apply Rplus_lt_reg_r with a. now ring_simplify. destruct H1. destruct (MVT_cor2 f df a b). apply Rplus_lt_reg_r with (-a). ring_simplify. now rewrite Rplus_comm. intros c Hc. apply is_derive_Reals, Hf'. rewrite Rabs_right. apply Rle_trans with (2:=H2). now apply Rplus_le_compat_r. apply Rle_ge; apply Rplus_le_reg_r with a. now ring_simplify. exists x; split. exact (proj1 H0). rewrite Rabs_right. left; now apply Rplus_lt_compat_r. apply Rle_ge; apply Rplus_le_reg_r with a. left; now ring_simplify. exists a. replace b with a. split;[ring|idtac]. rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rle_refl. apply Rplus_eq_reg_l with (-a). ring_simplify. rewrite - H; ring. Qed. Lemma bounded_variation (h dh : R -> R) (D : R) (x y : R) : (forall t : R, Rabs (t - x) <= Rabs (y - x) -> is_derive h t (dh t) /\ (Rabs (dh t) <= D)) -> Rabs (h y - h x) <= D * Rabs (y - x). Proof. intros H. destruct (MVT_cor4 h dh x (Rabs (y - x))) with (b := y) as [t Ht]. intros c Hc. specialize (H c Hc). apply H. apply Rle_refl. rewrite (proj1 Ht). rewrite Rabs_mult. apply Rmult_le_compat_r. apply Rabs_pos. now apply H. Qed. Lemma norm_le_prod_norm_1 {K : AbsRing} {U V : NormedModule K} (x : U * V) : norm (fst x) <= norm x. Proof. eapply Rle_trans, sqrt_plus_sqr. rewrite Rabs_pos_eq. apply Rmax_l. by apply norm_ge_0. Qed. Lemma norm_le_prod_norm_2 {K : AbsRing} {U V : NormedModule K} (x : U * V) : norm (snd x) <= norm x. Proof. eapply Rle_trans, sqrt_plus_sqr. rewrite (Rabs_pos_eq (norm (snd x))). apply Rmax_r. by apply norm_ge_0. Qed. Lemma is_derive_filterdiff (f : R -> R -> R) (x y : R) (dfx : R -> R -> R) (dfy : R) : locally (x,y) (fun u : R * R => is_derive (fun z => f z (snd u)) (fst u) (dfx (fst u) (snd u))) -> is_derive (fun z : R => f x z) y dfy -> continuous (fun u : R * R => dfx (fst u) (snd u)) (x,y) -> filterdiff (fun u : R * R => f (fst u) (snd u)) (locally (x,y)) (fun u : R * R => plus (scal (fst u) (dfx x y)) (scal (snd u) dfy)). Proof. intros Dx Dy Cx. split. apply (is_linear_comp (fun u : R * R => (scal (fst u) (dfx x y),scal (snd u) dfy)) (fun u : R * R => plus (fst u) (snd u))). apply is_linear_prod. apply (is_linear_comp (@fst _ _) (fun t : R => scal t (dfx x y))). by apply is_linear_fst. by apply @is_linear_scal_l. apply (is_linear_comp (@snd _ _) (fun t : R => scal t dfy)). by apply is_linear_snd. by apply @is_linear_scal_l. by apply @is_linear_plus. simpl => u Hu. replace u with (x,y) by now apply is_filter_lim_locally_unique. move => {u Hu} eps /=. set (eps' := pos_div_2 eps). generalize (proj1 (filterlim_locally _ _) Cx eps') => {Cx} /= Cx. generalize (filter_and _ _ Dx Cx) => {Dx Cx}. intros (d1,Hd1). destruct (proj2 Dy y (fun P H => H) eps') as (d2,Hd2). set (l1 := dfx x y). exists (mkposreal _ (Rmin_stable_in_posreal d1 d2)). intros (u,v) (Hu,Hv) ; simpl in *. set (g1 t := minus (f t v) (scal t l1)). set (g2 t := minus (f x t) (scal t dfy)). apply Rle_trans with (norm (minus (g1 u) (g1 x)) + norm (minus (g2 v) (g2 y))). eapply Rle_trans, norm_triangle. apply Req_le, f_equal, sym_eq. rewrite /g1 /g2 /minus !opp_plus !opp_opp -!plus_assoc ; apply f_equal. do 5 rewrite plus_comm -!plus_assoc ; apply f_equal. rewrite !scal_distr_r !opp_plus -!plus_assoc !scal_opp_l !opp_opp. rewrite plus_comm -!plus_assoc ; apply f_equal. rewrite plus_comm -!plus_assoc ; apply f_equal. by rewrite plus_comm -!plus_assoc plus_opp_l plus_zero_r. replace (pos eps) with (eps' + eps') by (apply sym_eq ; apply double_var). rewrite Rmult_plus_distr_r. apply Rplus_le_compat. (* *) apply Rle_trans with (eps' * norm (minus u x)). apply bounded_variation with (fun t => minus (dfx t v) l1) => t Ht. split. apply: is_derive_minus. apply (Hd1 (t,v)) ; split ; simpl. apply Rle_lt_trans with (1 := Ht). apply Rlt_le_trans with (1:=Hu). apply Rmin_l. apply Rlt_le_trans with (1:=Hv). apply Rmin_l. rewrite -{2}(Rmult_1_r l1). evar_last. apply filterdiff_linear, is_linear_scal_l. by rewrite Rmult_1_r. apply Rlt_le. apply (Hd1 (t,v)) ; split ; simpl. apply Rle_lt_trans with (1 := Ht). apply Rlt_le_trans with (1:=Hu). apply Rmin_l. apply Rlt_le_trans with (1:=Hv). apply Rmin_l. apply Rmult_le_compat_l. apply Rlt_le. apply cond_pos. apply (norm_le_prod_norm_1 (minus (u, v) (x, y))). (* *) apply Rle_trans with (eps' * norm (minus v y)). apply Rle_trans with (norm (minus (minus (f x v) (f x y)) (scal (minus v y) dfy))). right; apply f_equal. rewrite /g2 scal_minus_distr_r /minus !opp_plus opp_opp -!plus_assoc ; apply f_equal. rewrite plus_comm -!plus_assoc ; apply f_equal. apply plus_comm. apply Hd2. apply Rlt_le_trans with (1:=Hv). apply Rmin_r. apply Rmult_le_compat_l. apply Rlt_le. apply cond_pos. apply (norm_le_prod_norm_2 (minus (u, v) (x, y))). Qed. (** * Newton integration *) Lemma fn_eq_Derive_eq: forall f g a b, continuity_pt f a -> continuity_pt f b -> continuity_pt g a -> continuity_pt g b -> (forall x, a < x < b -> ex_derive f x) -> (forall x, a < x < b -> ex_derive g x) -> (forall x, a < x < b -> Derive f x = Derive g x) -> exists C, forall x, a <= x <= b -> f x = g x + C. Proof. intros f g a b Cfa Cfb Cga Cgb Df Dg Hfg. pose (h := fun x => f x - g x). assert (pr : forall x : R, a < x < b -> derivable_pt h x). intros x Hx. apply derivable_pt_minus. eexists; apply is_derive_Reals, Derive_correct, Df, Hx. eexists; apply is_derive_Reals, Derive_correct, Dg, Hx. assert (constant_D_eq h (fun x : R => a <= x <= b) (h a)). apply null_derivative_loc with (pr:=pr). intros x Hx. case (proj1 Hx). case (proj2 Hx). intros Y1 Y2. apply derivable_continuous_pt. apply pr; now split. intros Y1 _; rewrite Y1. apply continuity_pt_minus. apply Cfb. apply Cgb. intros Y1; rewrite <- Y1. apply continuity_pt_minus. apply Cfa. apply Cga. intros x P. apply trans_eq with (Derive h x). apply sym_eq, is_derive_unique, is_derive_Reals. now destruct (pr x P). rewrite Derive_minus. rewrite (Hfg _ P). ring. apply Df; split; apply P. apply Dg; split; apply P. unfold constant_D_eq in H. exists (h a). intros x Hx. rewrite <- (H _ Hx). unfold h; ring. Qed. (** * Extension *) Section ext_cont. Context {U : UniformSpace}. Definition extension_cont (f g : R -> U) (a x : R) : U := match Rle_dec x a with | left _ => f x | right _ => g x end. Lemma extension_cont_continuous (f g : R -> U) (a : R) : continuous f a -> continuous g a -> f a = g a -> continuous (extension_cont f g a) a. Proof. simpl => Cf Cg Heq ; apply filterlim_locally => /= eps. generalize (proj1 (filterlim_locally _ _) Cf eps) => {} Cf. generalize (proj1 (filterlim_locally _ _) Cg eps) => {} Cg. generalize (filter_and _ _ Cf Cg). apply filter_imp => {Cf Cg} x [Cf Cg]. rewrite /extension_cont. case: Rle_dec (Rle_refl a) => // _ _. case: Rle_dec => // H. by rewrite Heq. Qed. End ext_cont. Section ext_cont'. Context {V : NormedModule R_AbsRing}. Lemma extension_cont_is_derive (f g : R -> V) (a : R) (l : V) : is_derive f a l -> is_derive g a l -> f a = g a -> is_derive (extension_cont f g a) a l. Proof. case => _ Cf [_ Cg] Heq. split. by apply is_linear_scal_l. move => x Hx eps. move: (Cf x Hx eps) => {} Cf. move: (Cg x Hx eps) => {} Cg. generalize (is_filter_lim_locally_unique _ _ Hx) => {} Hx. rewrite -Hx {x Hx} in Cf, Cg |- *. generalize (filter_and _ _ Cf Cg). apply filter_imp => {Cf Cg} x [Cf Cg]. rewrite /extension_cont. case: Rle_dec => Hx ; case: Rle_dec (Rle_refl a) => //= _ _. by rewrite Heq. Qed. End ext_cont'. Section ext_C0. Context {V : NormedModule R_AbsRing}. Definition extension_C0 (f : R -> V) (a b : Rbar) (x : R) : V := match Rbar_le_dec a x with | left _ => match Rbar_le_dec x b with | left _ => f x | right _ => f (real b) end | right _ => f (real a) end. Lemma extension_C0_ext (f : R -> V) (a b : Rbar) : forall (x : R), Rbar_le a x -> Rbar_le x b -> (extension_C0 f a b) x = f x. Proof. move => x Hax Hxb. rewrite /extension_C0. case: Rbar_le_dec => // _. case: Rbar_le_dec => // _. Qed. Lemma extension_C0_continuous (f : R -> V) (a b : Rbar) : Rbar_le a b -> (forall x : R, Rbar_le a x -> Rbar_le x b -> continuous f x) -> forall x, continuous (extension_C0 f a b) x. Proof. intros Hab Cf x. apply Rbar_le_lt_or_eq_dec in Hab ; case: Hab => Hab. case: (Rbar_lt_le_dec x a) => Hax. eapply continuous_ext_loc. apply locally_interval with m_infty a. by []. by []. move => y _ Hay. rewrite /extension_C0. case: Rbar_le_dec => H. contradict H ; by apply Rbar_lt_not_le. reflexivity. apply continuous_const. apply Rbar_le_lt_or_eq_dec in Hax ; case: Hax => Hax. case: (Rbar_lt_le_dec x b) => Hbx. eapply continuous_ext_loc. apply locally_interval with a b. by []. by []. move => y Hay Hby. rewrite /extension_C0. case: Rbar_le_dec => H. case: Rbar_le_dec => H0. reflexivity. contradict H0 ; by apply Rbar_lt_le. contradict H ; by apply Rbar_lt_le. apply Cf ; by apply Rbar_lt_le. apply Rbar_le_lt_or_eq_dec in Hbx ; case: Hbx => Hbx. eapply continuous_ext_loc. apply locally_interval with b p_infty. by []. by []. move => y Hby _. rewrite /extension_C0. case: Rbar_le_dec => H. case: Rbar_le_dec => H0. contradict H0 ; by apply Rbar_lt_not_le. reflexivity. contradict H ; eapply Rbar_le_trans, Rbar_lt_le, Hby. by apply Rbar_lt_le. apply continuous_const. destruct b as [b | | ] => //. injection Hbx => {} Hbx. rewrite -Hbx {x Hbx} in Hax |- *. apply continuous_ext_loc with (extension_cont f (fun _ => f (real b)) b). apply locally_interval with a p_infty => //. move => y Hay _. rewrite /extension_cont /extension_C0. case: Rle_dec => H ; case: Rbar_le_dec => H0 ; case: (Rbar_le_dec y b) => // _. contradict H0 ; by apply Rbar_lt_le. contradict H0 ; by apply Rbar_lt_le. apply extension_cont_continuous => //. apply Cf => /=. by apply Rbar_lt_le. by apply Rle_refl. by apply continuous_const. destruct a as [a | | ] => //. injection Hax => {} Hax. rewrite -Hax {x Hax}. apply continuous_ext_loc with (extension_cont (fun _ => f (real a)) f a). apply locally_interval with m_infty b => //. move => y _ Hbx. rewrite /extension_cont /extension_C0. case: Rle_dec => H ; case: Rbar_le_dec => //= H0 ; try case: Rbar_le_dec => // H1. by replace y with a by now apply Rle_antisym. contradict H1 ; by apply Rbar_lt_le. contradict H1 ; by apply Rbar_lt_le. by contradict H0 ; apply Rlt_le, Rnot_le_lt. apply extension_cont_continuous => //. by apply continuous_const. apply Cf. by apply Rle_refl. by apply Rbar_lt_le. rewrite -Hab {b Hab Cf}. eapply continuous_ext. intros y. rewrite /extension_C0. case: Rbar_le_dec => H. 2: reflexivity. case: Rbar_le_dec => // H0. destruct a as [a | | ] => //. by replace y with a by now apply Rle_antisym. by apply continuous_const. Qed. End ext_C0. (** ** C1 extension *) Section ext_C1. Context {V : NormedModule R_AbsRing}. Definition extension_C1 (f df : R -> V) (a b : Rbar) (x : R) : V := match Rbar_le_dec a x with | left _ => match Rbar_le_dec x b with | left _ => f x | right _ => plus (f (real b)) (scal (x - real b) (df (real b))) end | right _ => plus (f (real a)) (scal (x - real a) (df (real a))) end. Lemma extension_C1_ext (f df : R -> V) (a b : Rbar) : forall (x : R), Rbar_le a x -> Rbar_le x b -> (extension_C1 f df a b) x = f x. Proof. move => x Hax Hxb. rewrite /extension_C1. case: Rbar_le_dec => // _. case: Rbar_le_dec => // _. Qed. Lemma extension_C1_is_derive (f df : R -> V) (a b : Rbar) : Rbar_le a b -> (forall x : R, Rbar_le a x -> Rbar_le x b -> is_derive f x (df x)) -> forall x : R, is_derive (extension_C1 f df a b) x (extension_C0 df a b x). Proof. intros Hab Cf x. apply Rbar_le_lt_or_eq_dec in Hab ; case: Hab => Hab. case: (Rbar_lt_le_dec x a) => Hax. evar_last. eapply is_derive_ext_loc. apply locally_interval with m_infty a. by []. by []. move => y _ Hay. rewrite /extension_C1. case: Rbar_le_dec => H. contradict H ; by apply Rbar_lt_not_le. reflexivity. apply is_derive_plus. apply is_derive_const. apply @is_derive_scal_l. apply @is_derive_minus. apply is_derive_id. apply is_derive_const. rewrite plus_zero_l minus_zero_r scal_one. rewrite /extension_C0. case: Rbar_le_dec => H //. by apply Rbar_le_not_lt in H. apply Rbar_le_lt_or_eq_dec in Hax ; case: Hax => Hax. case: (Rbar_lt_le_dec x b) => Hbx. evar_last. eapply is_derive_ext_loc. apply locally_interval with a b. by []. by []. move => y Hay Hby. apply sym_eq, extension_C1_ext ; by apply Rbar_lt_le. apply Cf ; by apply Rbar_lt_le. rewrite /extension_C0. case: Rbar_le_dec => // H. case: Rbar_le_dec => // H0. by apply Rbar_lt_le in Hbx. by apply Rbar_lt_le in Hax. apply Rbar_le_lt_or_eq_dec in Hbx ; case: Hbx => Hbx. evar_last. eapply is_derive_ext_loc. apply locally_interval with b p_infty. by []. by []. move => y Hby _. rewrite /extension_C1. case: Rbar_le_dec => H. case: Rbar_le_dec => H0. contradict H0 ; by apply Rbar_lt_not_le. reflexivity. contradict H ; eapply Rbar_le_trans, Rbar_lt_le, Hby. by apply Rbar_lt_le. apply is_derive_plus. apply is_derive_const. apply @is_derive_scal_l. apply @is_derive_minus. apply is_derive_id. apply is_derive_const. rewrite plus_zero_l minus_zero_r scal_one. rewrite /extension_C0. case: Rbar_le_dec => H //. case: Rbar_le_dec => H0 //. by apply Rbar_le_not_lt in H0. by apply Rbar_lt_le in Hax. destruct b as [b | | ] => //. injection Hbx => {} Hbx. rewrite -Hbx {x Hbx} in Hax |- *. evar_last. apply is_derive_ext_loc with (extension_cont f (fun x => plus (f (real b)) (scal (x - real b) (df (real b)))) b). apply locally_interval with a p_infty => //. move => y Hay _. rewrite /extension_cont /extension_C1. case: Rle_dec => H ; case: Rbar_le_dec => H0 ; case: (Rbar_le_dec y b) => // _. contradict H0 ; by apply Rbar_lt_le. contradict H0 ; by apply Rbar_lt_le. apply extension_cont_is_derive => //. apply Cf => /=. by apply Rbar_lt_le. by apply Rle_refl. evar_last. apply is_derive_plus. apply is_derive_const. apply @is_derive_scal_l. apply @is_derive_minus. apply is_derive_id. apply is_derive_const. by rewrite plus_zero_l minus_zero_r scal_one. by rewrite Rminus_eq_0 @scal_zero_l plus_zero_r. rewrite /extension_C0. case: Rbar_le_dec => H0. case: Rbar_le_dec (Rle_refl b) => //. by apply Rbar_lt_le in Hax. destruct a as [a | | ] => //. injection Hax => {} Hax. rewrite -Hax {x Hax}. evar_last. apply is_derive_ext_loc with (extension_cont (fun x => plus (f (real a)) (scal (x - real a) (df (real a)))) f a). apply locally_interval with m_infty b => //. move => y _ Hbx. rewrite /extension_cont /extension_C1. case: Rle_dec => H ; case: Rbar_le_dec => //= H0 ; try case: Rbar_le_dec => // H1. replace y with a by now apply Rle_antisym. by rewrite Rminus_eq_0 @scal_zero_l plus_zero_r. contradict H1 ; by apply Rbar_lt_le. contradict H1 ; by apply Rbar_lt_le. by contradict H0 ; apply Rlt_le, Rnot_le_lt. apply extension_cont_is_derive => //. apply is_derive_plus. apply is_derive_const. apply @is_derive_scal_l. apply @is_derive_minus. apply is_derive_id. apply is_derive_const. rewrite plus_zero_l minus_zero_r scal_one. apply Cf. by apply Rle_refl. by apply Rbar_lt_le. by rewrite Rminus_eq_0 @scal_zero_l plus_zero_r. rewrite plus_zero_l minus_zero_r scal_one. rewrite /extension_C0. case: Rbar_le_dec (Rle_refl a) => // _ _. case: Rbar_le_dec => H //. by apply Rbar_lt_le in Hab. rewrite -Hab {b Hab Cf}. evar_last. eapply is_derive_ext. intros y. rewrite /extension_C1. case: Rbar_le_dec => H. 2: reflexivity. case: Rbar_le_dec => // H0. destruct a as [a | | ] => //. replace y with a by now apply Rle_antisym. by rewrite Rminus_eq_0 @scal_zero_l plus_zero_r. apply is_derive_plus. apply is_derive_const. apply @is_derive_scal_l. apply @is_derive_minus. apply is_derive_id. apply is_derive_const. rewrite plus_zero_l minus_zero_r scal_one. rewrite /extension_C0. case: Rbar_le_dec => H //. case: Rbar_le_dec => H0 //. destruct a as [a | | ] => //. by replace a with x by now apply Rle_antisym. Qed. End ext_C1. Lemma extension_C1_ex_derive (f df : R -> R) (a b : Rbar) : Rbar_le a b -> (forall x : R, Rbar_le a x -> Rbar_le x b -> ex_derive f x) -> forall x : R, ex_derive (extension_C1 f (Derive f) a b) x. Proof. intros Hab Df x. eexists. apply extension_C1_is_derive => //. intros y Hay Hby. by apply Derive_correct, Df. Qed. Section NullDerivative. Context {V : NormedModule R_AbsRing}. Lemma eq_is_derive : forall (f : R -> V) (a b : R), (forall t, a <= t <= b -> is_derive f t zero) -> a < b -> f a = f b. Proof. intros f a b Hd Hab. apply ball_norm_eq => eps2. pose eps := pos_div_2 eps2. have Heps': 0 < eps / (b - a). apply Rdiv_lt_0_compat. apply eps. exact: Rlt_Rminus. pose eps' := mkposreal (eps / (b - a)) Heps'. pose P t := norm (minus (f t) (f a)) <= eps' * (t - a). pose A x := x <= b /\ forall t, a <= t <= x -> P t. have H c : (forall t, a <= t < c -> P t) -> a <= c <= b -> exists delta:posreal, (forall t, a <= t <= Rmin b (c + delta) -> P t). intros HP Hc. destruct (Hd c Hc) as [_ Hd']. refine (_ (Hd' c _ eps')). case => delta H. have Hdelta := cond_pos delta. exists (pos_div_2 delta) => t Ht. destruct (Rlt_le_dec t c) as [Htc|Htc]. apply HP. now split. unfold P. replace (minus (f t) (f a)) with (plus (minus (f t) (f c)) (minus (f c) (f a))). apply Rle_trans with (1 := norm_triangle _ _). replace (eps' * (t - a)) with (eps' * (t - c) + eps' * (c - a)) by ring. apply Rplus_le_compat. move: (H t) => {H}. rewrite scal_zero_r minus_zero_r -[norm (minus t c)]/(Rabs (t - c)). rewrite -> Rabs_pos_eq by lra. apply. apply: norm_compat1. change (Rabs (t - c) < delta). apply Rabs_lt_between'. cut (t <= c + delta/2). lra. apply Rle_trans with (1 := proj2 Ht). apply Rmin_r. set (d' := Rmax a (c - delta/2)). replace (minus (f c) (f a)) with (plus (opp (minus (f d') (f c))) (minus (f d') (f a))). apply Rle_trans with (1 := norm_triangle _ _). replace (eps' * (c - a)) with (eps' * (c - d') + eps' * (d' - a)) by ring. apply Rplus_le_compat. move: (H d') => {H}. rewrite scal_zero_r minus_zero_r -[norm (minus d' c)]/(Rabs (d' - c)). rewrite norm_opp -Rabs_Ropp Rabs_pos_eq Ropp_minus_distr. apply. apply: norm_compat1. change (Rabs (d' - c) < delta). apply Rabs_lt_between'. apply Rmax_case_strong ; lra. apply Rmax_case_strong ; lra. destruct (Req_dec a d') as [Had|Had]. rewrite Had. rewrite minus_eq_zero Rminus_eq_0 Rmult_0_r norm_zero. apply Rle_refl. apply HP. revert Had. apply Rmax_case_strong ; lra. by rewrite opp_minus /minus plus_assoc -(plus_assoc (f c)) plus_opp_l plus_zero_r. by rewrite /minus plus_assoc -(plus_assoc (f t)) plus_opp_l plus_zero_r. easy. assert (Ha : A a). apply (conj (Rlt_le _ _ Hab)). intros t [Ht1 Ht2]. rewrite (Rle_antisym _ _ Ht2 Ht1). rewrite /P /minus plus_opp_r /Rminus Rplus_opp_r Rmult_0_r norm_zero. apply Rle_refl. destruct (completeness A) as [s [Hs1 Hs2]]. now exists b => t [At _]. now exists a. assert (Hs: forall t, a <= t < s -> P t). intros t Ht. apply Rnot_lt_le => H'. specialize (Hs2 t). apply (Rlt_not_le _ _ (proj2 Ht)), Hs2. intros x [Ax1 Ax2]. apply Rnot_lt_le => Hxt. apply (Rlt_not_le _ _ H'). apply Ax2. lra. destruct (Req_dec s b) as [->|Hsb]. - destruct (H b) as [delta Hdelta]. apply Hs. lra. apply Rle_lt_trans with (eps' * (b - a)). apply: Hdelta. have Hdelta := cond_pos delta. rewrite Rmin_left ; lra. simpl. have Heps2 := cond_pos eps2. field_simplify ; lra. - destruct (H s) as [delta Hdelta]. apply Hs. split. now apply Hs1. apply Hs2. intros x. by case. eelim Rle_not_lt. apply Hs1. split. apply Rmin_l. apply Hdelta. apply Rmin_case. destruct (Hs2 b) ; try easy. intros x. by case. have Hdelta' := cond_pos delta. lra. Qed. End NullDerivative. (** * Iterated differential *) (** ** Definition *) Fixpoint Derive_n (f : R -> R) (n : nat) x := match n with | O => f x | S n => Derive (Derive_n f n) x end. Definition ex_derive_n f n x := match n with | O => True | S n => ex_derive (Derive_n f n) x end. Definition is_derive_n f n x l := match n with | O => f x = l | S n => is_derive (Derive_n f n) x l end. Lemma is_derive_n_unique f n x l : is_derive_n f n x l -> Derive_n f n x = l. Proof. case n. easy. simpl; intros n0 H. now apply is_derive_unique. Qed. Lemma Derive_n_correct f n x : ex_derive_n f n x -> is_derive_n f n x (Derive_n f n x). Proof. case: n => /= [ | n] Hf. by []. by apply Derive_correct. Qed. (** Extensionality *) Lemma Derive_n_ext_loc : forall f g n x, locally x (fun t => f t = g t) -> Derive_n f n x = Derive_n g n x. Proof. intros f g n x Heq. pattern x ; apply locally_singleton. induction n. exact Heq. apply locally_locally in IHn. apply filter_imp with (2 := IHn) => {IHn}. intros t H. now apply Derive_ext_loc. Qed. Lemma ex_derive_n_ext_loc : forall f g n x, locally x (fun t => f t = g t) -> ex_derive_n f n x -> ex_derive_n g n x. Proof. intros f g n x Heq. case: n => /= [ | n]. by []. apply ex_derive_ext_loc. apply locally_locally in Heq. apply filter_imp with (2 := Heq) => {Heq}. by apply Derive_n_ext_loc. Qed. Lemma is_derive_n_ext_loc : forall f g n x l, locally x (fun t => f t = g t) -> is_derive_n f n x l -> is_derive_n g n x l. Proof. intros f g n x l Heq. case: n => /= [ | n]. move => <- ; apply sym_eq. pattern x ; now apply locally_singleton. apply is_derive_ext_loc. apply locally_locally in Heq. apply filter_imp with (2 := Heq) => {Heq}. by apply Derive_n_ext_loc. Qed. Lemma Derive_n_ext : forall f g n x, (forall t, f t = g t) -> Derive_n f n x = Derive_n g n x. Proof. intros f g n x Heq. apply Derive_n_ext_loc. by apply filter_forall. Qed. Lemma ex_derive_n_ext : forall f g n x, (forall t, f t = g t) -> ex_derive_n f n x -> ex_derive_n g n x. Proof. intros f g n x Heq. apply ex_derive_n_ext_loc. by apply filter_forall. Qed. Lemma is_derive_n_ext : forall f g n x l, (forall t, f t = g t) -> is_derive_n f n x l -> is_derive_n g n x l. Proof. intros f g n x l Heq. apply is_derive_n_ext_loc. by apply filter_forall. Qed. Lemma Derive_n_comp: forall f n m x, Derive_n (Derive_n f m) n x = Derive_n f (n+m) x. Proof. intros f n m. induction n. now simpl. simpl. intros x. now apply Derive_ext. Qed. Lemma is_derive_Sn (f : R -> R) (n : nat) (x l : R) : locally x (ex_derive f) -> (is_derive_n f (S n) x l <-> is_derive_n (Derive f) n x l). Proof. move => Hf. case: n => /= [ | n]. split => H. by apply is_derive_unique. rewrite -H ; apply Derive_correct. now apply locally_singleton. split => Hf'. - apply is_derive_ext with (2 := Hf'). move => y ; rewrite (Derive_n_comp _ n 1%nat). by (replace (n + 1)%nat with (S n) by ring). - apply is_derive_ext with (2 := Hf'). move => y ; rewrite (Derive_n_comp _ n 1%nat). by (replace (n + 1)%nat with (S n) by ring). Qed. (** Constant function *) Lemma is_derive_n_const n a : forall x, is_derive_n (fun _ => a) (S n) x 0. Proof. elim: n => /= [ | n IH] x. by apply @is_derive_const. eapply is_derive_ext. intros t ; apply sym_equal, is_derive_unique, IH. by apply @is_derive_const. Qed. Lemma ex_derive_n_const a n x: ex_derive_n (fun _ => a) n x. Proof. case: n => //= ; case => //= [ | n]. apply ex_derive_const. eapply ex_derive_ext. intros t ; apply sym_equal, is_derive_unique, is_derive_n_const. by apply ex_derive_const. Qed. Lemma Derive_n_const n a : forall x, Derive_n (fun _ => a) (S n) x = 0. Proof. intros x ; apply is_derive_n_unique, is_derive_n_const. Qed. (** ** Operations *) (** *** Additive operators *) (** Opposite *) Lemma Derive_n_opp (f : R -> R) (n : nat) (x : R) : Derive_n (fun x => - f x) n x = - Derive_n f n x. Proof. elim: n x => [ | n IH] x /=. by []. rewrite -Derive_opp. by apply Derive_ext. Qed. Lemma ex_derive_n_opp (f : R -> R) (n : nat) (x : R) : ex_derive_n f n x -> ex_derive_n (fun x => -f x) n x. Proof. case: n x => [ | n] /= x Hf. by []. apply ex_derive_opp in Hf. apply: ex_derive_ext Hf. move => y ; by rewrite Derive_n_opp. Qed. Lemma is_derive_n_opp (f : R -> R) (n : nat) (x l : R) : is_derive_n f n x l -> is_derive_n (fun x => -f x) n x (- l). Proof. case: n x => [ | n] /= x Hf. by rewrite Hf. apply is_derive_opp in Hf. apply: is_derive_ext Hf. move => y ; by rewrite Derive_n_opp. Qed. (** Addition of functions *) Lemma Derive_n_plus (f g : R -> R) (n : nat) (x : R) : locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n f k y) -> locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n g k y) -> Derive_n (fun x => f x + g x) n x = Derive_n f n x + Derive_n g n x. Proof. elim: n x => /= [ | n IH] x [rf Hf] [rg Hg]. by []. rewrite -Derive_plus. apply Derive_ext_loc. set r := (mkposreal _ (Rmin_stable_in_posreal rf rg)) ; exists r => y Hy. rewrite /ball /= /AbsRing_ball /= in Hy. apply Rabs_lt_between' in Hy. case: Hy ; move/Rlt_Rminus => Hy1 ; move/Rlt_Rminus => Hy2. set r0 := mkposreal _ (Rmin_pos _ _ Hy1 Hy2). apply IH ; exists r0 => z Hz k Hk. apply Hf. rewrite /ball /= /AbsRing_ball /= in Hz. apply Rabs_lt_between' in Hz. rewrite /Rminus -Rmax_opp_Rmin Rplus_max_distr_l (Rplus_min_distr_l y) in Hz. case: Hz ; move => Hz1 Hz2. apply Rle_lt_trans with (1 := Rmax_l _ _) in Hz1 ; ring_simplify in Hz1. apply Rlt_le_trans with (2 := Rmin_r _ _) in Hz2 ; ring_simplify (y + (x + Rmin rf rg + - y)) in Hz2. have Hz := (conj Hz1 Hz2) => {Hz1 Hz2}. apply Rabs_lt_between' in Hz. apply Rlt_le_trans with (1 := Hz) => /= ; by apply Rmin_l. by apply Nat.le_trans with (1 := Hk), Nat.le_succ_diag_r. apply Hg. rewrite /ball /= /AbsRing_ball /= in Hz. apply Rabs_lt_between' in Hz. rewrite /Rminus -Rmax_opp_Rmin Rplus_max_distr_l (Rplus_min_distr_l y) in Hz. case: Hz ; move => Hz1 Hz2. apply Rle_lt_trans with (1 := Rmax_l _ _) in Hz1 ; ring_simplify in Hz1. apply Rlt_le_trans with (2 := Rmin_r _ _) in Hz2 ; ring_simplify (y + (x + Rmin rf rg + - y)) in Hz2. have Hz := (conj Hz1 Hz2) => {Hz1 Hz2}. apply Rabs_lt_between' in Hz. apply Rlt_le_trans with (1 := Hz) => /= ; by apply Rmin_r. by apply Nat.le_trans with (1 := Hk), Nat.le_succ_diag_r. apply Hf with (k := (S n)). by apply ball_center. by apply Nat.le_refl. apply Hg with (k := S n). by apply ball_center. by apply Nat.le_refl. Qed. Lemma ex_derive_n_plus (f g : R -> R) (n : nat) (x : R) : locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n f k y) -> locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n g k y) -> ex_derive_n (fun x => f x + g x) n x. Proof. case: n x => /= [ | n] x Hf Hg. by []. apply ex_derive_ext_loc with (fun y => Derive_n f n y + Derive_n g n y). apply locally_locally in Hf. apply locally_locally in Hg. generalize (filter_and _ _ Hf Hg). apply filter_imp => {Hf Hg} y [Hf Hg]. apply sym_eq, Derive_n_plus. apply filter_imp with (2 := Hf) ; by intuition. apply filter_imp with (2 := Hg) ; by intuition. apply: ex_derive_plus. apply locally_singleton ; apply filter_imp with (2 := Hf) => {Hf} y Hy ; by apply (Hy (S n)). apply locally_singleton ; apply filter_imp with (2 := Hg) => {Hg} y Hy ; by apply (Hy (S n)). Qed. Lemma is_derive_n_plus (f g : R -> R) (n : nat) (x lf lg : R) : locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n f k y) -> locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n g k y) -> is_derive_n f n x lf -> is_derive_n g n x lg -> is_derive_n (fun x => f x + g x) n x (lf + lg). Proof. case: n x lf lg => /= [ | n] x lf lg Hfn Hgn Hf Hg. by rewrite Hf Hg. apply is_derive_ext_loc with (fun y => Derive_n f n y + Derive_n g n y). apply locally_locally in Hfn. apply locally_locally in Hgn. generalize (filter_and _ _ Hfn Hgn). apply filter_imp => {Hfn Hgn} y [Hfn Hgn]. apply sym_eq, Derive_n_plus. apply filter_imp with (2 := Hfn) ; by intuition. apply filter_imp with (2 := Hgn) ; by intuition. by apply: is_derive_plus. Qed. Lemma is_derive_n_iter_plus {I : Type} (l : list I) (f : I -> R -> R) (n: nat) (x : R) : locally x (fun y => forall (j : I) (k : nat), List.In j l -> (k <= n)%nat -> ex_derive_n (f j) k y) -> is_derive_n (fun y => iter Rplus 0 l (fun j => f j y)) n x (iter Rplus 0 l (fun j => Derive_n (f j) n x)). Proof. intros H. elim: n {-2}n x (Nat.le_refl n) H => [ | n IH] m x Hn Hx. now replace m with O by intuition. apply le_lt_eq_dec in Hn ; case: Hn => Hn. apply IH => //. by apply Nat.lt_succ_r. rewrite Hn in Hx |- * => {m Hn} /=. eapply is_derive_ext_loc. eapply filter_imp. intros y Hy. apply sym_equal, is_derive_n_unique. apply IH. by apply Nat.le_refl. apply Hy. apply locally_locally. move: Hx ; apply filter_imp. move => y Hy j k Hj Hk. apply Hy => //. now eapply Nat.le_trans, Nat.le_succ_diag_r. eapply filterdiff_ext_lin. apply @filterdiff_iter_plus_fct => //. apply locally_filter. intros. apply Derive_correct. apply ((locally_singleton _ _ Hx) j (S n) H (Nat.le_refl _)). simpl => y. clear ; elim: l => /= [ | h l IH]. by rewrite scal_zero_r. by rewrite IH scal_distr_l. Qed. Lemma ex_derive_n_iter_plus {I : Type} (l : list I) (f : I -> R -> R) (n: nat) (x : R) : locally x (fun y => forall (j : I) (k : nat), List.In j l -> (k <= n)%nat -> ex_derive_n (f j) k y) -> ex_derive_n (fun y => iter Rplus 0 l (fun j => f j y)) n x. Proof. case: n => //= n H. eexists. by apply (is_derive_n_iter_plus l f (S n)). Qed. Lemma Derive_n_iter_plus {I : Type} (l : list I) (f : I -> R -> R) (n: nat) (x : R) : locally x (fun y => forall (j : I) (k : nat), List.In j l -> (k <= n)%nat -> ex_derive_n (f j) k y) -> Derive_n (fun y => iter Rplus 0 l (fun j => f j y)) n x = iter Rplus 0 l (fun j => Derive_n (f j) n x). Proof. intros H. apply is_derive_n_unique. by apply is_derive_n_iter_plus. Qed. Lemma is_derive_n_sum_n_m n m (f : nat -> R -> R) (k: nat) (x : R) : locally x (fun t => forall l j , (n <= l <= m)%nat ->(j <= k)%nat -> ex_derive_n (f l) j t) -> is_derive_n (fun y => sum_n_m (fun j => f j y) n m) k x (sum_n_m (fun j => Derive_n (f j) k x) n m). Proof. intros. apply is_derive_n_iter_plus. move: H ; apply filter_imp ; intros. apply H => //. by apply In_iota. Qed. Lemma ex_derive_n_sum_n_m n m (f : nat -> R -> R) (k: nat) (x : R) : locally x (fun t => forall l j , (n <= l <= m)%nat ->(j <= k)%nat -> ex_derive_n (f l) j t) -> ex_derive_n (fun y => sum_n_m (fun j => f j y) n m) k x. Proof. intros. apply ex_derive_n_iter_plus. move: H ; apply filter_imp ; intros. apply H => //. by apply In_iota. Qed. Lemma Derive_n_sum_n_m n m (f : nat -> R -> R) (k: nat) (x : R) : locally x (fun t => forall l j , (n <= l <= m)%nat ->(j <= k)%nat -> ex_derive_n (f l) j t) -> Derive_n (fun y => sum_n_m (fun j => f j y) n m) k x = sum_n_m (fun j => Derive_n (f j) k x) n m. Proof. intros. apply Derive_n_iter_plus. move: H ; apply filter_imp ; intros. apply H => //. by apply In_iota. Qed. Lemma is_derive_n_sum_n n (f : nat -> R -> R) (k: nat) (x : R) : locally x (fun t => forall l j , (l <= n)%nat ->(j <= k)%nat -> ex_derive_n (f l) j t) -> is_derive_n (fun y => sum_n (fun j => f j y) n) k x (sum_n (fun j => Derive_n (f j) k x) n). Proof. intros. apply is_derive_n_sum_n_m. move: H ; apply filter_imp ; intros. apply H => //. by apply H0. Qed. Lemma ex_derive_n_sum_n n (f : nat -> R -> R) (k: nat) (x : R) : locally x (fun t => forall l j , (l <= n)%nat ->(j <= k)%nat -> ex_derive_n (f l) j t) -> ex_derive_n (fun y => sum_n (fun j => f j y) n) k x. Proof. intros. apply ex_derive_n_sum_n_m. move: H ; apply filter_imp ; intros. apply H => //. by apply H0. Qed. Lemma Derive_n_sum_n n (f : nat -> R -> R) (k: nat) (x : R) : locally x (fun t => forall l j , (l <= n)%nat ->(j <= k)%nat -> ex_derive_n (f l) j t) -> Derive_n (fun y => sum_n (fun j => f j y) n) k x = (sum_n (fun j => Derive_n (f j) k x) n). Proof. intros. apply Derive_n_sum_n_m. move: H ; apply filter_imp ; intros. apply H => //. by apply H0. Qed. (** Subtraction of functions *) Lemma Derive_n_minus (f g : R -> R) (n : nat) (x : R) : locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n f k y) -> locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n g k y) -> Derive_n (fun x => f x - g x) n x = Derive_n f n x - Derive_n g n x. Proof. move => Hf Hg. rewrite Derive_n_plus. by rewrite Derive_n_opp. by []. move: Hg ; apply filter_imp => y Hg k Hk. apply ex_derive_n_opp ; by apply Hg. Qed. Lemma ex_derive_n_minus (f g : R -> R) (n : nat) (x : R) : locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n f k y) -> locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n g k y) -> ex_derive_n (fun x => f x - g x) n x. Proof. move => Hf Hg. apply ex_derive_n_plus. by []. move: Hg ; apply filter_imp => y Hg k Hk. apply ex_derive_n_opp ; by apply Hg. Qed. Lemma is_derive_n_minus (f g : R -> R) (n : nat) (x lf lg : R) : locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n f k y) -> locally x (fun y => forall k, (k <= n)%nat -> ex_derive_n g k y) -> is_derive_n f n x lf -> is_derive_n g n x lg -> is_derive_n (fun x => f x - g x) n x (lf - lg). Proof. move => Hf Hg Df Dg. apply is_derive_n_plus. by []. move: Hg ; apply filter_imp => y Hg k Hk. apply ex_derive_n_opp ; by apply Hg. by []. by apply is_derive_n_opp. Qed. (** *** Multiplicative operators *) (** Scalar multiplication *) Lemma Derive_n_scal_l (f : R -> R) (n : nat) (a x : R) : Derive_n (fun y => a * f y) n x = a * Derive_n f n x. Proof. elim: n x => /= [ | n IH] x. by []. rewrite -Derive_scal. by apply Derive_ext. Qed. Lemma ex_derive_n_scal_l (f : R -> R) (n : nat) (a x : R) : ex_derive_n f n x -> ex_derive_n (fun y => a * f y) n x. Proof. case: n x => /= [ | n] x Hf. by []. apply ex_derive_ext with (fun y => a * Derive_n f n y). move => t ; by rewrite Derive_n_scal_l. now apply ex_derive_scal. Qed. Lemma is_derive_n_scal_l (f : R -> R) (n : nat) (a x l : R) : is_derive_n f n x l -> is_derive_n (fun y => a * f y) n x (a * l). Proof. case: n x => /= [ | n] x Hf. by rewrite Hf. eapply filterdiff_ext_lin. apply filterdiff_ext with (fun y => a * Derive_n f n y). move => t ; by rewrite Derive_n_scal_l. apply @filterdiff_scal_r_fct ; try by apply locally_filter. by apply Rmult_comm. apply Hf. move => /= y. rewrite /scal /= /mult /=. ring. Qed. Lemma Derive_n_scal_r (f : R -> R) (n : nat) (a x : R) : Derive_n (fun y => f y * a) n x = Derive_n f n x * a. Proof. rewrite Rmult_comm -Derive_n_scal_l. apply Derive_n_ext => y ; ring. Qed. Lemma ex_derive_n_scal_r (f : R -> R) (n : nat) (a x : R) : ex_derive_n f n x -> ex_derive_n (fun y => f y * a) n x. Proof. move/(ex_derive_n_scal_l _ _ a). apply ex_derive_n_ext => y ; ring. Qed. Lemma is_derive_n_scal_r (f : R -> R) (n : nat) (a x l : R) : is_derive_n f n x l -> is_derive_n (fun y => f y * a) n x (l * a). Proof. move/(is_derive_n_scal_l _ _ a). rewrite Rmult_comm. apply is_derive_n_ext => y ; ring. Qed. (** *** Composition *) (** Composition with linear functions *) Lemma Derive_n_comp_scal (f : R -> R) (a : R) (n : nat) (x : R) : locally (a * x) (fun x => forall k, (k <= n)%nat -> ex_derive_n f k x) -> Derive_n (fun y => f (a * y)) n x = (a ^ n * Derive_n f n (a * x)). Proof. case: (Req_dec a 0) => [ -> _ | Ha] /=. rewrite Rmult_0_l. elim: n x => [ | n IH] x /= ; rewrite ?Rmult_0_l. ring. rewrite (Derive_ext _ _ _ IH). by apply Derive_const. move => Hf. apply (locally_singleton _ (fun x => Derive_n (fun y : R => f (a * y)) n x = a ^ n * Derive_n f n (a * x))). elim: n Hf => [ | n IH] Hf. apply filter_forall => /= y ; ring. case: IH => [ | r IH]. case: Hf => r0 Hf. exists r0 => y Hy k Hk ; by intuition. case: Hf => r0 Hf. have Hr1 : 0 < Rmin (r0 / (Rabs a)) r. apply Rmin_case. apply Rdiv_lt_0_compat. by apply r0. by apply Rabs_pos_lt. by apply r. set r1 := mkposreal _ Hr1. exists r1 => y Hy /=. rewrite (Derive_ext_loc _ (fun y => a ^ n * Derive_n f n (a * y))). rewrite Derive_scal. rewrite (Rmult_comm a (a^n)) Rmult_assoc. apply f_equal. rewrite Derive_comp. rewrite (Derive_ext (Rmult a) (fun x => a * x)) => //. rewrite Derive_scal Derive_id ; ring. apply Hf with (k := S n). rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=. rewrite -/(Rminus _ _) -Rmult_minus_distr_l Rabs_mult. apply Rlt_le_trans with (Rabs a * r1). apply Rmult_lt_compat_l. by apply Rabs_pos_lt. by apply Hy. rewrite Rmult_comm ; apply Rle_div_r. by apply Rabs_pos_lt. rewrite /r1 ; by apply Rmin_l. by apply Nat.lt_succ_diag_r. apply ex_derive_scal. by apply ex_derive_id. rewrite /ball /= /AbsRing_ball /= in Hy. apply Rabs_lt_between' in Hy. case: Hy => Hy1 Hy2. apply Rlt_Rminus in Hy1. apply Rlt_Rminus in Hy2. have Hy : 0 < Rmin (y - (x - r1)) (x + r1 - y). by apply Rmin_case. exists (mkposreal (Rmin (y - (x - r1)) (x + r1 - y)) Hy). set r2 := Rmin (y - (x - r1)) (x + r1 - y). move => t Ht. apply IH. apply Rabs_lt_between'. rewrite /ball /= /AbsRing_ball /= in Ht. apply Rabs_lt_between' in Ht. simpl in Ht. split. apply Rle_lt_trans with (2 := proj1 Ht). rewrite /r2 ; apply Rle_trans with (y-(y-(x-r1))). ring_simplify ; apply Rplus_le_compat_l, Ropp_le_contravar. rewrite /r1 ; apply Rmin_r. apply Rplus_le_compat_l, Ropp_le_contravar, Rmin_l. apply Rlt_le_trans with (1 := proj2 Ht). rewrite /r2 ; apply Rle_trans with (y+((x+r1)-y)). apply Rplus_le_compat_l, Rmin_r. ring_simplify ; apply Rplus_le_compat_l. rewrite /r1 ; apply Rmin_r. Qed. Lemma ex_derive_n_comp_scal (f : R -> R) (a : R) (n : nat) (x : R) : locally (a * x) (fun x => forall k, (k <= n)%nat -> ex_derive_n f k x) -> ex_derive_n (fun y => f (a * y)) n x. Proof. case: n f x => /= [ | n] f x Hf. by []. case: (Req_dec a 0) => Ha. rewrite Ha => {a Ha Hf}. apply ex_derive_ext with (fun _ => Derive_n (fun y : R => f (0 * y)) n 0). elim: n => /= [ | n IH] t. by rewrite ?Rmult_0_l. rewrite -?(Derive_ext _ _ _ IH). by rewrite ?Derive_const. by apply ex_derive_const. apply ex_derive_ext_loc with (fun x => a^n * Derive_n f n (a * x)). case: Hf => r Hf. have Hr0 : 0 < r / Rabs a. apply Rdiv_lt_0_compat. by apply r. by apply Rabs_pos_lt. exists (mkposreal _ Hr0) => /= y Hy. apply eq_sym, Derive_n_comp_scal. have : Rabs (a*y - a*x) < r. rewrite -Rmult_minus_distr_l Rabs_mult. replace (pos r) with (Rabs a * (r / Rabs a)) by (field ; by apply Rgt_not_eq, Rabs_pos_lt). apply Rmult_lt_compat_l. by apply Rabs_pos_lt. by apply Hy. move => {} Hy. apply Rabs_lt_between' in Hy ; case: Hy => Hy1 Hy2. apply Rlt_Rminus in Hy1. apply Rlt_Rminus in Hy2. exists (mkposreal _ (Rmin_pos _ _ Hy1 Hy2)) => /= z Hz k Hk. rewrite /ball /= /AbsRing_ball /= in Hz. apply Rabs_lt_between' in Hz ; case: Hz => Hz1 Hz2. rewrite /Rminus -Rmax_opp_Rmin in Hz1. rewrite Rplus_min_distr_l in Hz2. apply Rlt_le_trans with (2 := Rmin_r _ _) in Hz2. ring_simplify in Hz2. rewrite Rplus_max_distr_l in Hz1. apply Rle_lt_trans with (1 := Rmax_l _ _) in Hz1. ring_simplify in Hz1. apply Hf. apply Rabs_lt_between' ; by split. by intuition. apply ex_derive_scal. apply ex_derive_comp. apply (locally_singleton _ _) in Hf. by apply Hf with (k := S n). apply (ex_derive_scal id a x (ex_derive_id _)). Qed. Lemma is_derive_n_comp_scal (f : R -> R) (a : R) (n : nat) (x l : R) : locally (a * x) (fun x => forall k, (k <= n)%nat -> ex_derive_n f k x) -> is_derive_n f n (a * x) l -> is_derive_n (fun y => f (a * y)) n x (a ^ n * l). Proof. case: n => /= [ | n] Hfn Hf. by rewrite Rmult_1_l. apply is_derive_unique in Hf. rewrite -Hf. rewrite -(Derive_n_comp_scal f a (S n) x) => //. apply Derive_correct. by apply (ex_derive_n_comp_scal f a (S n) x). Qed. Lemma Derive_n_comp_opp (f : R -> R) (n : nat) (x : R) : locally (- x) (fun y => (forall k, (k <= n)%nat -> ex_derive_n f k y)) -> Derive_n (fun y => f (- y)) n x = ((-1) ^ n * Derive_n f n (-x)). Proof. move => Hf. rewrite -(Derive_n_ext (fun y : R => f (-1 * y))). rewrite (Derive_n_comp_scal f (-1) n x). by replace (-1*x) with (-x) by ring. by replace (-1*x) with (-x) by ring. move => t ; by replace (-1*t) with (-t) by ring. Qed. Lemma ex_derive_n_comp_opp (f : R -> R) (n : nat) (x : R) : locally (- x) (fun y => (forall k, (k <= n)%nat -> ex_derive_n f k y)) -> ex_derive_n (fun y => f (- y)) n x. Proof. move => Hf. apply (ex_derive_n_ext (fun y : R => f (-1 * y))). move => t ; by ring_simplify (-1*t). apply (ex_derive_n_comp_scal f (-1) n x). by replace (-1*x) with (-x) by ring. Qed. Lemma is_derive_n_comp_opp (f : R -> R) (n : nat) (x l : R) : locally (- x) (fun y => (forall k, (k <= n)%nat -> ex_derive_n f k y)) -> is_derive_n f n (-x) l -> is_derive_n (fun y => f (- y)) n x ((-1)^n * l). Proof. move => Hfn Hf. apply (is_derive_n_ext (fun y : R => f (-1 * y))). move => t ; by ring_simplify (-1*t). apply (is_derive_n_comp_scal f (-1) n x). by replace (-1*x) with (-x) by ring. by replace (-1*x) with (-x) by ring. Qed. Lemma Derive_n_comp_trans (f : R -> R) (n : nat) (x b : R) : Derive_n (fun y => f (y + b)) n x = Derive_n f n (x + b). Proof. elim: n x => [ | n IH] x /=. by []. rewrite (Derive_ext _ _ _ IH) => {IH}. generalize (Derive_n f n) => {} f. apply (f_equal real). apply Lim_ext => y. replace (x + b + y) with (x + y + b) by ring. by []. Qed. Lemma ex_derive_n_comp_trans (f : R -> R) (n : nat) (x b : R) : ex_derive_n f n (x + b) -> ex_derive_n (fun y => f (y + b)) n x. Proof. case: n => [ | n] /= Df. by []. apply ex_derive_ext with (fun x => Derive_n f n (x + b)). simpl => t. apply sym_eq, Derive_n_comp_trans. move: (Derive_n f n) Df => {} f Df. apply ex_derive_comp. apply Df. apply: ex_derive_plus. apply ex_derive_id. apply ex_derive_const. Qed. Lemma is_derive_n_comp_trans (f : R -> R) (n : nat) (x b l : R) : is_derive_n f n (x + b) l -> is_derive_n (fun y => f (y + b)) n x l. Proof. case: n => [ | n] /= Df. by []. apply is_derive_ext with (fun x => Derive_n f n (x + b)). simpl => t. apply sym_eq, Derive_n_comp_trans. move: (Derive_n f n) Df => {} f Df. eapply filterdiff_ext_lin. apply @filterdiff_comp'. apply @filterdiff_plus_fct ; try by apply locally_filter. by apply filterdiff_id. by apply filterdiff_const. by apply Df. simpl => y. by rewrite plus_zero_r. Qed. (** * Taylor-Lagrange formula *) Theorem Taylor_Lagrange : forall f n x y, x < y -> ( forall t, x <= t <= y -> forall k, (k <= S n)%nat -> ex_derive_n f k t ) -> exists zeta, x < zeta < y /\ f y = sum_f_R0 (fun m => (y-x) ^ m / INR (fact m) * Derive_n f m x ) n + (y-x) ^ (S n) / INR (fact (S n)) * Derive_n f (S n) zeta. Proof. intros f n x y Hxy Df. pose (c:= (f y - sum_f_R0 (fun m => (y-x) ^ m / INR (fact m) * Derive_n f m x ) n) / (y-x) ^ (S n)). pose (g t := f y - sum_f_R0 (fun m => (y-t) ^ m / INR (fact m) * Derive_n f m t ) n - c * (y-t) ^ (S n)). assert (Dg : forall t, x <= t <= y -> is_derive g t (- (y-t) ^ n / INR (fact n) * Derive_n f (S n) t + c * INR (S n) * (y-t) ^ n)). intros t Ht. unfold g. assert (Dp: forall n, derivable_pt_lim (fun x0 : R => (y - x0) ^ S n) t (INR (S n) * (y - t) ^ n * (0 - 1))). intros m. apply (derivable_pt_lim_comp (fun t => y - t) (fun t => t ^ (S m))). apply derivable_pt_lim_minus. apply derivable_pt_lim_const. apply derivable_pt_lim_id. apply derivable_pt_lim_pow. (* *) apply: is_derive_plus. (* . *) clear c g. rename n into N. generalize (Nat.le_refl N). generalize N at -2. intros n Hn. move: Hn. induction n. (* .. *) intros _. simpl. eapply filterdiff_ext_lin. apply @filterdiff_minus_fct ; try by apply locally_filter. apply filterdiff_const. apply @filterdiff_scal_r_fct with (f := fun u => f u). by apply locally_filter. by apply Rmult_comm. apply Derive_correct. apply (Df t Ht 1%nat). apply le_n_S. apply Nat.le_0_l. simpl => z. rewrite /minus /plus /opp /zero /scal /= /mult /=. field. (* .. *) intros Hn. apply filterdiff_ext with (fun x0 : R => (f y - (sum_f_R0 (fun m : nat => (y - x0) ^ m / INR (fact m) * Derive_n f m x0) n)) - (y - x0) ^ (S n) / INR (fact (S n)) * Derive_n f (S n) x0). simpl. intros; ring. eapply filterdiff_ext_lin. apply @filterdiff_plus_fct ; try by apply locally_filter. apply IHn. now apply Nat.lt_le_incl. apply @filterdiff_opp_fct ; try by apply locally_filter. generalize (filterdiff_mult_fct (fun x0 => ((y - x0) ^ S n / INR (fact (S n)))) (fun x0 => Derive_n f (S n) x0)) => /= H. apply H ; clear H. by apply Rmult_comm. apply @filterdiff_scal_l_fct ; try by apply locally_filter. generalize (filterdiff_comp' (fun u => y - u) (fun x => pow x (S n))) => /= H ; apply H ; clear H. apply @filterdiff_minus_fct ; try apply locally_filter. apply filterdiff_const. apply filterdiff_id. apply is_derive_Reals. apply (derivable_pt_lim_pow _ (S n)). apply Derive_correct. apply (Df t Ht (S (S n))). now apply le_n_S. move => z. change (fact (S n)) with ((S n)*fact n)%nat. rewrite mult_INR. set v := INR (S n). rewrite /minus /plus /opp /zero /scal /= /mult /=. field. split. apply INR_fact_neq_0. now apply not_0_INR. (* . *) eapply filterdiff_ext_lin. apply filterdiff_ext with (fun x0 : R => -c * (y - x0) ^ S n). simpl => z ; ring. apply @filterdiff_scal_r_fct ; try by apply locally_filter. by apply Rmult_comm. apply is_derive_Reals, Dp. set v := INR (S n). simpl => z. rewrite /scal /= /mult /=. ring. (* *) assert (Dg' : forall t : R, x <= t <= y -> derivable_pt g t). intros t Ht. exists (Derive g t). apply is_derive_Reals. apply Derive_correct. eexists. apply (Dg t Ht). assert (pr : forall t : R, x < t < y -> derivable_pt g t). intros t Ht. apply Dg'. split ; now apply Rlt_le. (* *) assert (Zxy: (y - x) ^ (S n) <> 0). apply pow_nonzero. apply Rgt_not_eq. apply Rplus_gt_reg_l with x. now ring_simplify. (* *) destruct (Rolle g x y pr) as (zeta, (Hzeta1,Hzeta2)). intros t Ht. apply derivable_continuous_pt. now apply Dg'. exact Hxy. apply trans_eq with 0. unfold g, c. now field. unfold g. destruct n. simpl; field. rewrite decomp_sum. rewrite sum_eq_R0. simpl; field. intros; simpl; field. exact (INR_fact_neq_0 (S n0)). apply Nat.lt_0_succ. exists zeta. apply (conj Hzeta1). rewrite Rmult_assoc. replace (/ INR (fact (S n)) * Derive_n f (S n) zeta) with c. unfold c. now field. apply Rmult_eq_reg_r with (INR (S n) * (y - zeta) ^ n). apply Rplus_eq_reg_l with ((- (y - zeta) ^ n / INR (fact n) * Derive_n f (S n) zeta)). change (fact (S n)) with (S n * fact n)%nat. rewrite mult_INR. apply trans_eq with 0. rewrite -Rmult_assoc. assert (H: x <= zeta <= y) by (split ; apply Rlt_le ; apply Hzeta1). rewrite -(is_derive_unique _ _ _ (Dg _ H)). destruct (pr zeta Hzeta1) as (x0,Hd). simpl in Hzeta2. rewrite Hzeta2 in Hd. now apply is_derive_unique, is_derive_Reals. field. split. apply INR_fact_neq_0. now apply not_0_INR. apply Rmult_integral_contrapositive_currified. now apply not_0_INR. apply pow_nonzero. apply Rgt_not_eq. apply Rplus_gt_reg_l with zeta. ring_simplify. apply Hzeta1. Qed. coquelicot-coquelicot-3.4.1/theories/Derive_2d.v000066400000000000000000001336331455143432500216660ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Hierarchy Continuity Derive. (** This file describes results about differentiability in [R x R]. This includes the [Schwarz] theorem and the 2D Taylor-Lagrange inequality. *) (** * Differentiability *) Definition differentiable_pt_lim (f : R -> R -> R) (x y : R) (lx ly : R) := forall eps : posreal, locally_2d (fun u v => Rabs (f u v - f x y - (lx * (u - x) + ly * (v - y))) <= eps * Rmax (Rabs (u - x)) (Rabs (v - y))) x y. Lemma filterdiff_differentiable_pt_lim (f : R -> R -> R) (x y lx ly : R) : filterdiff (fun u : R * R => f (fst u) (snd u)) (locally (x,y)) (fun u : R * R => fst u * lx + snd u * ly) <-> differentiable_pt_lim f x y lx ly. Proof. split => Df. move => eps. case: Df => _ Df. assert (is_filter_lim (locally (x, y)) (x, y)) by now intro. specialize (Df (x,y) H) => {H}. apply locally_2d_locally. assert (0 < eps / sqrt 2). apply Rdiv_lt_0_compat. by apply eps. by apply Rlt_sqrt2_0. move: (Df (mkposreal _ H)). apply filter_imp => [[u v] /= Huv]. rewrite !(Rmult_comm _ (_-_)). eapply Rle_trans. apply Huv. rewrite Rmult_assoc. apply Rmult_le_compat_l. by apply Rlt_le, eps. rewrite Rmult_comm Rle_div_l. rewrite Rmult_comm. eapply Rle_trans. apply norm_prod. apply Rle_refl. by apply Rlt_sqrt2_0. split. apply (is_linear_comp (fun u : R * R => (scal (fst u) lx,scal (snd u) ly)) (fun u : R * R => plus (fst u) (snd u))). apply is_linear_prod. apply (is_linear_comp (@fst _ _) (fun t : R => scal t lx)). by apply is_linear_fst. by apply @is_linear_scal_l. apply (is_linear_comp (@snd _ _) (fun t : R => scal t ly)). by apply is_linear_snd. by apply @is_linear_scal_l. by apply @is_linear_plus. simpl => u Hu. replace u with (x,y) by now apply is_filter_lim_locally_unique. move => {u Hu} eps /=. move: (proj1 (locally_2d_locally _ _ _) (Df eps)). apply filter_imp => [[u v]] /= Huv. rewrite !(Rmult_comm (_-_)). eapply Rle_trans. apply Huv. apply Rmult_le_compat_l. by apply Rlt_le, eps. apply (norm_prod (u - x) (v - y)). Qed. Lemma differentiable_pt_lim_ext : forall f1 f2 x y lx ly, locally_2d (fun u v => f1 u v = f2 u v) x y -> differentiable_pt_lim f1 x y lx ly -> differentiable_pt_lim f2 x y lx ly. Proof. intros f1 f2 x y lx ly H H1 eps. apply: locally_2d_impl (H1 eps) => {H1}. rewrite (locally_2d_singleton _ _ _ H). apply: locally_2d_impl H. apply locally_2d_forall. now intros u v ->. Qed. Definition differentiable_pt (f : R -> R -> R) (x y : R) := exists lx, exists ly, differentiable_pt_lim f x y lx ly. Lemma differentiable_continuity_pt : forall f x y, differentiable_pt f x y -> continuity_2d_pt f x y. Proof. intros f x y (l1&l2&Df) eps ; simpl in Df. assert (0 < eps / 2). apply Rdiv_lt_0_compat ; [apply eps|apply Rlt_R0_R2]. set (eps' := mkposreal _ H). elim (Df eps') ; clear Df ; intros d0 Df. assert (0 < Rmin (Rmin d0 1) (Rmin (eps/(4*Rmax (Rabs l1) 1)) (eps / (4* Rmax (Rabs l2) 1)))). apply Rmin_pos ; apply Rmin_pos. apply d0. apply Rlt_0_1. apply Rdiv_lt_0_compat. apply eps. apply Rmult_lt_0_compat. apply Rmult_lt_0_compat ; apply Rlt_R0_R2. apply (Rlt_le_trans _ _ _ Rlt_0_1 (RmaxLess2 _ _)). apply Rdiv_lt_0_compat. apply eps. apply Rmult_lt_0_compat. apply Rmult_lt_0_compat ; apply Rlt_R0_R2. apply (Rlt_le_trans _ _ _ Rlt_0_1 (RmaxLess2 _ _)). set (delta := mkposreal _ H0). exists delta ; intros x' y' H1 H2. rewrite (double_var eps). apply (Rle_lt_trans _ (Rabs (f x' y' - f x y - (l1 * (x' - x) + l2 * (y' - y))) + Rabs (l1 * (x' - x) + l2 * (y' - y)))). assert (Rabs (f x' y' - f x y) = Rabs ((f x' y' - f x y - (l1 * (x' - x) + l2 * (y' - y))) + (l1 * (x' - x) + l2 * (y' - y)))). assert ((f x' y' - f x y) = (f x' y' - f x y - (l1 * (x' - x) + l2 * (y' - y)) + (l1 * (x' - x) + l2 * (y' - y)))). ring. rewrite <- H3 ; clear H3 ; reflexivity. rewrite H3 ; clear H3 ; apply Rabs_triang. apply Rplus_lt_le_compat. apply (Rle_lt_trans _ (eps' * Rmax (Rabs (x' - x)) (Rabs (y' - y)))). apply Df. apply (Rlt_le_trans _ _ _ H1) ; unfold delta ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_l _ _)). apply (Rlt_le_trans _ _ _ H2) ; unfold delta ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_l _ _)). rewrite <- (Rmult_1_r (eps/2)) ; unfold eps' ; simpl. apply Rmult_lt_compat_l. apply H. apply (Rlt_le_trans _ delta). apply (Rmax_lub_lt _ _ _ H1 H2). unfold delta ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_r _ _)). apply (Rle_trans _ (Rabs l1 * Rabs (x'-x) + Rabs l2 * Rabs (y'-y))). repeat rewrite <- Rabs_mult. apply Rabs_triang. rewrite (double_var (eps/2)). apply Rplus_le_compat. apply (Rle_trans _ (Rabs l1 * delta)). apply Rmult_le_compat_l. apply Rabs_pos. apply Rlt_le, H1. apply (Rle_trans _ (Rabs l1 * (Rmin (eps / (4 * Rmax (Rabs l1) 1)) (eps / (4 * Rmax (Rabs l2) 1))))). apply Rmult_le_compat_l ; unfold delta ; simpl ; [apply Rabs_pos| apply Rmin_r]. apply (Rle_trans _ (Rabs l1 * (eps / (4 * Rmax (Rabs l1) 1)))). apply Rmult_le_compat_l ; [apply Rabs_pos | apply Rmin_l]. unfold Rmax ; destruct (Rle_dec (Rabs l1) 1). rewrite <- (Rmult_1_l (eps/2/2)). apply Rmult_le_compat. apply Rabs_pos. apply Rlt_le, Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat ; [apply Rmult_lt_0_compat ; apply Rlt_R0_R2|apply Rlt_0_1]]. apply r. apply Req_le ; field. apply Req_le ; field. apply Rnot_le_lt in n. apply sym_not_eq, Rlt_not_eq, (Rlt_trans _ _ _ Rlt_0_1 n). apply (Rle_trans _ (Rabs l2 * delta)). apply Rmult_le_compat_l. apply Rabs_pos. apply Rlt_le, H2. apply (Rle_trans _ (Rabs l2 * (Rmin (eps / (4 * Rmax (Rabs l1) 1)) (eps / (4 * Rmax (Rabs l2) 1))))). apply Rmult_le_compat_l ; unfold delta ; simpl ; [apply Rabs_pos| apply Rmin_r]. apply (Rle_trans _ (Rabs l2 * (eps / (4 * Rmax (Rabs l2) 1)))). apply Rmult_le_compat_l ; [apply Rabs_pos | apply Rmin_r]. unfold Rmax ; destruct (Rle_dec (Rabs l2) 1). rewrite <- (Rmult_1_l (eps/2/2)). apply Rmult_le_compat. apply Rabs_pos. apply Rlt_le, Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat ; [apply Rmult_lt_0_compat ; apply Rlt_R0_R2|apply Rlt_0_1]]. apply r. apply Req_le ; field. apply Req_le ; field. apply Rnot_le_lt in n. apply sym_not_eq, Rlt_not_eq, (Rlt_trans _ _ _ Rlt_0_1 n). Qed. Lemma differentiable_pt_lim_proj1_0 (f : R -> R) (x y l : R) : derivable_pt_lim f x l -> differentiable_pt_lim (fun u v => f u) x y l 0. Proof. intros Df eps. apply is_derive_Reals in Df ; elim (proj2 Df x (fun P H => H) eps) ; clear Df ; intros delta Df. exists delta ; simpl ; intros. rewrite Rmult_0_l Rplus_0_r. apply (Rle_trans _ (eps * Rabs (u - x))). rewrite Rmult_comm ; apply (Df _ H). apply Rmult_le_compat_l. apply Rlt_le, eps. apply RmaxLess1. Qed. Lemma differentiable_pt_lim_proj1_1 (f : R -> R) (x y l : R) : differentiable_pt_lim (fun u v => f u) x y l 0 -> derivable_pt_lim f x l. Proof. intros Df. apply is_derive_Reals ; split => [ | z Hz eps]. by apply @is_linear_scal_l. rewrite -(is_filter_lim_locally_unique _ _ Hz) => {z Hz}. elim (Df eps) ; clear Df ; intros delta Df. exists delta ; simpl in Df ; simpl ; intros. rewrite /minus /plus /opp /scal /= /mult /=. replace (f y0 + - f x + - ((y0 + - x) * l)) with (f y0 - f x - (l * (y0 - x) + 0 * (y - y))) by ring. assert (Rabs (y0 - x) = Rmax (Rabs (y0 - x)) (Rabs (y-y))). rewrite Rmax_comm ; apply sym_equal, Rmax_right. rewrite Rminus_eq_0 Rabs_R0 ; apply Rabs_pos. rewrite /norm /= /abs /=. rewrite H0 ; clear H0. apply (Df _ _ H). rewrite Rminus_eq_0 Rabs_R0 ; apply delta. Qed. Lemma differentiable_pt_lim_unique (f : R -> R -> R) (x y : R) (lx ly : R) : differentiable_pt_lim f x y lx ly -> Derive (fun x => f x y) x = lx /\ Derive (fun y => f x y) y = ly. Proof. move => Df ; split ; apply is_derive_unique, is_derive_Reals => e He ; case: (Df (pos_div_2 (mkposreal e He))) => {Df} delta /= Df ; exists delta => h Hh0 Hh. replace ((f (x + h) y - f x y) / h - lx) with ((f (x+h) y - f x y - (lx * ((x+h) - x) + ly * (y - y))) / h) by (by field). rewrite Rabs_div. apply Rlt_div_l. by apply Rabs_pos_lt. apply Rle_lt_trans with (e / 2 * Rmax (Rabs (x + h - x)) (Rabs (y - y))). apply (Df (x+h) y). by (ring_simplify (x + h - x)). rewrite Rminus_eq_0 Rabs_R0 ; by apply delta. ring_simplify (x + h - x). rewrite Rmax_left. apply Rmult_lt_compat_r. by apply Rabs_pos_lt. lra. rewrite Rminus_eq_0 Rabs_R0 ; by apply Rabs_pos. by []. replace ((f x (y + h) - f x y) / h - ly) with ((f x (y + h) - f x y - (lx * (x - x) + ly * ((y + h) - y))) / h) by (by field). rewrite Rabs_div. apply Rlt_div_l. by apply Rabs_pos_lt. apply Rle_lt_trans with (e / 2 * Rmax (Rabs (x - x)) (Rabs (y + h - y))). apply (Df x (y + h)). rewrite Rminus_eq_0 Rabs_R0 ; by apply delta. by (ring_simplify (y + h - y)). ring_simplify (y + h - y). rewrite Rmax_right. apply Rmult_lt_compat_r. by apply Rabs_pos_lt. lra. rewrite Rminus_eq_0 Rabs_R0 ; by apply Rabs_pos. by []. Qed. (** * Operations *) Lemma differentiable_pt_lim_comp : forall f1 f2 f3 x y l1x l1y l2x l2y l3x l3y, differentiable_pt_lim f1 (f2 x y) (f3 x y) l1x l1y -> differentiable_pt_lim f2 x y l2x l2y -> differentiable_pt_lim f3 x y l3x l3y -> differentiable_pt_lim (fun u v => f1 (f2 u v) (f3 u v)) x y (l1x * l2x + l1y * l3x) (l1x * l2y + l1y * l3y). Proof. intros f1 f2 f3 x y l1_1 l1_2 l2_1 l2_2 l3_1 l3_2 Df1 Df2 Df3 eps ; simpl. assert (Cf2 : continuity_2d_pt f2 x y). apply differentiable_continuity_pt. exists l2_1 ; exists l2_2 ; apply Df2. assert (Cf3 : continuity_2d_pt f3 x y). apply differentiable_continuity_pt. exists l3_1 ; exists l3_2 ; apply Df3. assert (He2 : 0 < eps / (4 * Rmax (Rabs l1_1) 1)). apply Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat]. apply Rmult_lt_0_compat ; apply Rlt_R0_R2. apply (Rlt_le_trans _ _ _ Rlt_0_1 (RmaxLess2 _ _)). set (eps2 := mkposreal _ He2). assert (He3 : 0 < eps / (4 * Rmax (Rabs l1_2) 1)). apply Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat]. apply Rmult_lt_0_compat ; apply Rlt_R0_R2. apply (Rlt_le_trans _ _ _ Rlt_0_1 (RmaxLess2 _ _)). set (eps3 := mkposreal _ He3). assert (He1 : 0 < eps / (2 * Rmax (eps2 + Rabs l2_1 + Rabs l2_2) (eps3 + Rabs l3_1 + Rabs l3_2))). apply Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat]. apply Rlt_R0_R2. apply (Rlt_le_trans _ (eps2 + Rabs l2_1 + Rabs l2_2)). rewrite Rplus_assoc ; apply Rplus_lt_le_0_compat. apply eps2. apply Rplus_le_le_0_compat ; apply Rabs_pos. apply RmaxLess1. set (eps1 := mkposreal _ He1). elim (Df1 eps1) ; clear Df1 ; intros d0 Df1. elim (Cf2 d0) ; clear Cf2 ; intros d1 Cf2. elim (Cf3 d0) ; clear Cf3 ; intros d'1 Cf3. elim (Df2 eps2) ; clear Df2 ; intros d2 Df2. elim (Df3 eps3) ; clear Df3 ; intros d3 Df3. assert (Hd : 0 < Rmin (Rmin d1 d'1) (Rmin d2 d3)). apply Rmin_pos ; apply Rmin_pos ; [apply d1 | apply d'1 | apply d2 | apply d3]. set (delta := mkposreal _ Hd). exists delta ; intros x' y' ; intros. apply (Rle_trans _ (Rabs (f1 (f2 x' y') (f3 x' y') - f1 (f2 x y) (f3 x y) - (l1_1 * (f2 x' y' - f2 x y) + l1_2 * (f3 x' y' - f3 x y))) + Rabs (l1_1 * (f2 x' y' - f2 x y) + l1_2 * (f3 x' y' - f3 x y) - ((l1_1 * l2_1 + l1_2 * l3_1) * (x' - x) + (l1_1 * l2_2 + l1_2 * l3_2) * (y' - y))))). replace ((f1 (f2 x' y') (f3 x' y') - f1 (f2 x y) (f3 x y) - ((l1_1 * l2_1 + l1_2 * l3_1) * (x' - x) + (l1_1 * l2_2 + l1_2 * l3_2) * (y' - y)))) with ((f1 (f2 x' y') (f3 x' y') - f1 (f2 x y) (f3 x y) - (l1_1 * (f2 x' y' - f2 x y) + l1_2 * (f3 x' y' - f3 x y))) + (l1_1 * (f2 x' y' - f2 x y) + l1_2 * (f3 x' y' - f3 x y) - ((l1_1 * l2_1 + l1_2 * l3_1) * (x' - x) + (l1_1 * l2_2 + l1_2 * l3_2) * (y' - y)))) by ring. apply Rabs_triang. rewrite (double_var eps) (Rmult_plus_distr_r (eps/2)). apply Rplus_le_compat. apply (Rle_trans _ (eps1 * Rmax (Rabs (f2 x' y' - f2 x y)) (Rabs (f3 x' y' - f3 x y)))). apply Df1. apply Cf2. apply (Rlt_le_trans _ _ _ H) ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_l _ _)). apply (Rlt_le_trans _ _ _ H0) ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_l _ _)). apply Cf3. apply (Rlt_le_trans _ _ _ H) ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_r _ _)). apply (Rlt_le_trans _ _ _ H0) ; simpl ; apply (Rle_trans _ _ _ (Rmin_l _ _) (Rmin_r _ _)). apply (Rle_trans _ (eps1 * (Rmax (eps2 + Rabs l2_1 + Rabs l2_2) (eps3 + Rabs l3_1 + Rabs l3_2) * Rmax (Rabs (x'-x)) (Rabs (y'-y))))). apply Rmult_le_compat_l. apply Rlt_le, eps1. rewrite Rmax_mult. apply Rmax_le_compat. rewrite Rplus_assoc Rmult_plus_distr_r. apply (Rle_trans _ (Rabs (f2 x' y' - f2 x y - (l2_1 * (x' - x) + l2_2 * (y' - y))) + Rabs (l2_1 * (x' - x) + l2_2 * (y' - y)))). assert (Rabs (f2 x' y' - f2 x y) = Rabs ((f2 x' y' - f2 x y - (l2_1 * (x' - x) + l2_2 * (y' - y))) + (l2_1 * (x' - x) + l2_2 * (y' - y)))). assert ((f2 x' y' - f2 x y) = ((f2 x' y' - f2 x y - (l2_1 * (x' - x) + l2_2 * (y' - y))) + (l2_1 * (x' - x) + l2_2 * (y' - y)))). ring. rewrite <- H1 ; clear H1 ; reflexivity. rewrite H1 ; clear H1 ; apply Rabs_triang. apply Rplus_le_compat. apply Df2. apply (Rlt_le_trans _ _ _ H) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_l _ _)). apply (Rlt_le_trans _ _ _ H0) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_l _ _)). apply (Rle_trans _ (Rabs l2_1 * Rabs (x'-x) + Rabs l2_2 * Rabs (y'-y))). repeat rewrite <- Rabs_mult ; apply Rabs_triang. rewrite Rmult_plus_distr_r. apply Rplus_le_compat ; apply Rmult_le_compat_l. apply Rabs_pos. apply RmaxLess1. apply Rabs_pos. apply RmaxLess2. rewrite Rplus_assoc Rmult_plus_distr_r. apply (Rle_trans _ (Rabs (f3 x' y' - f3 x y - (l3_1 * (x' - x) + l3_2 * (y' - y))) + Rabs (l3_1 * (x' - x) + l3_2 * (y' - y)))). assert (Rabs (f3 x' y' - f3 x y) = Rabs ((f3 x' y' - f3 x y - (l3_1 * (x' - x) + l3_2 * (y' - y))) + (l3_1 * (x' - x) + l3_2 * (y' - y)))). assert ((f3 x' y' - f3 x y) = ((f3 x' y' - f3 x y - (l3_1 * (x' - x) + l3_2 * (y' - y))) + (l3_1 * (x' - x) + l3_2 * (y' - y)))). ring. rewrite <- H1 ; clear H1 ; reflexivity. rewrite H1 ; clear H1 ; apply Rabs_triang. apply Rplus_le_compat. apply Df3. apply (Rlt_le_trans _ _ _ H) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_r _ _)). apply (Rlt_le_trans _ _ _ H0) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_r _ _)). apply (Rle_trans _ (Rabs l3_1 * Rabs (x'-x) + Rabs l3_2 * Rabs (y'-y))). repeat rewrite <- Rabs_mult ; apply Rabs_triang. rewrite Rmult_plus_distr_r. apply Rplus_le_compat ; apply Rmult_le_compat_l. apply Rabs_pos. apply RmaxLess1. apply Rabs_pos. apply RmaxLess2. apply (Rle_trans _ _ _ (Rabs_pos _) (RmaxLess1 _ _)). simpl ; apply Req_le ; field. apply sym_not_eq, Rlt_not_eq, (Rlt_le_trans _ (eps2 + Rabs l2_1 + Rabs l2_2)). rewrite Rplus_assoc ; apply Rplus_lt_le_0_compat. apply eps2. apply Rplus_le_le_0_compat ; apply Rabs_pos. apply RmaxLess1. rewrite (double_var (eps/2)) (Rmult_plus_distr_r (eps/2/2)). apply (Rle_trans _ (Rabs l1_1 * Rabs (f2 x' y' - f2 x y - (l2_1 * (x' - x) + l2_2 * (y' - y))) + Rabs l1_2 * Rabs (f3 x' y' - f3 x y - (l3_1 * (x' - x) + l3_2 * (y' - y))))). repeat rewrite <- Rabs_mult. assert ((l1_1 * (f2 x' y' - f2 x y) + l1_2 * (f3 x' y' - f3 x y) - ((l1_1 * l2_1 + l1_2 * l3_1) * (x' - x) + (l1_1 * l2_2 + l1_2 * l3_2) * (y' - y))) = (l1_1 * (f2 x' y' - f2 x y - (l2_1 * (x' - x) + l2_2 * (y' - y)))) + (l1_2 * (f3 x' y' - f3 x y - (l3_1 * (x' - x) + l3_2 * (y' - y))))). ring. rewrite H1 ; clear H1 ; apply Rabs_triang. apply Rplus_le_compat. apply (Rle_trans _ (Rabs l1_1 * (eps2 * Rmax (Rabs (x' - x)) (Rabs (y' - y))))). apply Rmult_le_compat_l. apply Rabs_pos. apply Df2. apply (Rlt_le_trans _ _ _ H) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_l _ _)). apply (Rlt_le_trans _ _ _ H0) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_l _ _)). rewrite <- Rmult_assoc ; apply Rmult_le_compat_r. apply (Rle_trans _ _ _ (Rabs_pos _) (RmaxLess1 _ _)). unfold eps2, Rmax ; simpl ; destruct (Rle_dec (Rabs l1_1) 1). rewrite <- (Rmult_1_l (eps/2/2)) ; apply Rmult_le_compat. apply Rabs_pos. rewrite Rmult_1_r ; apply Rlt_le, Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat ; apply Rlt_R0_R2]. apply r. apply Req_le ; field. apply Req_le ; field. apply sym_not_eq, Rlt_not_eq, (Rlt_trans _ _ _ Rlt_0_1 (Rnot_le_lt _ _ n)). apply (Rle_trans _ (Rabs l1_2 * (eps3 * Rmax (Rabs (x' - x)) (Rabs (y' - y))))). apply Rmult_le_compat_l. apply Rabs_pos. apply Df3. apply (Rlt_le_trans _ _ _ H) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_r _ _)). apply (Rlt_le_trans _ _ _ H0) ; simpl ; apply (Rle_trans _ _ _ (Rmin_r _ _) (Rmin_r _ _)). rewrite <- Rmult_assoc ; apply Rmult_le_compat_r. apply (Rle_trans _ _ _ (Rabs_pos _) (RmaxLess1 _ _)). unfold eps3, Rmax ; simpl ; destruct (Rle_dec (Rabs l1_2) 1). rewrite <- (Rmult_1_l (eps/2/2)) ; apply Rmult_le_compat. apply Rabs_pos. rewrite Rmult_1_r ; apply Rlt_le, Rdiv_lt_0_compat ; [apply eps | apply Rmult_lt_0_compat ; apply Rlt_R0_R2]. apply r. apply Req_le ; field. apply Req_le ; field. apply sym_not_eq, Rlt_not_eq, (Rlt_trans _ _ _ Rlt_0_1 (Rnot_le_lt _ _ n)). Qed. Lemma derivable_pt_lim_comp_2d : forall f1 f2 f3 x l1x l1y l2 l3, differentiable_pt_lim f1 (f2 x) (f3 x) l1x l1y -> derivable_pt_lim f2 x l2 -> derivable_pt_lim f3 x l3 -> derivable_pt_lim (fun t => f1 (f2 t) (f3 t)) x (l1x * l2 + l1y * l3). Proof. intros. apply (differentiable_pt_lim_proj1_1 _ x 0 (l1x * l2 + l1y * l3)). pattern 0 at 2 ; replace 0 with (l1x * 0 + l1y * 0) by ring. apply differentiable_pt_lim_comp. apply H. apply: differentiable_pt_lim_proj1_0 H0. apply: differentiable_pt_lim_proj1_0 H1. Qed. (** * Partial derivatives *) Definition partial_derive (m k : nat) (f : R -> R -> R) : R -> R -> R := fun x y => Derive_n (fun t => Derive_n (fun z => f t z) k y) m x. Definition differential (p : nat) (f : R -> R -> R) (x y dx dy : R) : R := sum_f_R0 (fun m => C p m * partial_derive m (p - m)%nat f x y * dx ^ m * dy ^ (p - m)%nat) p. Definition DL_pol (n : nat) (f : R -> R -> R) (x y dx dy : R) : R := sum_f_R0 (fun p => differential p f x y dx dy / INR (fact p)) n. Lemma partial_derive_ext_loc : forall f g p q x y, locally_2d (fun u v => f u v = g u v) x y -> partial_derive p q f x y = partial_derive p q g x y. Proof. intros f g p q x y H. unfold partial_derive. apply Derive_n_ext_loc. destruct H as (e,He). exists e. intros u Hu. apply Derive_n_ext_loc. exists e. intros v Hv. now apply He. Qed. (** * Schwarz theorem *) Lemma Schwarz_aux : forall f x y (eps : posreal), ( forall u v, Rabs (u - x) < eps -> Rabs (v - y) < eps -> ex_derive (fun z : R => f z v) u /\ ex_derive (fun z : R => Derive (fun t => f t z) u) v ) -> forall h k, Rabs h < eps -> Rabs k < eps -> let phi k x := f x (y + k) - f x y in exists u, exists v, Rabs (u - x) <= Rabs h /\ Rabs (v - y) <= Rabs k /\ phi k (x + h) - phi k x = h * k * (Derive (fun z => Derive (fun t => f t z) u) v). Proof. intros f x y eps HD h k Hh Hk phi. assert (Hx: x + h - x = h) by ring. assert (Hy: y + k - y = k) by ring. (* . *) destruct (MVT_cor4 (phi k) (Derive (phi k)) x (Rabs h)) with (b := x + h) as (u&Hu1&Hu2). intros c Hc. apply Derive_correct. apply: ex_derive_minus. apply (HD c). now apply Rle_lt_trans with (Rabs h). now rewrite Hy. apply (HD c). now apply Rle_lt_trans with (Rabs h). rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. rewrite Hx. apply Rle_refl. rewrite Hx in Hu1, Hu2. exists u. (* . *) destruct (MVT_cor4 (fun v => Derive (fun t => f t v) u) (Derive (fun v => Derive (fun t => f t v) u)) y (Rabs k)) with (b := y + k) as (v&Hv1&Hv2). intros c Hc. apply Derive_correct, HD. now apply Rle_lt_trans with (Rabs h). now apply Rle_lt_trans with (1 := Hc). rewrite Hy. apply Rle_refl. rewrite Hy in Hv1, Hv2. exists v. (* . *) refine (conj Hu2 (conj Hv2 _)). rewrite Hu1 /phi Derive_minus. rewrite Hv1. ring. apply (HD u). now apply Rle_lt_trans with (Rabs h). now rewrite Hy. apply (HD u). now apply Rle_lt_trans with (Rabs h). rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. Qed. Lemma Schwarz : forall (f : R -> R -> R) x y, locally_2d (fun u v => ex_derive (fun z : R => f z v) u /\ ex_derive (fun z : R => f u z) v /\ ex_derive (fun z : R => Derive (fun t => f z t) v) u /\ ex_derive (fun z : R => Derive (fun t => f t z) u) v) x y -> continuity_2d_pt (fun u v => Derive (fun z => Derive (fun t => f z t) v) u) x y -> continuity_2d_pt (fun u v => Derive (fun z => Derive (fun t => f t z) u) v) x y -> Derive (fun z => Derive (fun t => f z t) y) x = Derive (fun z => Derive (fun t => f t z) x) y. Proof. intros f x y (eps, HD) HC2 HC1. refine ((fun H1 => _) (Schwarz_aux f x y eps _)). 2: intros u v Hu Hv ; split ; now apply (HD u v). refine ((fun H2 => _ )(Schwarz_aux (fun x y => f y x) y x eps _)). 2: intros u v Hu Hv ; split ; now apply (HD v u). simpl in H1, H2. apply Req_lt_aux. intros e. destruct (HC1 (pos_div_2 e)) as (d1,Hc1). destruct (HC2 (pos_div_2 e)) as (d2,Hc2). set (d := Rmin (Rmin (pos_div_2 d1) (pos_div_2 d2)) (pos_div_2 eps)). assert (Hd: d > 0). apply Rmin_glb_lt. apply Rmin_stable_in_posreal. apply cond_pos. assert (K: Rabs d < eps). rewrite Rabs_right. apply Rle_lt_trans with (1 := Rmin_r _ _). apply (Rlt_eps2_eps eps). apply cond_pos. now apply Rgt_ge. specialize (H1 d d K K). specialize (H2 d d K K). destruct H1 as (u1&v1&Hu1&Hv1&H1). destruct H2 as (v2&u2&Hv2&Hu2&H2). clear K. rewrite (Rabs_right d (Rgt_ge _ _ Hd)) in Hu1 Hv1 Hu2 Hv2. assert (K: forall a b, Rabs (a - b) <= d -> Rabs (a - b) < d1). intros a b H. apply Rle_lt_trans with (1 := H). apply Rle_lt_trans with (1 := Rmin_l _ _). apply Rle_lt_trans with (1 := Rmin_l _ _). apply (Rlt_eps2_eps d1). apply cond_pos. specialize (Hc1 u1 v1 (K _ _ Hu1) (K _ _ Hv1)). clear K. assert (K: forall a b, Rabs (a - b) <= d -> Rabs (a - b) < d2). intros a b H. apply Rle_lt_trans with (1 := H). apply Rle_lt_trans with (1 := Rmin_l _ _). apply Rle_lt_trans with (1 := Rmin_r _ _). apply (Rlt_eps2_eps d2). apply cond_pos. specialize (Hc2 u2 v2 (K _ _ Hu2) (K _ _ Hv2)). clear -Hd H1 H2 Hc1 Hc2. assert (H: forall a b c, b - c = -(a - b) + (a - c)) by (intros ; ring). rewrite (H (Derive (fun z : R => Derive (fun t : R => f z t) v2) u2)). clear H. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite Rabs_Ropp (double_var e). apply Rplus_lt_compat. exact Hc2. replace (Derive (fun z : R => Derive (fun t : R => f z t) v2) u2) with (Derive (fun z : R => Derive (fun t : R => f t z) u1) v1). exact Hc1. apply Rmult_eq_reg_l with (d * d). rewrite -H1 -H2. ring. apply Rgt_not_eq. now apply Rmult_gt_0_compat. Qed. Lemma partial_derive_add_zero: forall f p q r s x y, (q=0)%nat \/ (r=0)%nat -> partial_derive p q (partial_derive r s f) x y = partial_derive (p+r) (q+s) f x y. intros f p q r s x y H. destruct H; rewrite H. rewrite Nat.add_0_l. unfold partial_derive. simpl. rewrite -Derive_n_comp. now apply Derive_n_ext. rewrite Nat.add_0_r. unfold partial_derive. simpl. apply Derive_n_ext. intros y0. rewrite -Derive_n_comp. now apply Derive_n_ext. Qed. (** * Iterated differential *) Fixpoint ex_diff_n f n x y := continuity_2d_pt f x y /\ match n with | O => True | S n => ex_derive (fun z => f z y) x /\ ex_derive (fun z => f x z) y /\ ex_diff_n (fun u v => Derive (fun z => f z v) u) n x y /\ ex_diff_n (fun u v => Derive (fun z => f u z) v) n x y end. Lemma ex_diff_n_ext_loc: forall f g n x y, locally_2d (fun u v => f u v = g u v) x y -> ex_diff_n f n x y -> ex_diff_n g n x y. Proof. intros f g n; revert f g. induction n. intros f g x y H; simpl. intros (H1,_); split. apply (continuity_2d_pt_ext_loc _ _ _ _ H H1). easy. simpl. intros f g x y H (H1&H2&H3&H4&H5). split. apply (continuity_2d_pt_ext_loc _ _ _ _ H H1). split. apply: ex_derive_ext_loc H2. apply locally_2d_1d_const_y with (1:=H). split. apply: ex_derive_ext_loc H3. apply locally_2d_1d_const_x with (1:=H). split. apply IHn with (2:=H4). apply locally_2d_impl_strong with (2:=H). apply locally_2d_forall. intros u v H6. apply Derive_ext_loc. apply locally_2d_1d_const_y with (1:=H6). apply IHn with (2:=H5). apply locally_2d_impl_strong with (2:=H). apply locally_2d_forall. intros u v H6. apply Derive_ext_loc. apply locally_2d_1d_const_x with (1:=H6). Qed. Lemma ex_diff_n_m : forall n m, (m <= n)%nat -> forall f x y, ex_diff_n f n x y -> ex_diff_n f m x y. Proof. assert (forall n f x y, ex_diff_n f (S n) x y -> ex_diff_n f n x y). induction n. simpl. intros f x y H; split; try apply H. intros f x y H. repeat (split; try apply H). apply IHn. apply H. apply IHn. apply H. intros n m H1 f x y Hn. induction n. - apply Nat.le_0_r in H1 as ->; exact Hn. - destruct (proj1 (Nat.lt_eq_cases _ _) H1) as [H2 | ->]; [| exact Hn]. now apply IHn; apply ->Nat.lt_succ_r in H2; [exact H2 |]; apply H; exact Hn. Qed. Lemma ex_diff_n_deriv_aux1: forall f n x y, ex_diff_n f (S n) x y -> ex_diff_n (fun u v => Derive (fun z => f z v) u) n x y. Proof. intros f n x y. case n. simpl. intros H; split; apply H. clear n;intros n H. simpl in H. repeat split; apply H. Qed. Lemma ex_diff_n_deriv_aux2: forall f n x y, ex_diff_n f (S n) x y -> ex_diff_n (fun u v => Derive (fun z => f u z) v) n x y. Proof. intros f n x y. case n. simpl. intros H; split; apply H. clear n;intros n H. simpl in H. repeat split; apply H. Qed. Lemma ex_diff_n_deriv: forall n p q, (p+q <= n)%nat -> forall f x y, ex_diff_n f n x y-> ex_diff_n (partial_derive p q f) (n -(p+q)) x y. induction p. (* . *) intros q; rewrite Nat.add_0_l. induction q. intros H f x y H1. unfold partial_derive. simpl. rewrite Nat.sub_0_r. apply: (ex_diff_n_ext_loc _ _ _ _ _ _ H1). now apply locally_2d_forall. intros H f x y H1. apply (ex_diff_n_ext_loc (fun u v => Derive (fun z => (partial_derive 0 q f) u z) v)). apply locally_2d_forall. intros u v; unfold partial_derive. reflexivity. apply ex_diff_n_deriv_aux2. replace ((S (n - S q))) with (n-q)%nat by lia. apply IHq. now apply Nat.lt_le_incl. exact H1. (* . *) intros q H f x y H1. apply (ex_diff_n_ext_loc (fun u v => Derive (fun z => (partial_derive p q f) z v) u)). apply locally_2d_forall. intros u v; unfold partial_derive. reflexivity. apply ex_diff_n_deriv_aux1. replace ((S (n - (S p +q)))) with (n-(p+q))%nat by lia. apply IHp. now apply Nat.lt_le_incl. exact H1. Qed. Lemma ex_diff_n_ex_deriv_inf_1 : forall n p k, (p+k < n)%nat -> forall f x y, ex_diff_n f n x y -> ex_derive (fun z : R => partial_derive p k f z y) x. Proof. intros n p; case p; clear p. (* . *) intros k; case k; clear k. case n; clear n. intros Hn; contradict Hn; apply Nat.nlt_0_r. intros n _ f x y H. unfold partial_derive; simpl. apply H. intros n0 H f x y Hf. assert (ex_diff_n (partial_derive 0 n0 f) (n -(0+n0)) x y). apply ex_diff_n_deriv. auto with zarith. exact Hf. revert H0; rewrite Nat.add_0_l. case_eq (n-n0)%nat. intros H1; contradict H; auto with zarith. intros n1 H1 H2. apply ex_derive_ext with (fun z => Derive (fun t => (partial_derive 0 n0 f z) t) y). intros y0; unfold partial_derive; simpl. reflexivity. simpl in H2. destruct H2 as (T1&T2&T3&T4&T5). case_eq n1. intros H2; rewrite H2 in H1. clear -H H1; contradict H; auto with zarith. intros n2 Hn2; rewrite Hn2 in T5. apply T5. (* . *) intros p q H f x y Hf. assert (ex_diff_n (partial_derive p q f) (n -(p+q)) x y). apply ex_diff_n_deriv. auto with zarith. exact Hf. case_eq (n-(p+q))%nat. intros H1; contradict H; auto with zarith. intros n1 H1. apply ex_derive_ext with (fun z => Derive (fun t => (partial_derive p q f t) y) z). intros x0; unfold partial_derive; simpl. reflexivity. rewrite H1 in H0; simpl in H0. destruct H0 as (T1&T2&T3&T4&T5). case_eq n1. intros H2; rewrite H2 in H1. clear -H H1; contradict H; auto with zarith. intros n2 Hn2; rewrite Hn2 in T4. apply T4. Qed. Lemma ex_diff_n_ex_deriv_inf_2 : forall n p k, (p+k < n)%nat -> forall f x y, ex_diff_n f n x y -> ex_derive (fun z => partial_derive p k f x z) y. Proof. intros n p; case p; clear p. (* . *) intros k; case k; clear k. case n; clear n. intros Hn; contradict Hn; apply Nat.nlt_0_r. intros n _ f x y H. unfold partial_derive; simpl. apply H. intros n0 H f x y Hf. assert (ex_diff_n (partial_derive 0 n0 f) (n -(0+n0)) x y). apply ex_diff_n_deriv. auto with zarith. exact Hf. revert H0; rewrite Nat.add_0_l. case_eq (n-n0)%nat. intros H1; contradict H; auto with zarith. intros n1 H1 H2. apply ex_derive_ext with (fun z => Derive (fun t => (partial_derive 0 n0 f x) t) z). intros y0; unfold partial_derive; simpl. reflexivity. simpl in H2. destruct H2 as (T1&T2&T3&T4&T5). case_eq n1. intros H2; rewrite H2 in H1. clear -H H1; contradict H; auto with zarith. intros n2 Hn2; rewrite Hn2 in T5. apply T5. (* . *) intros p q H f x y Hf. assert (ex_diff_n (partial_derive p q f) (n -(p+q)) x y). apply ex_diff_n_deriv. auto with zarith. exact Hf. case_eq (n-(p+q))%nat. intros H1; contradict H; auto with zarith. intros n1 H1. apply ex_derive_ext with (fun z => Derive (fun t => (partial_derive p q f t) z) x). intros x0; unfold partial_derive; simpl. reflexivity. rewrite H1 in H0; simpl in H0. destruct H0 as (T1&T2&T3&T4&T5). case_eq n1. intros H2; rewrite H2 in H1. clear -H H1; contradict H; auto with zarith. intros n2 Hn2; rewrite Hn2 in T4. apply T4. Qed. Lemma ex_diff_n_continuity_inf_1 : forall n p k, (p+k < n)%nat -> forall f x y, ex_diff_n f n x y -> continuity_2d_pt (fun u v => Derive (fun z : R => partial_derive p k f z v) u) x y. Proof. intros n p k Hn f x y Hf. assert (ex_diff_n (partial_derive (S p) k f) (n -(S p+k)) x y). now apply ex_diff_n_deriv. apply continuity_2d_pt_ext_loc with (partial_derive (S p) k f). apply locally_2d_forall. intros u v; unfold partial_derive; simpl. reflexivity. revert H; case (n - (S p + k))%nat. simpl; intros H; apply H. intros n0; simpl; intros H; apply H. Qed. Lemma Derive_partial_derive_aux1: forall p f x y, locally_2d (ex_diff_n f (S p)) x y -> partial_derive 1 p f x y = partial_derive 0 p (partial_derive 1 0 f) x y. Proof. intros p; induction p. intros f x y H. unfold partial_derive; now simpl. intros f x y H. apply trans_eq with (partial_derive 1 p (partial_derive 0 1 f) x y). unfold partial_derive. simpl. apply Derive_ext. intros t. apply trans_eq with (Derive_n (Derive_n (fun z : R => f t z) p) 1 y). reflexivity. rewrite Derive_n_comp. rewrite Nat.add_comm. rewrite -Derive_n_comp. reflexivity. rewrite IHp. apply trans_eq with (partial_derive 0 p (partial_derive 0 1 (partial_derive 1 0 f)) x y). unfold partial_derive. simpl. apply Derive_n_ext_loc. cut (locally_2d (fun u v => Derive (fun x0 : R => Derive (fun x1 : R => f x0 x1) v) u = Derive (fun x0 : R => Derive (fun x1 : R => f x1 x0) u) v) x y). apply locally_2d_1d_const_x. apply locally_2d_impl_strong with (2:=H). apply locally_2d_forall. intros u v H1. apply Schwarz. apply locally_2d_impl with (2:=H1). apply locally_2d_forall. intros u' v' H2. split. apply H2. split. apply H2. simpl in H2; destruct H2 as (T1&T2&T3&T4&T5). split. apply T5. apply T4. apply locally_2d_singleton in H1. simpl in H1; destruct H1 as (T1&T2&T3&T4&T5). destruct T5 as (Y1&Y2&Y3&Y4&Y5). clear - Y4. case p in Y4; simpl in Y4; apply Y4. apply locally_2d_singleton in H1. simpl in H1; destruct H1 as (T1&T2&T3&T4&T5). destruct T4 as (Y1&Y2&Y3&Y4&Y5). clear - Y5. case p in Y5; simpl in Y5; apply Y5. unfold partial_derive. simpl. apply trans_eq with (Derive_n (Derive_n (fun z => Derive (fun x0 => f x0 z) x) p) 1 y). rewrite Derive_n_comp. rewrite Nat.add_comm. rewrite -Derive_n_comp. reflexivity. reflexivity. apply locally_2d_impl with (2:=H). apply locally_2d_forall. intros u v. pattern (S p) at 2; replace (S p) with (S (S p) -(0+1))%nat. apply ex_diff_n_deriv. rewrite Nat.add_0_l; apply ->Nat.succ_le_mono; exact (Nat.le_0_l _). by rewrite Nat.add_0_l Nat.sub_succ Nat.sub_0_r. Qed. Lemma Derive_partial_derive_aux2: forall p k f x y, locally_2d (ex_diff_n f (p+S k)) x y -> partial_derive 0 1 (partial_derive p k f) x y = partial_derive p (S k) f x y. Proof. intros p; induction p. intros; easy. intros k f x y Y. apply sym_eq. apply trans_eq with (partial_derive p 0 (partial_derive 1 (S k) f) x y). rewrite partial_derive_add_zero. rewrite Nat.add_0_l. replace (S p) with (p+1)%nat by apply Nat.add_comm. easy. now left. apply trans_eq with (partial_derive p 0 (partial_derive 0 (S k) (partial_derive 1 0 f)) x y). apply partial_derive_ext_loc. apply locally_2d_impl_strong with (2:=Y). apply locally_2d_forall. intros u v H. apply Derive_partial_derive_aux1. apply locally_2d_impl with (2:=H). apply locally_2d_forall. intros u'' v''. apply ex_diff_n_m. lia. apply trans_eq with (partial_derive p (S k) (partial_derive 1 0 f) x y). rewrite partial_derive_add_zero. now rewrite Nat.add_0_l Nat.add_0_r. now right. rewrite - IHp. apply partial_derive_ext_loc. apply locally_2d_impl_strong with (2:=Y). apply locally_2d_forall. intros u v H. apply trans_eq with (partial_derive p 0 (partial_derive 0 k (partial_derive 1 0 f)) u v). rewrite (partial_derive_add_zero _ _ 0%nat). now rewrite Nat.add_0_l Nat.add_0_r. now right. apply trans_eq with (partial_derive p 0 (partial_derive 1 k f) u v). apply partial_derive_ext_loc. apply locally_2d_impl_strong with (2:=H). apply locally_2d_forall. intros u' v' H'. apply sym_eq. apply Derive_partial_derive_aux1. apply locally_2d_impl with (2:=H'). apply locally_2d_forall. intros u'' v''. apply ex_diff_n_m. apply MyNat.le_add_l. rewrite partial_derive_add_zero. rewrite Nat.add_0_l. replace (S p) with (p+1)%nat by apply Nat.add_comm. easy. now left. apply locally_2d_impl with (2:=Y). apply locally_2d_forall. intros u'' v''. replace (p+ S k)%nat with ((S p+S k)-(1+0))%nat. apply ex_diff_n_deriv. now rewrite Nat.add_0_r Nat.add_succ_l; apply ->Nat.succ_le_mono; apply Nat.le_0_l. now rewrite Nat.add_0_r Nat.add_succ_l Nat.sub_succ Nat.sub_0_r. Qed. Lemma Derive_partial_derive: forall p k f x y, locally_2d (ex_diff_n f (p+S k)) x y -> Derive (fun v : R => partial_derive p k f x v) y = partial_derive p (S k) f x y. Proof. intros p k f x y H. generalize (Derive_partial_derive_aux2 p k f x y H). easy. Qed. Lemma ex_diff_n_continuity_inf_2 : forall n p k, (p+k < n)%nat -> forall f x y, ex_diff_n f n x y -> continuity_2d_pt (fun u v => Derive (fun z : R => partial_derive p k f u z) v) x y. Proof. intros n p k Hn f x y Hf. assert (ex_diff_n (partial_derive p k f) (n -(p+k)) x y). apply ex_diff_n_deriv. now apply Nat.lt_le_incl. exact Hf. revert H; case_eq (n-(p+k))%nat. intros H; contradict Hn. lia. intros n0 Hn0; simpl; intros (T1&T2&T3&T4&T5). revert T5; case n0. intros Y; apply Y. intros n1 Y; apply Y. Qed. (** * 2D Taylor-Lagrange inequality *) Definition DL_regular_n f m x y := exists D, locally_2d (fun u v => Rabs (f u v - DL_pol m f x y (u-x) (v-y)) <= D * (Rmax (Rabs (u-x)) (Rabs (v-y))) ^ (S m)) x y. Theorem Taylor_Lagrange_2d : forall f n x y, locally_2d (fun u v => ex_diff_n f (S n) u v) x y -> DL_regular_n f n x y. Proof. intros f n x y Df. (* *) assert (exists D, locally_2d (fun u v => forall p, (p <= S n)%nat -> Rabs (partial_derive p (S n - p) f u v) <= D) x y). (* . *) assert (forall p, (p <= S n)%nat -> exists D, locally_2d (fun u v => Rabs (partial_derive p (S n - p) f u v) <= D) x y). intros p Hp. (* .. *) assert (continuity_2d_pt (partial_derive p (S n - p) f) x y). apply locally_2d_singleton in Df. refine (proj1 (_: ex_diff_n (partial_derive p (S n - p) f) 0 x y)). replace O with (S n - (p + (S n - p)))%nat by lia. cut (p + (S n - p) <= S n)%nat. 2: now rewrite Nat.add_comm Nat.sub_add. generalize (S n - p)%nat. clear Hp. revert f Df p. generalize (S n). clear n. induction n. intros f (H,_) [|p] [|q] H' ; try inversion H'. done. intros f H [|p] q H'. destruct q as [|q]. exact H. now apply ex_diff_n_deriv. now apply ex_diff_n_deriv. (* .. *) exists (Rabs (partial_derive p (S n - p) f x y) + 1). specialize (H (mkposreal 1 Rlt_0_1)). apply: locally_2d_impl H. apply: locally_2d_forall => u v H. replace (partial_derive p (S n - p) f u v) with (partial_derive p (S n - p) f x y + (partial_derive p (S n - p) f u v - partial_derive p (S n - p) f x y)) by ring. apply Rle_trans with (1 := Rabs_triang _ _). apply Rplus_le_compat_l. now apply Rlt_le. (* . *) clear -H. generalize (Nat.le_refl (S n)). generalize (S n) at 1 3. intros p Hp. induction p. move: (H _ Hp) => {H} [D H]. exists D. apply: locally_2d_impl H. apply locally_2d_forall => u v H [|p] Hp' //. inversion Hp'. move: (IHp (le_S _ _ (le_S_n _ _ Hp))) => {IHp} [D1 H1]. move: (H _ Hp) => {H} [D2 H2]. exists (Rmax D1 D2). move: (locally_2d_and _ _ x y H1 H2) => {H1 H2} H. apply: locally_2d_impl H. apply locally_2d_forall => u v H p' Hp'. destruct ((proj1 (Nat.lt_eq_cases _ _)) Hp'). apply Rle_trans with (2 := Rmax_l _ _). now apply H, Nat.lt_succ_r. apply Rle_trans with (2 := Rmax_r _ _). now rewrite H0. (* *) destruct H as (D,H). exists (/ INR (fact (S n)) * D * sum_f_R0 (fun i : nat => Rabs (C (S n) i)) (S n)). move: (locally_2d_and _ _ _ _ Df H) => {Df H} HH. apply locally_2d_1d_strong in HH. apply: locally_2d_impl HH. apply locally_2d_forall => u v HH. set (g t := f (x + t * (u - x)) (y + t * (v - y))). replace (f u v) with (g 1) by (rewrite /g 2!Rmult_1_l ; apply f_equal2 ; ring). assert (forall k t, (k <= S n)%nat -> 0 <= t <= 1 -> is_derive_n g k t (sum_f_R0 (fun m => C k m * partial_derive m (k - m)%nat f (x+t*(u-x)) (y+t*(v-y)) * (u-x) ^ m * (v-y) ^ (k - m)%nat) k)). intros k t Hk Ht. specialize (HH t Ht). revert HH. pattern t ; apply locally_singleton. induction k. rewrite /C /partial_derive /g /=. apply filter_forall. intros ; field. specialize (IHk (le_S _ _ (le_S_n _ _ Hk))). rewrite /is_derive_n. apply locally_locally in IHk. move: IHk ; apply filter_imp => {t Ht} z IHk HH. apply is_derive_ext_loc with (fun t => sum_n (fun m => C k m * partial_derive m (k - m) f (x + t * (u - x)) (y + t * (v - y)) * (u - x) ^ m * (v - y) ^ (k - m)) k). apply locally_locally in HH. generalize (filter_and _ _ HH IHk). apply filter_imp => {HH IHk} z [Hz HH]. specialize (HH Hz). apply sym_eq. rewrite sum_n_Reals. now apply is_derive_n_unique. replace (sum_f_R0 (fun m : nat => C (S k) m * partial_derive m (S k - m) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ m * (v - y) ^ (S k - m)) (S k)) with (sum_n (fun m : nat => C k m * (u - x) ^ m * (v - y) ^ (k - m) * ((u - x) * partial_derive (S m) (k - m) f (x + z * (u - x)) (y + z * (v - y)) + (v - y) * partial_derive m (S (k - m)) f (x + z * (u - x)) (y + z * (v - y)))) k). apply: is_derive_sum_n => p Hp. apply is_derive_ext with (fun u0 => C k p * (u - x) ^ p * (v - y) ^ (k - p) * partial_derive p (k - p) f (x + u0 * (u - x)) (y + u0 * (v - y))). intros w. simpl ; ring. apply is_derive_Reals, derivable_pt_lim_scal. rewrite (Rmult_comm (u - x)) (Rmult_comm (v - y)). apply derivable_pt_lim_comp_2d. apply locally_singleton in HH. replace (partial_derive (S p) (k - p) f (x + z * (u - x)) (y + z * (v - y))) with (Derive (fun u : R => partial_derive p (k - p) f u (y + z * (v - y))) (x + z * (u - x))). 2: reflexivity. replace (partial_derive p (S (k - p)) f (x + z * (u - x)) (y + z * (v - y))) with (Derive (fun v : R => partial_derive p (k - p) f (x + z * (u - x)) v) (y + z * (v - y))). apply filterdiff_differentiable_pt_lim. eapply filterdiff_ext_lin. apply is_derive_filterdiff. apply locally_2d_locally in HH. apply filter_imp with (2:=HH). clear - Hk Hp ; intros [u' v'] (H1,H2). evar_last. apply Derive_correct. apply ex_diff_n_ex_deriv_inf_1 with (S n). now rewrite Nat.add_comm Nat.sub_add. exact H1. simpl ; reflexivity. apply locally_2d_singleton in HH. apply Derive_correct. apply ex_diff_n_ex_deriv_inf_2 with (S n). now rewrite Nat.add_comm Nat.sub_add. apply HH. apply locally_2d_singleton in HH. apply continuity_2d_pt_filterlim. apply ex_diff_n_continuity_inf_1 with (S n). now rewrite Nat.add_comm Nat.sub_add. apply HH. case => /= u' v'. reflexivity. apply Derive_partial_derive_aux2. apply locally_2d_impl with (2:=HH). apply locally_2d_forall. intros u' v' (Y,_). apply ex_diff_n_m with (2:=Y). lia. apply is_derive_Reals ; eapply filterdiff_ext_lin. apply @filterdiff_plus_fct ; try apply locally_filter. apply filterdiff_const. apply @filterdiff_scal_l ; try apply locally_filter. simpl => y0 ; apply plus_zero_l. apply is_derive_Reals ; eapply filterdiff_ext_lin. apply @filterdiff_plus_fct ; try apply locally_filter. apply filterdiff_const. apply @filterdiff_scal_l ; try apply locally_filter. simpl => y0 ; apply plus_zero_l. rewrite sum_n_Reals -(sum_eq (fun m => C k m * (u - x) ^ (S m) * (v - y) ^ (k - m) * partial_derive (S m) (k - m) f (x + z * (u - x)) (y + z * (v - y)) + C k m * (u - x) ^ m * (v - y) ^ (S (k - m)) * partial_derive m (S (k - m)) f (x + z * (u - x)) (y + z * (v - y)))). 2: intros ; simpl ; ring. case k; clear Hk IHk k. unfold C; simpl. simpl ; field. intros k. apply sym_eq. rewrite (decomp_sum _ (S (S k))). 2: apply Nat.lt_0_succ. rewrite - pred_Sn. rewrite tech5. rewrite (sum_eq _ (fun i : nat => (C (S k) i* partial_derive (S i) (S (S k) - S i) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ S i * (v - y) ^ (S (S k) - S i)) + (C (S k) (S i) * partial_derive (S i) (S (S k) - S i) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ S i * (v - y) ^ (S (S k) - S i)))). rewrite sum_plus. apply sym_eq. rewrite sum_plus. rewrite tech5. rewrite (tech2 _ 0 (S k)). 2: apply Nat.lt_0_succ. replace (sum_f_R0 (fun l : nat => C (S k) l * (u - x) ^ l * (v - y) ^ S (S k - l) * partial_derive l (S (S k - l)) f (x + z * (u - x)) (y + z * (v - y))) 0) with (C (S (S k)) 0 * partial_derive 0 (S (S k) - 0) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ 0 * (v - y) ^ (S (S k) - 0)). replace (C (S k) (S k) * (u - x) ^ S (S k) * (v - y) ^ (S k - S k) * partial_derive (S (S k)) (S k - S k) f (x + z * (u - x)) (y + z * (v - y))) with (C (S (S k)) (S (S k)) * partial_derive (S (S k)) (S (S k) - S (S k)) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ S (S k) * (v - y) ^ (S (S k) - S (S k))). replace (sum_f_R0 (fun l : nat => C (S k) l * partial_derive (S l) (S (S k) - S l) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ S l * (v - y) ^ (S (S k) - S l)) k) with (sum_f_R0 (fun l : nat => C (S k) l * (u - x) ^ S l * (v - y) ^ (S k - l) * partial_derive (S l) (S k - l) f (x + z * (u - x)) (y + z * (v - y))) k). replace (sum_f_R0 (fun l : nat => C (S k) (S l) * partial_derive (S l) (S (S k) - S l) f (x + z * (u - x)) (y + z * (v - y)) * (u - x) ^ S l * (v - y) ^ (S (S k) - S l)) k) with (sum_f_R0 (fun i : nat => C (S k) (1 + i) * (u - x) ^ (1 + i) * (v - y) ^ S (S k - (1 + i)) * partial_derive (1 + i) (S (S k - (1 + i))) f (x + z * (u - x)) (y + z * (v - y))) (S k - 1)). simpl ; ring. replace (S k - 1)%nat with k. 2: now apply eq_sym, Nat.add_sub_eq_l. apply sum_eq. intros i Hi. replace (1+i)%nat with (S i) by reflexivity. replace (S (S k - S i))%nat with (S (S k) - S i)%nat. ring. now (rewrite Nat.sub_succ_l; try apply le_n_S). apply sum_eq. intros i Hi. replace (S k - i)%nat with (S (S k) - S i)%nat by reflexivity. ring. rewrite 2!C_n_n 2!Nat.sub_diag. ring. simpl. rewrite 2!C_n_0. ring. intros. rewrite - (pascal (S k) i). ring. now apply Nat.lt_succ_r. (* *) destruct (Taylor_Lagrange g n 0 1 Rlt_0_1) as (t&Ht&Hg). intros t Ht. intros [|k] Hk. easy. eexists. now apply (H (S k)). (* *) rewrite Hg /DL_pol. replace (1 - 0) with 1 by ring. rewrite pow1 {1}/Rminus Rplus_assoc [_*_+_]Rplus_comm -Rplus_assoc -/(Rminus _ _). assert (forall k t, (k <= S n)%nat -> 0 <= t <= 1 -> Derive_n g k t = (sum_f_R0 (fun m => C k m * partial_derive m (k - m)%nat f (x+t*(u-x)) (y+t*(v-y)) * (u-x) ^ m * (v-y) ^ (k - m)%nat) k)). intros k t0 Hk Ht0. apply is_derive_n_unique. now apply H. rewrite -minus_sum sum_eq_R0. rewrite H0. rewrite Rplus_0_l. unfold differential. rewrite Rabs_mult. eapply Rle_trans. apply Rmult_le_compat_l. apply Rabs_pos. eapply Rle_trans. apply Rsum_abs. apply sum_Rle. intros n0 Hn0. rewrite Rmult_assoc 3!Rabs_mult. rewrite Rmult_assoc. apply Rmult_le_compat_l. apply Rabs_pos. apply Rmult_le_compat. apply Rabs_pos. apply Rmult_le_pos; apply Rabs_pos. specialize (HH t (conj (Rlt_le _ _ (proj1 Ht)) (Rlt_le _ _ (proj2 Ht)))). apply locally_singleton in HH. apply locally_2d_singleton in HH. now apply HH. rewrite - 2!RPow_abs. instantiate (1:=(Rmax (Rabs (u - x)) (Rabs (v - y)) ^ S n)). apply Rle_trans with ((Rmax (Rabs (u - x)) (Rabs (v - y)) ^ n0) * (Rmax (Rabs (u - x)) (Rabs (v - y)) ^ (S n - n0))). apply Rmult_le_compat. apply pow_le ; apply Rabs_pos. apply pow_le ; apply Rabs_pos. apply pow_incr. split. apply Rabs_pos. apply Rmax_l. apply pow_incr. split. apply Rabs_pos. apply Rmax_r. rewrite -pow_add. rewrite Nat.add_comm Nat.sub_add. apply Rle_refl. exact Hn0. rewrite - scal_sum. rewrite /Rdiv Rmult_1_l Rabs_right . right; ring. apply Rle_ge; apply Rlt_le; apply Rinv_0_lt_compat. apply INR_fact_lt_0. apply Nat.le_refl. split; apply Rlt_le, Ht. intros n0 hn0. rewrite H0. rewrite 2!Rmult_0_l 2!Rplus_0_r pow1. unfold differential, Rdiv; ring. now apply le_S. split; [apply Rle_refl | apply Rle_0_1]. Qed. coquelicot-coquelicot-3.4.1/theories/ElemFct.v000066400000000000000000000711751455143432500214040ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2020 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Lia ssreflect. Require Import Rbar Rcomplements Continuity Derive Hierarchy RInt PSeries Lim_seq RInt_analysis. (** This file describes basic properties (such as limits or differentiability) about basic functions: absolute value, inverse, square root, power, exponential and so on.*) (** * Absolute value *) (** ** in an [AbsRing] *) Lemma continuous_abs {K : AbsRing} (x : K) : continuous abs x. Proof. apply filterlim_locally => /= eps. exists eps => /= y Hy. eapply Rle_lt_trans, Hy. wlog: x y Hy / (abs x <= abs y) => [Hw | Hxy]. case: (Rle_lt_dec (abs x) (abs y)) => Hxy. by apply Hw. rewrite abs_minus (abs_minus y). apply Hw, Rlt_le, Hxy. by apply ball_sym. rewrite {1}/abs /=. rewrite Rabs_pos_eq. apply Rle_minus_l. eapply Rle_trans, abs_triangle. apply Req_le, f_equal. by rewrite /minus -plus_assoc plus_opp_l plus_zero_r. by apply -> Rminus_le_0. Qed. Lemma filterlim_abs_0 {K : AbsRing} : (forall x : K, abs x = 0 -> x = zero) -> filterlim (abs (K := K)) (locally' (zero (G := K))) (at_right 0). Proof. intros H P [eps HP]. exists eps. intros x Hx Hx'. apply HP. revert Hx. rewrite /ball /= /AbsRing_ball !minus_zero_r {2}/abs /= Rabs_pos_eq. by []. by apply abs_ge_0. assert (abs x <> 0). contradict Hx' ; by apply H. case: (abs_ge_0 x) => // H1. by rewrite -H1 in H0. Qed. (** ** in [R] *) Lemma continuous_Rabs (x : R) : continuous Rabs x. Proof. by apply @continuous_abs. Qed. Lemma continuous_Rabs_comp f (x : R) : continuous f x -> continuous (fun x0 => Rabs (f x0)) x. Proof. move => Hcontfx. apply: continuous_comp => // . apply: continuous_Rabs. Qed. Lemma filterlim_Rabs (x : Rbar) : filterlim Rabs (Rbar_locally' x) (Rbar_locally (Rbar_abs x)). Proof. destruct x as [x| | ] => //=. eapply filterlim_filter_le_1, continuous_Rabs. intros P [d HP] ; exists d => y Hy _. by apply HP. eapply filterlim_ext_loc. exists 0 => y Hy. rewrite Rabs_pos_eq // ; by apply Rlt_le. apply is_lim_id. eapply filterlim_ext_loc. exists 0 => y Hy. rewrite -Rabs_Ropp Rabs_pos_eq // -Ropp_0 ; by apply Ropp_le_contravar, Rlt_le. apply (is_lim_opp id m_infty m_infty), is_lim_id. Qed. Lemma is_lim_Rabs (f : R -> R) (x l : Rbar) : is_lim f x l -> is_lim (fun x => Rabs (f x)) x (Rbar_abs l). Proof. destruct l as [l| | ] ; simpl ; intros ; first last. eapply is_lim_comp. 2: by apply H. by apply filterlim_Rabs. destruct x ; by exists (mkposreal _ Rlt_0_1). eapply is_lim_comp. 2: by apply H. by apply filterlim_Rabs. destruct x ; by exists (mkposreal _ Rlt_0_1). apply is_lim_comp_continuous => //. by apply continuous_Rabs. Qed. Lemma filterlim_Rabs_0 : filterlim Rabs (Rbar_locally' 0) (at_right 0). Proof. apply @filterlim_abs_0. by apply Rabs_eq_0. Qed. Lemma is_lim_Rabs_0 (f : R -> R) (x : Rbar) : is_lim f x 0 -> Rbar_locally' x (fun x => f x <> 0) -> filterlim (fun x => Rabs (f x)) (Rbar_locally' x) (at_right 0). Proof. intros. eapply filterlim_comp, filterlim_Rabs_0. intros P HP. apply H in HP. generalize (filter_and _ _ H0 HP). rewrite /filtermap /= ; apply filter_imp. intros y Hy. apply Hy, Hy. Qed. Lemma filterdiff_Rabs (x : R) : x <> 0 -> filterdiff Rabs (locally x) (fun y : R => scal y (sign x)). Proof. rewrite -/(is_derive Rabs x (sign x)). move => Hx0. case: (Rle_lt_dec 0 x) => Hx. case: Hx => //= Hx. rewrite sign_eq_1 //. eapply is_derive_ext_loc. apply locally_interval with 0 p_infty. by []. by []. move => /= y Hy _. rewrite Rabs_pos_eq //. by apply Rlt_le. by apply @is_derive_id. by apply sym_eq in Hx. rewrite sign_eq_m1 //. eapply is_derive_ext_loc. apply locally_interval with m_infty 0. by []. by []. move => /= y _ Hy. rewrite -Rabs_Ropp Rabs_pos_eq //. rewrite -Ropp_0 ; by apply Rlt_le, Ropp_lt_contravar. apply @is_derive_opp. by apply @is_derive_id. Qed. Lemma is_derive_Rabs (f : R -> R) (x df : R) : is_derive f x df -> f x <> 0 -> is_derive (fun x => Rabs (f x)) x (sign (f x) * df). Proof. intros Hf Hfx. evar_last. apply is_derive_comp, Hf. by apply filterdiff_Rabs. apply Rmult_comm. Qed. (** * Inverse function *) Lemma filterlim_Rinv_0_right : filterlim Rinv (at_right 0) (Rbar_locally p_infty). Proof. intros P [M HM]. have Hd : 0 < / Rmax 1 M. apply Rinv_0_lt_compat. apply Rlt_le_trans with (2 := Rmax_l _ _). by apply Rlt_0_1. exists (mkposreal _ Hd) => x /= Hx Hx0. apply HM. apply Rle_lt_trans with (1 := Rmax_r 1 M). replace (Rmax 1 M) with (/ / Rmax 1 M) by (field ; apply Rgt_not_eq, Rlt_le_trans with (2 := Rmax_l _ _), Rlt_0_1). apply Rinv_lt_contravar. apply Rdiv_lt_0_compat with (1 := Hx0). apply Rlt_le_trans with (2 := Rmax_l _ _), Rlt_0_1. rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /= in Hx. rewrite -/(Rminus _ _) Rminus_0_r Rabs_pos_eq // in Hx. exact: Rlt_le. Qed. Lemma is_lim_Rinv_0_right (f : R -> R) (x : Rbar) : is_lim f x 0 -> Rbar_locally' x (fun x => 0 < f x) -> is_lim (fun x => / (f x)) x p_infty. Proof. intros. eapply filterlim_comp, filterlim_Rinv_0_right. intros P HP. apply H in HP. generalize (filter_and _ _ H0 HP). rewrite /filtermap ; apply filter_imp => y Hy. by apply Hy, Hy. Qed. Lemma filterlim_Rinv_0_left : filterlim Rinv (at_left 0) (Rbar_locally m_infty). Proof. eapply filterlim_ext_loc. exists (mkposreal _ Rlt_0_1) => /= y _ Hy0. rewrite -{2}(Ropp_involutive y). rewrite -Ropp_inv_permute. reflexivity. contradict Hy0. apply Rle_not_lt, Req_le. by rewrite -(Ropp_involutive y) Hy0 Ropp_0. eapply filterlim_comp. eapply filterlim_comp. by apply filterlim_Ropp_left. rewrite Ropp_0. by apply filterlim_Rinv_0_right. apply filterlim_Rbar_opp. Qed. Lemma is_lim_Rinv_0_left (f : R -> R) (x : Rbar) : is_lim f x 0 -> Rbar_locally' x (fun x => f x < 0) -> is_lim (fun x => / (f x)) x m_infty. Proof. intros. eapply filterlim_comp, filterlim_Rinv_0_left. intros P HP. apply H in HP. generalize (filter_and _ _ H0 HP). rewrite /filtermap ; apply filter_imp => y Hy. by apply Hy, Hy. Qed. Lemma continuous_Rinv x : x <> 0 -> continuous (fun x => / x) x. Proof. move => Hxneq0. apply continuity_pt_filterlim. (* strange: apply works but not apply: *) apply: continuity_pt_inv => // . apply continuity_pt_filterlim. apply: continuous_id. Qed. Lemma continuous_Rinv_comp (f : R -> R) x: continuous f x -> f x <> 0 -> continuous (fun x => / (f x)) x. Proof. move => Hcont Hfxneq0. apply: continuous_comp => //. by apply: continuous_Rinv. Qed. (** * Square root function *) Lemma filterlim_sqrt_p : filterlim sqrt (Rbar_locally' p_infty) (Rbar_locally p_infty). Proof. apply is_lim_spec. move => M. exists ((Rmax 0 M)²) => x Hx. apply Rle_lt_trans with (1 := Rmax_r 0 M). rewrite -(sqrt_Rsqr (Rmax 0 M)). apply sqrt_lt_1_alt. split. apply Rle_0_sqr. by apply Hx. apply Rmax_l. Qed. Lemma is_lim_sqrt_p (f : R -> R) (x : Rbar) : is_lim f x p_infty -> is_lim (fun x => sqrt (f x)) x p_infty. Proof. intros. eapply filterlim_comp, filterlim_sqrt_p. by apply H. Qed. Lemma filterdiff_sqrt (x : R) : 0 < x -> filterdiff sqrt (locally x) (fun y => scal y (/ (2 * sqrt x))). Proof. intros Hx. apply is_derive_Reals. by apply derivable_pt_lim_sqrt. Qed. Lemma is_derive_sqrt (f : R -> R) (x df : R) : is_derive f x df -> 0 < f x -> is_derive (fun x => sqrt (f x)) x (df / (2 * sqrt (f x))). Proof. intros Hf Hfx. evar_last. eapply is_derive_comp. by apply filterdiff_sqrt. by apply Hf. reflexivity. Qed. Lemma continuous_sqrt (x : R) : continuous sqrt x. Proof. destruct (Rle_or_lt 0 x) as [Hx|Hx]. apply continuity_pt_filterlim. by apply: continuity_pt_sqrt. assert (Hs: forall t, t < 0 -> sqrt t = 0). intros t Ht. unfold sqrt. case Rcase_abs. easy. intros Ht'. now elim Rge_not_lt with (1 := Ht'). intros P H. rewrite Hs // in H. unfold filtermap. eapply locally_open. apply open_lt. 2: exact Hx. move => /= t Ht. rewrite Hs //. now apply locally_singleton. Qed. Lemma continuous_sqrt_comp (f : R -> R) x: continuous f x -> continuous (fun x => sqrt (f x)) x. Proof. move => Hcont. apply: continuous_comp => // . by apply: continuous_sqrt. Qed. (** * Power function *) Section nat_to_ring. Context {K : Ring}. Definition nat_to_ring (n : nat) : K := sum_n_m (fun _ => one) 1 n. Lemma nat_to_ring_O : nat_to_ring O = zero. Proof. rewrite /nat_to_ring sum_n_m_zero //. Qed. Lemma nat_to_ring_Sn (n : nat) : nat_to_ring (S n) = plus (nat_to_ring n) one. Proof. case: n => [ | n] ; rewrite /nat_to_ring. rewrite sum_n_n sum_n_m_zero //. by rewrite plus_zero_l. rewrite sum_n_Sm //. by apply le_n_S, Nat.le_0_l. Qed. End nat_to_ring. Section is_derive_mult. Context {K : AbsRing}. Lemma is_derive_mult (f g : K -> K) x (df dg : K) : is_derive f x df -> is_derive g x dg -> (forall n m : K, mult n m = mult m n) -> is_derive (fun x : K => mult (f x) (g x)) x (plus (mult df (g x)) (mult (f x) dg)). Proof. intros Hf Hg Hmult. eapply filterdiff_ext_lin. eapply filterdiff_comp_2 => /=. by apply Hf. by apply Hg. eapply filterdiff_ext_lin. apply (filterdiff_mult (f x,g x)) => /=. intros P [d Hd]. assert (Cf := ex_derive_continuous f x). assert (Cg := ex_derive_continuous g x). destruct (fun H => proj1 (filterlim_locally _ _) (Cf H) d) as [d1 Hd1]. eexists ; by apply Hf. destruct (fun H => proj1 (filterlim_locally _ _) (Cg H) d) as [d2 Hd2]. eexists ; by apply Hg. exists (mkposreal _ (Rmin_stable_in_posreal d1 d2)) => /= y Hy. apply Hd ; split => /=. eapply (Hd1 y), ball_le, Hy. by apply Rmin_l. eapply (Hd2 y), ball_le, Hy. by apply Rmin_r. by apply Hmult. simpl => [[y1 y2]] /=. reflexivity. simpl => y. rewrite /scal /=. rewrite mult_assoc (Hmult (f x)) -!mult_assoc. by rewrite mult_distr_l. Qed. End is_derive_mult. Lemma filterdiff_pow_n {K : AbsRing} (x : K) (n : nat) : (forall a b : K, mult a b = mult b a) -> filterdiff (fun y : K => pow_n y n) (locally x) (fun y : K => scal y (mult (nat_to_ring n) (pow_n x (pred n)))). Proof. intros Hmult. rewrite -/(is_derive (fun y : K => pow_n y n) x (mult (nat_to_ring n) (pow_n x (pred n)))). elim: n => [ | n IH] /=. evar_last. apply is_derive_const. by rewrite nat_to_ring_O mult_zero_l. evar_last. eapply is_derive_mult. apply is_derive_id. apply IH. by apply Hmult. simpl. rewrite nat_to_ring_Sn mult_one_l mult_assoc (Hmult x) -mult_assoc. rewrite mult_distr_r mult_one_l plus_comm. apply f_equal2 => //. clear ; case: n => [ | n] //=. by rewrite nat_to_ring_O !mult_zero_l. Qed. Lemma is_derive_n_pow_smalli: forall i p x, (i <= p)%nat -> is_derive_n (fun x : R => x ^ p) i x (INR (fact p) / INR (fact (p - i)%nat) * x ^ (p - i)%nat). Proof. elim => /= [ | i IH] p x Hip. rewrite Nat.sub_0_r ; field. by apply INR_fact_neq_0. eapply is_derive_ext. intros t. apply sym_equal, is_derive_n_unique, IH. eapply Nat.le_trans, Hip ; by apply Nat.le_succ_diag_r. evar_last. apply is_derive_scal, is_derive_pow, is_derive_id. rewrite MyNat.sub_succ_r. change one with 1; rewrite -!Rmult_assoc; f_equal; rewrite Rmult_1_r. assert (p - i <> 0)%nat as E by (now apply Nat.sub_gt). rewrite -{1}(Nat.succ_pred (p - i)); [| exact E]. rewrite fact_simpl Nat.succ_pred ?mult_INR; [| exact E]. field. split; [exact (INR_fact_neq_0 _) | now apply not_0_INR]. Qed. Lemma Derive_n_pow_smalli: forall i p x, (i <= p)%nat -> Derive_n (fun x : R => x ^ p) i x = INR (fact p) / INR (fact (p - i)%nat) * x ^ (p - i)%nat. Proof. intros. now apply is_derive_n_unique, is_derive_n_pow_smalli. Qed. Lemma is_derive_n_pow_bigi: forall i p x, (p < i) %nat -> is_derive_n (fun x : R => x ^ p) i x 0. Proof. elim => /= [ | i IH] p x Hip. by apply Nat.nlt_0_r in Hip. apply ->Nat.lt_succ_r in Hip; apply le_lt_eq_dec in Hip. case: Hip => [Hip | ->] ; eapply is_derive_ext. intros t ; by apply sym_equal, is_derive_n_unique, IH. apply @is_derive_const. intros t ; rewrite Derive_n_pow_smalli. by rewrite Nat.sub_diag /=. by apply Nat.le_refl. by apply @is_derive_const. Qed. Lemma Derive_n_pow_bigi: forall i p x, (p < i) %nat -> Derive_n (fun x : R => x ^ p) i x = 0. Proof. intros. now apply is_derive_n_unique, is_derive_n_pow_bigi. Qed. Lemma Derive_n_pow i p x: Derive_n (fun x : R => x ^ p) i x = match (le_dec i p) with | left _ => INR (fact p) / INR (fact (p -i)%nat) * x ^ (p - i)%nat | right _ => 0 end. Proof. case: le_dec => H. by apply Derive_n_pow_smalli. by apply Derive_n_pow_bigi, not_le. Qed. Lemma ex_derive_n_pow i p x: ex_derive_n (fun x : R => x ^ p) i x. Proof. case: i => //= i. exists (Derive_n (fun x : R => x ^ p) (S i) x). rewrite Derive_n_pow. case: le_dec => Hip. by apply (is_derive_n_pow_smalli (S i)). apply (is_derive_n_pow_bigi (S i)) ; lia. Qed. Lemma is_RInt_pow : forall a b n, is_RInt (fun x => pow x n) a b (pow b (S n) / INR (S n) - pow a (S n) / INR (S n)). Proof. intros a b n. set f := fun x => pow x (S n) / INR (S n). fold (f a) (f b). assert (H: forall x : R, is_derive f x (pow x n)). intros x. evar_last. rewrite /f /Rdiv -[Rmult]/(scal (V := R_NormedModule)). apply is_derive_scal_l. apply is_derive_pow, is_derive_id. rewrite /pred. set k := INR (S n). rewrite /scal /= /mult /one /=. field. rewrite /k S_INR. apply Rgt_not_eq, INRp1_pos. apply: is_RInt_derive => x Hx //. apply continuity_pt_filterlim. apply derivable_continuous_pt. apply derivable_pt_pow. Qed. (** * Exponential function *) Lemma exp_ge_taylor (x : R) (n : nat) : 0 <= x -> sum_f_R0 (fun k => x^k / INR (fact k)) n <= exp x. Proof. move => Hx. rewrite /exp /exist_exp. case: Alembert_C3 => /= y Hy. apply Rnot_lt_le => H. apply Rminus_lt_0 in H. case: (Hy _ H) => N {} Hy. move: (Hy _ (MyNat.le_add_l N n)) => {Hy}. apply Rle_not_lt. apply Rle_trans with (2 := Rle_abs _). apply Rplus_le_compat_r. elim: N => [ | N IH]. rewrite Nat.add_0_r. apply Req_le. elim: (n) => {n H} [ | n /= <-]. apply Rmult_comm. apply f_equal. apply Rmult_comm. apply Rle_trans with (1 := IH). rewrite -plus_n_Sm. move: (n + N)%nat => {H N IH} n. rewrite /sum_f_R0 -/sum_f_R0. apply Rminus_le_0 ; ring_simplify. apply Rmult_le_pos. apply Rlt_le, Rinv_0_lt_compat, INR_fact_lt_0. by apply pow_le. Qed. (** Definition *) Lemma is_exp_Reals (x : R) : is_pseries (fun n => / INR (fact n)) x (exp x). Proof. rewrite /exp. case: exist_exp => l /= Hl. apply Series.is_series_Reals in Hl. move: Hl ; apply Series.is_series_ext => n. by rewrite Rmult_comm pow_n_pow. Qed. Lemma exp_Reals (x : R) : exp x = PSeries (fun n => / INR (fact n)) x. Proof. apply sym_eq, is_pseries_unique. by apply is_exp_Reals. Qed. (** Limits *) Lemma is_lim_exp_p : is_lim (fun y => exp y) p_infty p_infty. Proof. apply is_lim_le_p_loc with (fun y => 1 + y). exists 0 => y Hy. by apply Rlt_le, exp_ineq1; auto with real. pattern p_infty at 2. replace p_infty with (Rbar_plus 1 p_infty) by auto. eapply is_lim_plus. apply is_lim_const. apply is_lim_id. by []. Qed. Lemma is_lim_exp_m : is_lim (fun y => exp y) m_infty 0. Proof. evar_last. apply is_lim_ext with (fun y => /(exp (- y))). move => y ; rewrite exp_Ropp ; apply Rinv_involutive. apply Rgt_not_eq, exp_pos. apply is_lim_inv. apply is_lim_comp with p_infty. apply is_lim_exp_p. replace p_infty with (Rbar_opp m_infty) by auto. apply is_lim_opp. apply is_lim_id. by apply filter_forall. by []. by []. Qed. Lemma ex_lim_exp (x : Rbar) : ex_lim (fun y => exp y) x. Proof. case: x => [x | | ]. apply ex_finite_lim_correct, ex_lim_continuity. apply derivable_continuous_pt, derivable_pt_exp. exists p_infty ; by apply is_lim_exp_p. exists 0 ; by apply is_lim_exp_m. Qed. Lemma Lim_exp (x : Rbar) : Lim (fun y => exp y) x = match x with | Finite x => exp x | p_infty => p_infty | m_infty => 0 end. Proof. apply is_lim_unique. case: x => [x | | ]. apply is_lim_continuity. apply derivable_continuous_pt, derivable_pt_exp. by apply is_lim_exp_p. by apply is_lim_exp_m. Qed. Lemma is_lim_div_exp_p : is_lim (fun y => exp y / y) p_infty p_infty. Proof. apply is_lim_le_p_loc with (fun y => (1 + y + y^2 / 2)/y). exists 0 => y Hy. apply Rmult_le_compat_r. by apply Rlt_le, Rinv_0_lt_compat. rewrite /exp. rewrite /exist_exp. case: Alembert_C3 => /= x Hx. rewrite /Pser /infinite_sum in Hx. apply Rnot_lt_le => H. case: (Hx _ (proj1 (Rminus_lt_0 _ _) H)) => N {} Hx. move: (Hx _ (MyNat.le_add_l N 2)) => {Hx}. apply Rle_not_lt. apply Rle_trans with (2 := Rle_abs _). apply Rplus_le_compat_r. elim: N => [ | n IH]. simpl ; apply Req_le ; field. apply Rle_trans with (1 := IH). rewrite -plus_n_Sm ; move: (2 + n)%nat => {IH} n. rewrite /sum_f_R0 -/sum_f_R0. rewrite Rplus_comm ; apply Rle_minus_l ; rewrite Rminus_eq_0. apply Rmult_le_pos. apply Rlt_le, Rinv_0_lt_compat, INR_fact_lt_0. apply pow_le. by apply Rlt_le. apply is_lim_ext_loc with (fun y => /y + 1 + y / 2). exists 0 => y Hy. field. by apply Rgt_not_eq. eapply is_lim_plus. eapply is_lim_plus. apply is_lim_inv. apply is_lim_id. by []. apply is_lim_const. by []. apply is_lim_div. apply is_lim_id. apply is_lim_const. apply Rbar_finite_neq, Rgt_not_eq, Rlt_0_2. simpl. apply Rgt_not_eq, Rinv_0_lt_compat, Rlt_0_2. simpl. case: Rle_dec (Rlt_le _ _ (Rinv_0_lt_compat 2 (Rlt_0_2))) => //= H _. case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ (Rinv_0_lt_compat 2 (Rlt_0_2))) => //= H _. Qed. Lemma is_lim_mul_exp_m : is_lim (fun y => y * exp y) m_infty 0. Proof. evar_last. apply is_lim_ext_loc with (fun y => - / (exp (-y) / (- y))). exists 0 => y Hy. rewrite exp_Ropp. field. split. apply Rgt_not_eq, exp_pos. by apply Rlt_not_eq. apply is_lim_opp. apply is_lim_inv. apply (is_lim_comp (fun y => exp y / y)) with p_infty. by apply is_lim_div_exp_p. evar_last. apply is_lim_opp. apply is_lim_id. by []. by apply filter_forall. by []. simpl ; by rewrite Ropp_0. Qed. Lemma is_lim_div_expm1_0 : is_lim (fun y => (exp y - 1) / y) 0 1. Proof. apply is_lim_spec. move => eps. case: (derivable_pt_lim_exp_0 eps (cond_pos eps)) => delta H. exists delta => y Hy Hy0. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= in Hy. rewrite -/(Rminus _ _) Rminus_0_r in Hy. move: (H y Hy0 Hy). by rewrite Rplus_0_l exp_0. Qed. (** Integral *) Lemma is_RInt_exp : forall a b, is_RInt exp a b (exp b - exp a). Proof. intros a b. apply: is_RInt_derive. intros x _. apply is_derive_Reals, derivable_pt_lim_exp. intros x _. apply continuity_pt_filterlim. apply derivable_continuous_pt. apply derivable_pt_exp. Qed. (** Continuity *) Lemma continuous_exp x : continuous exp x. Proof. apply: ex_derive_continuous. apply: ex_derive_Reals_1. exact: derivable_pt_exp. Qed. Lemma continuous_exp_comp (f : R -> R) x: continuous f x -> continuous (fun x => exp (f x)) x. Proof. move => Hcont. apply: continuous_comp => //. by apply: continuous_exp. Qed. (** Derivative *) Lemma is_derive_exp : forall x, is_derive exp x (exp x). Proof. intros x. apply is_derive_Reals. apply derivable_pt_lim_exp. Qed. Lemma is_derive_n_exp : forall n x, is_derive_n exp n x (exp x). Proof. intros [|n]. easy. simpl. induction n. apply is_derive_exp. intros x. apply is_derive_ext with exp ; cycle 1. apply is_derive_exp. simpl. intros t. apply eq_sym. now apply is_derive_unique. Qed. (** * Natural logarithm *) Lemma is_lim_ln_p : is_lim (fun y => ln y) p_infty p_infty. Proof. apply is_lim_spec. move => M. exists (exp M) => x Hx. rewrite -(ln_exp M). apply ln_increasing. apply exp_pos. by apply Hx. Qed. Lemma is_lim_ln_0 : filterlim ln (at_right 0) (Rbar_locally m_infty). Proof. intros P [M HM]. exists (mkposreal (exp M) (exp_pos _)) => x /= Hx Hx0. apply HM. rewrite <- (ln_exp M). apply ln_increasing. exact Hx0. rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /= in Hx. rewrite -/(Rminus _ _) Rminus_0_r Rabs_pos_eq in Hx. exact Hx. now apply Rlt_le. Qed. Lemma is_lim_div_ln_p : is_lim (fun y => ln y / y) p_infty 0. Proof. have H : forall x, 0 < x -> ln x < x. move => x Hx. apply Rminus_lt_0. apply Rlt_le_trans with (1 := Rlt_0_1). case: (MVT_gen (fun y => y - ln y) 1 x (fun y => (y-1)/y)). move => z Hz. evar (l : R). replace ((z - 1) / z) with l. apply is_derive_Reals. apply derivable_pt_lim_minus. apply derivable_pt_lim_id. apply derivable_pt_lim_ln. eapply Rlt_trans, Hz. apply Rmin_case => //. by apply Rlt_0_1. rewrite /l ; field. apply Rgt_not_eq ; eapply Rlt_trans, Hz. apply Rmin_case => //. by apply Rlt_0_1. move => y Hy. apply continuity_pt_minus. apply continuity_pt_id. apply derivable_continuous_pt ; eexists ; apply derivable_pt_lim_ln. eapply Rlt_le_trans, Hy. apply Rmin_case => //. by apply Rlt_0_1. move => c [Hc H0]. replace 1 with (1 - ln 1) by (rewrite ln_1 Rminus_0_r //). apply Rminus_le_0. rewrite H0. move: Hc ; rewrite /Rmin /Rmax ; case: Rle_dec => H1 Hc. apply Rmult_le_pos. apply Rdiv_le_0_compat. apply -> Rminus_le_0 ; apply Hc. apply Rlt_le_trans with (1 := Rlt_0_1). by apply Hc. apply -> Rminus_le_0 ; apply H1. apply Rnot_le_lt in H1. replace ((c - 1) / c * (x - 1)) with ((1-c) * (1-x) / c). apply Rdiv_le_0_compat. apply Rmult_le_pos. apply -> Rminus_le_0 ; apply Hc. apply -> Rminus_le_0 ; apply Rlt_le, H1. apply Rlt_le_trans with (1 := Hx). by apply Hc. field. apply Rgt_not_eq. apply Rlt_le_trans with (1 := Hx). by apply Hc. apply (is_lim_le_le_loc (fun _ => 0) (fun y => 2/sqrt y)). exists 1 => x Hx. split. apply Rdiv_le_0_compat. rewrite -ln_1. apply ln_le. apply Rlt_0_1. by apply Rlt_le. by apply Rlt_trans with (1 := Rlt_0_1). replace (ln _) with (2 * ln (sqrt x)). rewrite /Rdiv Rmult_assoc. apply Rmult_le_compat_l. apply Rlt_le, Rlt_0_2. apply Rle_div_l. by apply Rlt_trans with (1 := Rlt_0_1). rewrite -{3}(sqrt_sqrt x). field_simplify ; rewrite ?Rdiv_1. apply Rlt_le, H. apply sqrt_lt_R0. by apply Rlt_trans with (1 := Rlt_0_1). apply Rgt_not_eq. apply sqrt_lt_R0. by apply Rlt_trans with (1 := Rlt_0_1). apply Rlt_le. by apply Rlt_trans with (1 := Rlt_0_1). change 2 with (INR 2). rewrite -ln_pow. rewrite /= Rmult_1_r. rewrite sqrt_sqrt. by []. apply Rlt_le. by apply Rlt_trans with (1 := Rlt_0_1). apply sqrt_lt_R0. by apply Rlt_trans with (1 := Rlt_0_1). apply is_lim_const. evar_last. apply is_lim_div. apply is_lim_const. apply filterlim_sqrt_p. by []. by []. simpl ; by rewrite Rmult_0_r. Qed. Lemma is_lim_div_ln1p_0 : is_lim (fun y => ln (1+y) / y) 0 1. Proof. apply is_lim_spec. move => eps. case: (derivable_pt_lim_ln 1 (Rlt_0_1) eps (cond_pos eps)) => delta H. exists delta => y Hy Hy0. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= in Hy. rewrite /= -/(Rminus _ _) Rminus_0_r in Hy. move: (H y Hy0 Hy). by rewrite ln_1 Rinv_1 Rminus_0_r. Qed. Lemma continuous_ln x : (0 < x) -> continuous ln x. Proof. move => Hxgt0. apply: ex_derive_continuous. exists (/x). apply is_derive_Reals. exact: derivable_pt_lim_ln. Qed. Lemma is_derive_ln x : 0 < x -> is_derive ln x (/ x)%R. Proof. intros H. apply is_derive_Reals. now apply derivable_pt_lim_ln. Qed. (** * Unnormalized sinc *) Lemma is_lim_sinc_0 : is_lim (fun x => sin x / x) 0 1. Proof. apply is_lim_spec. move => eps. case: (derivable_pt_lim_sin_0 eps (cond_pos eps)) => delta H. exists delta => y Hy Hy0. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= in Hy. rewrite /= -/(Rminus _ _) Rminus_0_r in Hy. move: (H y Hy0 Hy). by rewrite Rplus_0_l sin_0 Rminus_0_r. Qed. (** * ArcTan *) Lemma CV_radius_atan : CV_radius (fun n => (-1)^n / (INR (S (n + n)))) = 1. Proof. apply eq_trans with (2 := f_equal Finite Rinv_1). apply CV_radius_finite_DAlembert. intros n. apply Rmult_integral_contrapositive_currified. apply pow_nonzero. apply Rlt_not_eq, Rminus_lt_0 ; ring_simplify ; apply Rlt_0_1. rewrite S_INR ; by apply Rgt_not_eq, RinvN_pos. by apply Rlt_0_1. apply is_lim_seq_ext with (fun n => 1 - 2 / (2 * INR n + 3)). intros n. rewrite -plus_n_Sm plus_Sn_m !S_INR plus_INR. assert (0 < INR n + INR n + 1). rewrite -plus_INR -S_INR. by apply (lt_INR O), Nat.lt_0_succ. assert (0 < INR n + INR n + 1 + 1 + 1). rewrite -plus_INR -!S_INR. by apply (lt_INR O), Nat.lt_0_succ. rewrite !Rabs_div ; try by apply Rgt_not_eq. rewrite -!RPow_abs Rabs_m1 !pow1 !Rabs_pos_eq ; try by left. field. split ; by apply Rgt_not_eq. apply Rmult_integral_contrapositive_currified. apply pow_nonzero. apply Rlt_not_eq, Rminus_lt_0 ; ring_simplify ; apply Rlt_0_1. rewrite -plus_INR ; by apply Rgt_not_eq, RinvN_pos. evar_last. apply is_lim_seq_minus'. apply filterlim_const. eapply is_lim_seq_div. apply is_lim_seq_const. eapply is_lim_seq_plus. eapply is_lim_seq_mult. apply is_lim_seq_const. apply is_lim_seq_INR. apply is_Rbar_mult_sym, is_Rbar_mult_p_infty_pos. by apply Rlt_0_2. apply is_lim_seq_const. reflexivity ; simpl. by []. reflexivity. simpl ; apply f_equal ; ring. Qed. Lemma atan_Reals (x : R) : Rabs x < 1 -> atan x = x * PSeries (fun n => (-1)^n / (INR (S (n + n)))) (x ^ 2). Proof. wlog: x / (0 <= x) => [Hw | Hx0] Hx. case: (Rle_lt_dec 0 x) => Hx0. by apply Hw. rewrite -{1}(Ropp_involutive x) atan_opp Hw. replace ((- x) ^ 2) with (x^2) by ring. ring. apply Ropp_le_cancel ; rewrite Ropp_involutive Ropp_0 ; by left. by rewrite Rabs_Ropp. rewrite Rabs_pos_eq // in Hx. case: Hx0 => Hx0. rewrite atan_eq_ps_atan ; try by split. rewrite /ps_atan. case: Ratan.in_int => H. case: ps_atan_exists_1 => ps Hps. apply sym_eq. rewrite -Series.Series_scal_l. apply Series.is_series_unique. apply is_lim_seq_Reals in Hps. move: Hps ; apply is_lim_seq_ext => n. rewrite -sum_n_Reals. apply sum_n_ext => k. rewrite /tg_alt /Ratan_seq S_INR !plus_INR. rewrite pow_add -pow_mult. simpl ; field. rewrite -plus_INR -S_INR. apply Rgt_not_eq, (lt_INR 0), Nat.lt_0_succ. contradict H ; split. apply Rle_trans with 0. apply Rminus_le_0 ; ring_simplify ; by apply Rle_0_1. by left. by left. by rewrite -Hx0 atan_0 Rmult_0_l. Qed. Lemma continuous_atan x : continuous atan x. Proof. apply: ex_derive_continuous. apply: ex_derive_Reals_1. exact: derivable_pt_atan. Qed. Lemma continuous_atan_comp (f : R -> R) x: continuous f x -> continuous (fun x => atan (f x)) x. Proof. move => Hcont. apply: continuous_comp => //. by apply: continuous_atan. Qed. Lemma is_derive_atan x : is_derive atan x (/ (1 + x²)). Proof. rewrite Rsqr_pow2. apply is_derive_Reals, derivable_pt_lim_atan. Qed. (** * Cosine *) Lemma continuous_cos x : continuous cos x. Proof. apply continuity_pt_filterlim. by apply: continuity_cos => // . Qed. Lemma continuous_cos_comp (f : R -> R) x: continuous f x -> continuous (fun x => cos (f x)) x. Proof. move => Hcont. apply: continuous_comp => //. by apply: continuous_cos. Qed. Lemma is_derive_cos x : is_derive cos x (- sin x). Proof. apply is_derive_Reals. apply derivable_pt_lim_cos. Qed. (** * Sine *) Lemma continuous_sin x : continuous sin x. Proof. apply continuity_pt_filterlim. by apply: continuity_sin => // . Qed. Lemma continuous_sin_comp (f : R -> R) x: continuous f x -> continuous (fun x => sin (f x)) x. Proof. move => Hcont. apply: continuous_comp => //. by apply: continuous_sin. Qed. Lemma is_derive_sin x : is_derive sin x (cos x). Proof. apply is_derive_Reals. apply derivable_pt_lim_sin. Qed. (** * Tangent *) Lemma continuous_tan x : cos x <> 0 -> continuous tan x. Proof. move => Hcos. rewrite /tan. apply: continuous_mult; first by apply: continuous_sin. by apply: continuous_Rinv_comp; first by apply: continuous_cos. Qed. Lemma is_derive_tan x : cos x <> 0%R -> is_derive tan x (tan x ^ 2 + 1)%R. Proof. intros Hx. unfold tan. evar_last. apply Derive.is_derive_mult. apply is_derive_sin. apply is_derive_inv. apply is_derive_cos. exact Hx. simpl. now field. Qed. coquelicot-coquelicot-3.4.1/theories/Equiv.v000066400000000000000000000462621455143432500211550ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rbar Rcomplements Hierarchy. (** This file gives definitions of equivalent (g ~ f) and dominant (g = o(f)). This is used for defining differentiability on a [NormedModule]. *) Definition is_domin {T} {Ku Kv : AbsRing} {U : NormedModule Ku} {V : NormedModule Kv} (F : (T -> Prop) -> Prop) (f : T -> U) (g : T -> V) := forall eps : posreal, F (fun x => norm (g x) <= eps * norm (f x)). Definition is_equiv {T} {K : AbsRing} {V : NormedModule K} (F : (T -> Prop) -> Prop) (f g : T -> V) := is_domin F g (fun x => minus (g x) (f x)). (** To be dominant is a partial strict order *) Lemma domin_antisym {T} {K : AbsRing} {V : NormedModule K} : forall {F : (T -> Prop) -> Prop} {FF : ProperFilter F} (f : T -> V), F (fun x => norm (f x) <> 0) -> ~ is_domin F f f. Proof. intros F FF f Hf H. move: (H (pos_div_2 (mkposreal _ Rlt_0_1))) => {H} /= H. apply filter_const. generalize (filter_and _ _ H Hf) => {H Hf}. apply filter_imp. intros x [H1 H2]. generalize (norm_ge_0 (f x)). lra. Qed. Lemma domin_trans {T} {Ku Kv Kw : AbsRing} {U : NormedModule Ku} {V : NormedModule Kv} {W : NormedModule Kw} : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g : T -> V) (h : T -> W), is_domin F f g -> is_domin F g h -> is_domin F f h. Proof. intros F FF f g h Hfg Hgh eps. apply (filter_imp (fun x => (norm (h x) <= sqrt eps * norm (g x)) /\ (norm (g x) <= sqrt eps * norm (f x)))). intros x [H0 H1]. apply Rle_trans with (1 := H0). rewrite -{2}(sqrt_sqrt eps). rewrite Rmult_assoc. apply Rmult_le_compat_l. by apply sqrt_pos. apply H1. by apply Rlt_le, eps. apply filter_and. by apply (Hgh (mkposreal (sqrt eps) (sqrt_lt_R0 _ (cond_pos eps)))). by apply (Hfg (mkposreal (sqrt eps) (sqrt_lt_R0 _ (cond_pos eps)))). Qed. (** Relations between domination and equivalence *) Lemma equiv_le_2 {T} {K : AbsRing} {V : NormedModule K} F {FF : Filter F} (f g : T -> V) : is_equiv F f g -> F (fun x => norm (g x) <= 2 * norm (f x) /\ norm (f x) <= 2 * norm (g x)). Proof. intros H. apply filter_and. - move: (H (pos_div_2 (mkposreal _ Rlt_0_1))) => {H}. apply filter_imp => x /= H. apply Rle_trans with (1 := norm_triangle_inv _ _) in H. rewrite -Ropp_minus_distr Rabs_Ropp in H. apply Rabs_le_between' in H ; case: H => H _. field_simplify in H. rewrite ?Rdiv_1 in H. apply Rle_div_l in H. by rewrite Rmult_comm. by apply Rlt_0_2. - move: (H (mkposreal _ Rlt_0_1)) => {H}. apply filter_imp => x /= H. apply Rle_trans with (1 := norm_triangle_inv _ _) in H. rewrite -Ropp_minus_distr Rabs_Ropp in H. apply Rabs_le_between' in H ; case: H => _ H. field_simplify in H. by rewrite ?Rdiv_1 in H. Qed. Lemma domin_rw_l {T} {Ku Kv : AbsRing} {U : NormedModule Ku} {V : NormedModule Kv} : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f1 f2 : T -> U) (g : T -> V), is_equiv F f1 f2 -> is_domin F f1 g -> is_domin F f2 g. Proof. intros F FF f1 f2 g Hf Hg eps. assert (F (fun x => norm (f1 x) <= 2 * norm (f2 x))). eapply filter_imp. 2: apply (equiv_le_2 _ _ _ Hf). move => /= x Hx. by apply Hx. clear Hf ; rename H into Hf. specialize (Hg (pos_div_2 eps)). generalize (filter_and _ _ Hf Hg) ; clear -FF. apply filter_imp => x /= [Hf Hg]. apply Rle_trans with (1 := Hg). rewrite /Rdiv Rmult_assoc. apply Rmult_le_compat_l. by apply Rlt_le, eps. rewrite Rmult_comm Rle_div_l. by rewrite Rmult_comm. by apply Rlt_0_2. Qed. Lemma domin_rw_r {T} {Ku Kv : AbsRing} {U : NormedModule Ku} {V : NormedModule Kv} : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g1 g2 : T -> V), is_equiv F g1 g2 -> is_domin F f g1 -> is_domin F f g2. Proof. intros F FF f g1 g2 Hg Hf eps. assert (F (fun x => norm (g2 x) <= 2 * norm (g1 x))). eapply filter_imp. 2: apply (equiv_le_2 _ _ _ Hg). move => /= x Hx. by apply Hx. clear Hg ; rename H into Hg. specialize (Hf (pos_div_2 eps)). generalize (filter_and _ _ Hf Hg) ; clear -FF. apply filter_imp => x /= [Hf Hg]. apply Rle_trans with (1 := Hg). rewrite Rmult_comm Rle_div_r. apply Rle_trans with (1 := Hf). right ; rewrite /Rdiv ; ring. by apply Rlt_0_2. Qed. (** To be equivalent is an equivalence relation *) Section Equiv. Context {T : Type} {K : AbsRing} {V : NormedModule K}. Lemma equiv_refl : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> V), is_equiv F f f. Proof. intros F FF f eps. apply: filter_forall => x. rewrite /minus plus_opp_r norm_zero. apply Rmult_le_pos. by apply Rlt_le, eps. by apply norm_ge_0. Qed. Lemma equiv_sym : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V), is_equiv F f g -> is_equiv F g f. Proof. intros F FF f g H eps. assert (H0 := equiv_le_2 _ _ _ H). specialize (H (pos_div_2 eps)). generalize (filter_and _ _ H H0) ; apply filter_imp ; clear => x [H [H0 H1]]. rewrite -norm_opp /minus opp_plus opp_opp plus_comm. apply Rle_trans with (1 := H) ; simpl. eapply Rle_trans. apply Rmult_le_compat_l. by apply Rlt_le, is_pos_div_2. by apply H0. apply Req_le ; field. Qed. Lemma equiv_trans : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g h : T -> V), is_equiv F f g -> is_equiv F g h -> is_equiv F f h. Proof. intros F FF f g h Hfg Hgh. apply (fun c => domin_rw_l _ _ c Hgh). intros eps. apply equiv_sym in Hgh. generalize (filter_and _ _ (Hfg (pos_div_2 eps)) (Hgh (pos_div_2 eps))) => {Hfg Hgh}. apply filter_imp => x /= [Hfg Hgh]. replace (minus (h x) (f x)) with (plus (minus (g x) (f x)) (opp (minus (g x) (h x)))). eapply Rle_trans. 1 : by apply @norm_triangle. rewrite norm_opp (double_var eps) Rmult_plus_distr_r. by apply Rplus_le_compat. rewrite /minus opp_plus opp_opp plus_comm plus_assoc. congr (plus _ (opp (f x))). rewrite plus_comm plus_assoc plus_opp_r. apply plus_zero_l. Qed. Lemma equiv_carac_0 : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V), is_equiv F f g -> {o : T -> V | (forall x : T, f x = plus (g x) (o x)) /\ is_domin F g o }. Proof. intros F FF f g H. exists (fun x => minus (f x) (g x)). split. intro x. by rewrite /minus plus_comm -plus_assoc plus_opp_l plus_zero_r. apply (domin_rw_l _ _ _ H). by apply equiv_sym. Qed. Lemma equiv_carac_1 : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g o : T -> V), (forall x, f x = plus (g x) (o x)) -> is_domin F g o -> is_equiv F f g. Proof. intros F FF f g o Ho Hgo. intro eps ; move: (Hgo eps). apply filter_imp => x. replace (o x) with (minus (f x) (g x)). congr (_ <= _). by rewrite -norm_opp /minus opp_plus opp_opp plus_comm. rewrite Ho. rewrite /minus plus_comm plus_assoc plus_opp_l. apply plus_zero_l. Qed. Lemma equiv_ext_loc {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V) : F (fun x => f x = g x) -> is_equiv F f g. Proof. move => H eps. move: H ; apply filter_imp. move => x ->. rewrite /minus plus_opp_r norm_zero. apply Rmult_le_pos. by apply Rlt_le, eps. by apply norm_ge_0. Qed. End Equiv. (** * Vector space *) (** is_domin is a vector space *) Section Domin. Context {T : Type} {Ku Kv : AbsRing} {U : NormedModule Ku} {V : NormedModule Kv}. Lemma is_domin_le {F G} (f : T -> U) (g : T -> V) : is_domin F f g -> filter_le G F -> is_domin G f g. Proof. intros. intros eps. by apply H0. Qed. Lemma domin_scal_r : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g : T -> V) (c : Kv), is_domin F f g -> is_domin F f (fun x => scal c (g x)). Proof. intros F FF f g c H. case: (Req_dec (abs c) 0) => Hc. move => eps /=. apply filter_forall => x. eapply Rle_trans. apply @norm_scal. rewrite Hc Rmult_0_l. apply Rmult_le_pos. by apply Rlt_le, eps. by apply norm_ge_0. destruct (abs_ge_0 c) => //. clear Hc ; rename H0 into Hc. move => eps /=. assert (He : 0 < eps / abs c). apply Rdiv_lt_0_compat. by apply eps. by apply Hc. move: (H (mkposreal _ He)) => /= {H}. apply filter_imp => x H. eapply Rle_trans. apply @norm_scal. rewrite Rmult_comm ; apply Rle_div_r. by []. apply Rle_trans with (1 := H). apply Req_le ; rewrite /Rdiv ; ring. by apply sym_eq in H0. Qed. Lemma domin_scal_l : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g : T -> V) (c : Ku), (exists y, mult y c = one) -> is_domin F f g -> is_domin F (fun x => scal c (f x)) g. Proof. intros F FF f g c Hc H eps. destruct Hc as [y Hc]. assert (0 < abs c). apply Rnot_le_lt => H0. destruct H0. move: H0 ; by apply Rle_not_lt, abs_ge_0. move: H0. apply (Rmult_neq_0_reg (abs y)). apply Rgt_not_eq. eapply Rlt_le_trans, @abs_mult. rewrite Hc abs_one ; by apply Rlt_0_1. assert (0 < abs y). apply Rmult_lt_reg_r with (abs c). by []. rewrite Rmult_0_l. eapply Rlt_le_trans, @abs_mult. rewrite Hc abs_one ; by apply Rlt_0_1. assert (He : (0 < eps / abs y)). apply Rdiv_lt_0_compat. by apply eps. by []. move: (H (mkposreal _ He)) => /= {H}. apply filter_imp => x Hx. apply Rle_trans with (1 := Hx). rewrite /Rdiv Rmult_assoc ; apply Rmult_le_compat_l. by apply Rlt_le, eps. rewrite -{1}(scal_one (f x)) -Hc -scal_assoc. eapply Rle_trans. apply Rmult_le_compat_l. by apply Rlt_le, Rinv_0_lt_compat. apply @norm_scal. apply Req_le ; field. by apply Rgt_not_eq. Qed. Lemma domin_plus : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (g1 g2 : T -> V), is_domin F f g1 -> is_domin F f g2 -> is_domin F f (fun x => plus (g1 x) (g2 x)). Proof. intros F FF f g1 g2 Hg1 Hg2 eps. generalize (filter_and _ _ (Hg1 (pos_div_2 eps)) (Hg2 (pos_div_2 eps))) => /= {Hg1 Hg2}. apply filter_imp => x [Hg1 Hg2]. eapply Rle_trans. apply @norm_triangle. eapply Rle_trans. apply Rplus_le_compat. by apply Hg1. by apply Hg2. apply Req_le ; field. Qed. End Domin. (** is_equiv is compatible with the vector space structure *) Section Equiv_VS. Context {T : Type} {K : AbsRing} {V : NormedModule K}. Lemma equiv_scal : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> V) (c : K), (exists y : K, mult y c = one) -> is_equiv F f g -> is_equiv F (fun x => scal c (f x)) (fun x => scal c (g x)). Proof. intros F FF f g c [y Hc] H. apply domin_scal_l. by exists y. move => eps /=. cut (F (fun x => norm (scal c (minus (g x) (f x))) <= eps * norm (g x))). apply filter_imp => x. now rewrite scal_distr_l scal_opp_r. now apply domin_scal_r. Qed. Lemma equiv_plus : forall {F : (T -> Prop) -> Prop} {FF : Filter F} (f o : T -> V), is_domin F f o -> is_equiv F (fun x => plus (f x) (o x)) f. Proof. intros F FF f o H eps. move: (H eps) => {H}. apply filter_imp => x Hx. simpl. now rewrite /minus opp_plus plus_assoc plus_opp_r plus_zero_l norm_opp. Qed. End Equiv_VS. (** * Multiplication and inverse *) (** Domination *) Lemma domin_mult_r : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g h : T -> R), is_domin F f g -> is_domin F (fun x => f x * h x) (fun x => g x * h x). Proof. intros T F FF f g h H eps. move: (H eps) => {H}. apply filter_imp => x H1. rewrite /norm /= /abs /= ?Rabs_mult. rewrite -Rmult_assoc. apply Rmult_le_compat_r. by apply Rabs_pos. by apply H1. Qed. Lemma domin_mult_l : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g h : T -> R), is_domin F f g -> is_domin F (fun x => h x * f x) (fun x => h x * g x). Proof. intros T F FF f g h H eps. generalize (domin_mult_r f g h H eps). apply filter_imp => x. by rewrite ?(Rmult_comm (h x)). Qed. Lemma domin_mult : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f1 f2 g1 g2 : T -> R), is_domin F f1 g1 -> is_domin F f2 g2 -> is_domin F (fun x => f1 x * f2 x) (fun x => g1 x * g2 x). Proof. intros T F FF f1 f2 g1 g2 H1 H2 eps. move: (H1 (mkposreal _ (sqrt_lt_R0 _ (cond_pos eps)))) (H2 (mkposreal _ (sqrt_lt_R0 _ (cond_pos eps)))) => {H1 H2} /= H1 H2. generalize (filter_and _ _ H1 H2) => {H1 H2}. apply filter_imp => x [H1 H2]. rewrite /norm /= /abs /= ?Rabs_mult. rewrite -(sqrt_sqrt _ (Rlt_le _ _ (cond_pos eps))). replace (sqrt eps * sqrt eps * (Rabs (f1 x) * Rabs (f2 x))) with ((sqrt eps * Rabs (f1 x))*(sqrt eps * Rabs (f2 x))) by ring. apply Rmult_le_compat. by apply Rabs_pos. by apply Rabs_pos. by apply H1. by apply H2. Qed. Lemma domin_inv : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> R), F (fun x => g x <> 0) -> is_domin F f g -> is_domin F (fun x => / g x) (fun x => / f x). Proof. intros T F FF f g Hg H eps. have Hf : F (fun x => f x <> 0). generalize (filter_and _ _ Hg (H (mkposreal _ Rlt_0_1))) => /=. apply filter_imp => x {Hg H} [Hg H]. case: (Req_dec (f x) 0) => Hf. rewrite /norm /= /abs /= Hf Rabs_R0 Rmult_0_r in H. apply Rlt_not_le in H. move => _ ; apply H. by apply Rabs_pos_lt. by []. generalize (filter_and _ _ (H eps) (filter_and _ _ Hf Hg)) => {H Hf Hg}. apply filter_imp => x [H [Hf Hg]]. rewrite /norm /= /abs /= ?Rabs_Rinv => //. replace (/ Rabs (f x)) with (Rabs (g x) / (Rabs (f x) * Rabs (g x))) by (field ; split ; by apply Rabs_no_R0). replace (eps * / Rabs (g x)) with (eps * Rabs (f x) / (Rabs (f x) * Rabs (g x))) by (field ; split ; by apply Rabs_no_R0). apply Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat, Rmult_lt_0_compat ; apply Rabs_pos_lt => //. by apply H. Qed. (** Equivalence *) Lemma equiv_mult : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f1 f2 g1 g2 : T -> R), is_equiv F f1 g1 -> is_equiv F f2 g2 -> is_equiv F (fun x => f1 x * f2 x) (fun x => g1 x * g2 x). Proof. intros T F FF f1 f2 g1 g2 H1 H2. case: (equiv_carac_0 _ _ H1) => {H1} o1 [H1 Ho1]. case: (equiv_carac_0 _ _ H2) => {H2} o2 [H2 Ho2]. apply equiv_carac_1 with (fun x => o1 x * g2 x + g1 x * o2 x + o1 x * o2 x). move => x ; rewrite H1 H2 /plus /= ; ring. repeat apply @domin_plus => //. by apply domin_mult_r. by apply domin_mult_l. by apply domin_mult. Qed. Lemma equiv_inv : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> R), F (fun x => g x <> 0) -> is_equiv F f g -> is_equiv F (fun x => / f x) (fun x => / g x). Proof. intros T F FF f g Hg H. have Hf : F (fun x => f x <> 0). generalize (filter_and _ _ Hg (H (pos_div_2 (mkposreal _ Rlt_0_1)))) => /=. apply filter_imp => x {Hg H} [Hg H]. case: (Req_dec (f x) 0) => Hf //. rewrite /minus /plus /opp /= Hf Ropp_0 Rplus_0_r in H. generalize (norm_ge_0 (g x)) (norm_eq_zero (g x)). rewrite /zero /=. lra. apply equiv_sym in H. move => eps. generalize (filter_and _ _ (filter_and _ _ Hf Hg) (H eps)). clear -FF. apply filter_imp. intros x [[Hf Hg] H]. rewrite /norm /= /abs /minus /plus /opp /=. replace (/ g x + - / f x) with ((f x - g x) / (f x * g x)). rewrite Rabs_div ?Rabs_Rinv ?Rabs_mult //. apply Rle_div_l. apply Rmult_lt_0_compat ; by apply Rabs_pos_lt. field_simplify ; rewrite ?Rdiv_1. by []. by apply Rabs_no_R0. by apply Rmult_integral_contrapositive_currified. field ; by split. Qed. (** * Domination and composition *) Section Domin_comp. Context {T1 T2 : Type} {Ku Kv : AbsRing} {U : NormedModule Ku} {V : NormedModule Kv} (F : (T1 -> Prop) -> Prop) {FF : Filter F} (G : (T2 -> Prop) -> Prop) {FG : Filter G}. Lemma domin_comp (f : T2 -> U) (g : T2 -> V) (l : T1 -> T2) : filterlim l F G -> is_domin G f g -> is_domin F (fun t => f (l t)) (fun t => g (l t)). Proof. intros Hl Hg eps. generalize (fun eps => Hl _ (Hg eps)) => {Hl Hg} /= Hl. by apply Hl. Qed. End Domin_comp. (** * Equivalence and limits *) Lemma filterlim_equiv : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} (f g : T -> R) (l : Rbar), is_equiv F f g -> filterlim f F (Rbar_locally l) -> filterlim g F (Rbar_locally l). Proof. intros T F FF f g [l| |] Hfg Hf P [eps HP] ; apply equiv_sym in Hfg ; unfold filtermap. - assert (He: 0 < eps / 2 / (Rabs l + 1)). apply Rdiv_lt_0_compat. apply is_pos_div_2. apply Rplus_le_lt_0_compat. apply Rabs_pos. apply Rlt_0_1. pose ineqs (y : R) := Rabs (y - l) < eps/2 /\ Rabs y <= Rabs l + 1. assert (Hl: Rbar_locally l ineqs). assert (H: 0 < Rmin (eps / 2) 1). apply Rmin_case. apply is_pos_div_2. apply Rlt_0_1. exists (mkposreal _ H). simpl. intros x Hx. split. apply Rlt_le_trans with (1 := Hx). apply Rmin_l. apply Rabs_le_between'. apply Rle_trans with (1 := Rabs_triang_inv2 _ _). apply Rlt_le. apply Rlt_le_trans with (1 := Hx). apply Rmin_r. generalize (filter_and _ (fun (x : T) => ineqs (f x)) (Hfg (mkposreal _ He)) (Hf _ Hl)). apply filter_imp. simpl. intros x [H1 [H2 H3]]. apply HP. rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=. replace (g x + - l) with ((f x - l) + -(f x - g x)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). replace (pos eps) with (eps / 2 + eps / 2 / (Rabs l + 1) * (Rabs l + 1)). apply Rplus_lt_le_compat with (1 := H2). rewrite Rabs_Ropp. apply Rle_trans with (1 := H1). apply Rmult_le_compat_l with (2 := H3). now apply Rlt_le. field. apply Rgt_not_eq. apply Rplus_le_lt_0_compat. apply Rabs_pos. apply Rlt_0_1. - pose ineq (y : R) := Rmax 0 (2 * eps) < y. assert (Hl: Rbar_locally' p_infty ineq). now exists (Rmax 0 (2 * eps)). generalize (filter_and _ (fun (x : T) => ineq (f x)) (Hfg (mkposreal _ pos_half_prf)) (Hf _ Hl)). apply filter_imp. simpl. intros x [H1 H2]. apply HP. apply Rabs_le_between' in H1. generalize (Rplus_le_compat_l (- /2 * Rabs (f x)) _ _ (proj2 H1)). rewrite /norm /= /abs /=. replace (- / 2 * Rabs (f x) + (g x + / 2 * Rabs (f x))) with (g x) by ring. apply Rlt_le_trans. rewrite Rabs_pos_eq. apply Rmult_lt_reg_l with (1 := Rlt_R0_R2). replace (2 * (- / 2 * f x + f x)) with (f x) by field. apply Rle_lt_trans with (2 := H2). apply Rmax_r. apply Rlt_le. apply Rle_lt_trans with (2 := H2). apply Rmax_l. - pose ineq (y : R) := y < Rmin 0 (2 * eps). assert (Hl: Rbar_locally' m_infty ineq). now exists (Rmin 0 (2 * eps)). generalize (filter_and _ (fun (x : T) => ineq (f x)) (Hfg (mkposreal _ pos_half_prf)) (Hf _ Hl)). apply filter_imp. simpl. intros x [H1 H2]. apply HP. apply Rabs_le_between' in H1. generalize (Rplus_le_compat_l (/2 * Rabs (f x)) _ _ (proj1 H1)). rewrite /norm /= /abs /=. replace (/ 2 * Rabs (f x) + (g x - / 2 * Rabs (f x))) with (g x) by ring. intros H. apply Rle_lt_trans with (1 := H). rewrite Rabs_left. apply Rmult_lt_reg_l with (1 := Rlt_R0_R2). replace (2 * (/ 2 * - f x + f x)) with (f x) by field. apply Rlt_le_trans with (1 := H2). apply Rmin_r. apply Rlt_le_trans with (1 := H2). apply Rmin_l. Qed. coquelicot-coquelicot-3.4.1/theories/Hierarchy.v000066400000000000000000004176751455143432500220140ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2017 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Rbar Markov Iter Lub. (** This file first describes [Filter]s that are predicates of type [(T -> Prop) -> Prop] used for limits and neighborhoods. Then the algebraic hierarchy of the Coquelicot library is given: from the [AbelianMonoid] to the [CompleteNormedModule]. Topologies on [R] and [R*R] are also given. #
# More documentation details can be found in #Coquelicot.html#. *) Open Scope R_scope. (** * Filters *) (** ** Definitions *) Class Filter {T : Type} (F : (T -> Prop) -> Prop) := { filter_true : F (fun _ => True) ; filter_and : forall P Q : T -> Prop, F P -> F Q -> F (fun x => P x /\ Q x) ; filter_imp : forall P Q : T -> Prop, (forall x, P x -> Q x) -> F P -> F Q }. Global Hint Mode Filter + + : typeclass_instances. Class ProperFilter' {T : Type} (F : (T -> Prop) -> Prop) := { filter_not_empty : not (F (fun _ => False)) ; filter_filter' :> Filter F }. Class ProperFilter {T : Type} (F : (T -> Prop) -> Prop) := { filter_ex : forall P, F P -> exists x, P x ; filter_filter :> Filter F }. Global Instance Proper_StrongProper : forall {T : Type} (F : (T -> Prop) -> Prop), ProperFilter F -> ProperFilter' F. Proof. intros T F [H1 H2]. constructor. intros H. now destruct (H1 _ H) as [x Hx]. exact H2. Qed. Lemma filter_forall : forall {T : Type} {F} {FF: @Filter T F} (P : T -> Prop), (forall x, P x) -> F P. Proof. intros T F FF P H. apply filter_imp with (fun _ => True). easy. apply filter_true. Qed. Lemma filter_const : forall {T : Type} {F} {FF: @ProperFilter T F} (P : Prop), F (fun _ => P) -> P. Proof. intros T F FF P H. destruct (filter_ex (fun _ => P) H) as [_ H']. exact H'. Qed. (** ** Limits expressed with filters *) Definition filter_le {T : Type} (F G : (T -> Prop) -> Prop) := forall P, G P -> F P. Lemma filter_le_refl : forall T F, @filter_le T F F. Proof. now intros T F P. Qed. Lemma filter_le_trans : forall T F G H, @filter_le T F G -> filter_le G H -> filter_le F H. Proof. intros T F G H FG GH P K. now apply FG, GH. Qed. Definition filtermap {T U : Type} (f : T -> U) (F : (T -> Prop) -> Prop) := fun P => F (fun x => P (f x)). Global Instance filtermap_filter : forall T U (f : T -> U) (F : (T -> Prop) -> Prop), Filter F -> Filter (filtermap f F). Proof. intros T U f F FF. unfold filtermap. constructor. - apply filter_true. - intros P Q HP HQ. now apply filter_and. - intros P Q H HP. apply (filter_imp (fun x => P (f x))). intros x Hx. now apply H. exact HP. Qed. Global Instance filtermap_proper_filter' : forall T U (f : T -> U) (F : (T -> Prop) -> Prop), ProperFilter' F -> ProperFilter' (filtermap f F). Proof. intros T U f F FF. unfold filtermap. split. - apply filter_not_empty. - apply filtermap_filter. apply filter_filter'. Qed. Global Instance filtermap_proper_filter : forall T U (f : T -> U) (F : (T -> Prop) -> Prop), ProperFilter F -> ProperFilter (filtermap f F). Proof. intros T U f F FF. unfold filtermap. split. - intros P FP. destruct (filter_ex _ FP) as [x Hx]. now exists (f x). - apply filtermap_filter. apply filter_filter. Qed. Definition filtermapi {T U : Type} (f : T -> U -> Prop) (F : (T -> Prop) -> Prop) := fun P : U -> Prop => F (fun x => exists y, f x y /\ P y). Global Instance filtermapi_filter : forall T U (f : T -> U -> Prop) (F : (T -> Prop) -> Prop), F (fun x => (exists y, f x y) /\ forall y1 y2, f x y1 -> f x y2 -> y1 = y2) -> Filter F -> Filter (filtermapi f F). Proof. intros T U f F H FF. unfold filtermapi. constructor. - apply: filter_imp H => x [[y Hy] H]. exists y. exact (conj Hy I). - intros P Q HP HQ. apply: filter_imp (filter_and _ _ (filter_and _ _ HP HQ) H). intros x [[[y1 [Hy1 Py]] [y2 [Hy2 Qy]]] [[y Hy] Hf]]. exists y. apply (conj Hy). split. now rewrite (Hf y y1). now rewrite (Hf y y2). - intros P Q HPQ HP. apply: filter_imp HP. intros x [y [Hf Py]]. exists y. apply (conj Hf). now apply HPQ. Qed. Global Instance filtermapi_proper_filter' : forall T U (f : T -> U -> Prop) (F : (T -> Prop) -> Prop), F (fun x => (exists y, f x y) /\ forall y1 y2, f x y1 -> f x y2 -> y1 = y2) -> ProperFilter' F -> ProperFilter' (filtermapi f F). Proof. intros T U f F HF FF. unfold filtermapi. split. - intro H. apply filter_not_empty. apply filter_imp with (2 := H). now intros x [y [_ Hy]]. - apply filtermapi_filter. exact HF. apply filter_filter'. Qed. Global Instance filtermapi_proper_filter : forall T U (f : T -> U -> Prop) (F : (T -> Prop) -> Prop), F (fun x => (exists y, f x y) /\ forall y1 y2, f x y1 -> f x y2 -> y1 = y2) -> ProperFilter F -> ProperFilter (filtermapi f F). Proof. intros T U f F HF FF. unfold filtermapi. split. - intros P FP. destruct (filter_ex _ FP) as [x [y [_ Hy]]]. now exists y. - apply filtermapi_filter. exact HF. apply filter_filter. Qed. Definition filterlim {T U : Type} (f : T -> U) F G := filter_le (filtermap f F) G. Lemma filterlim_id : forall T (F : (T -> Prop) -> Prop), filterlim (fun x => x) F F. Proof. now intros T F P HP. Qed. Lemma filterlim_comp : forall T U V (f : T -> U) (g : U -> V) F G H, filterlim f F G -> filterlim g G H -> filterlim (fun x => g (f x)) F H. Proof. intros T U V f g F G H FG GH P HP. apply (FG (fun x => P (g x))). now apply GH. Qed. Lemma filterlim_ext_loc : forall {T U F G} {FF : Filter F} (f g : T -> U), F (fun x => f x = g x) -> filterlim f F G -> filterlim g F G. Proof. intros T U F G FF f g Efg Lf P GP. specialize (Lf P GP). generalize (filter_and _ (fun x : T => P (f x)) Efg Lf). unfold filtermap. apply filter_imp. now intros x [-> H]. Qed. Lemma filterlim_ext : forall {T U F G} {FF : Filter F} (f g : T -> U), (forall x, f x = g x) -> filterlim f F G -> filterlim g F G. Proof. intros T U F G FF f g Efg. apply filterlim_ext_loc. now apply filter_forall. Qed. Lemma filterlim_filter_le_1 : forall {T U F G H} (f : T -> U), filter_le G F -> filterlim f F H -> filterlim f G H. Proof. intros T U F G H f K Hf P HP. apply K. now apply Hf. Qed. Lemma filterlim_filter_le_2 : forall {T U F G H} (f : T -> U), filter_le G H -> filterlim f F G -> filterlim f F H. Proof. intros T U F G H f K Hf P HP. apply Hf. now apply K. Qed. Definition filterlimi {T U : Type} (f : T -> U -> Prop) F G := filter_le (filtermapi f F) G. Lemma filterlimi_comp : forall T U V (f : T -> U) (g : U -> V -> Prop) F G H, filterlim f F G -> filterlimi g G H -> filterlimi (fun x => g (f x)) F H. Proof. intros T U V f g F G H FG GH P HP. apply (FG (fun x => exists y, g x y /\ P y)). now apply GH. Qed. Lemma filterlimi_ext_loc : forall {T U F G} {FF : Filter F} (f g : T -> U -> Prop), F (fun x => forall y, f x y <-> g x y) -> filterlimi f F G -> filterlimi g F G. Proof. intros T U F G FF f g Efg Lf P GP. specialize (Lf P GP). generalize (filter_and _ _ Efg Lf). unfold filtermapi. apply filter_imp. intros x [H [y [Hy1 Hy2]]]. exists y. apply: conj Hy2. now apply H. Qed. Lemma filterlimi_ext : forall {T U F G} {FF : Filter F} (f g : T -> U -> Prop), (forall x y, f x y <-> g x y) -> filterlimi f F G -> filterlimi g F G. Proof. intros T U F G FF f g Efg. apply filterlimi_ext_loc. now apply filter_forall. Qed. Lemma filterlimi_lim_ext_loc : forall {T U F G} {FF : Filter F} (f : T -> U) (g : T -> U -> Prop), F (fun x => g x (f x)) -> filterlim f F G -> filterlimi g F G. Proof. intros T U F G FF f g HF Hf P HP. generalize (filter_and (fun x => g x (f x)) _ HF (Hf P HP)). unfold filtermapi. apply: filter_imp. intros x [H1 H2]. now exists (f x). Qed. Lemma filterlimi_lim_ext : forall {T U F G} {FF : Filter F} (f : T -> U) (g : T -> U -> Prop), (forall x, g x (f x)) -> filterlim f F G -> filterlimi g F G. Proof. intros T U F G FF f g HF. apply filterlimi_lim_ext_loc. now apply filter_forall. Qed. Lemma filterlimi_filter_le_1 : forall {T U F G H} (f : T -> U -> Prop), filter_le G F -> filterlimi f F H -> filterlimi f G H. Proof. intros T U F G H f K Hf P HP. apply K. now apply Hf. Qed. Lemma filterlimi_filter_le_2 : forall {T U F G H} (f : T -> U -> Prop), filter_le G H -> filterlimi f F G -> filterlimi f F H. Proof. intros T U F G H f K Hf P HP. apply Hf. now apply K. Qed. (** ** Specific filters *) (** Filters for pairs *) Inductive filter_prod {T U : Type} (F G : _ -> Prop) (P : T * U -> Prop) : Prop := Filter_prod (Q : T -> Prop) (R : U -> Prop) : F Q -> G R -> (forall x y, Q x -> R y -> P (x, y)) -> filter_prod F G P. Global Instance filter_prod_filter : forall T U (F : (T -> Prop) -> Prop) (G : (U -> Prop) -> Prop), Filter F -> Filter G -> Filter (filter_prod F G). Proof. intros T U F G FF FG. constructor. - exists (fun _ => True) (fun _ => True). apply filter_true. apply filter_true. easy. - intros P Q [AP BP P1 P2 P3] [AQ BQ Q1 Q2 Q3]. exists (fun x => AP x /\ AQ x) (fun x => BP x /\ BQ x). now apply filter_and. now apply filter_and. intros x y [Px Qx] [Py Qy]. split. now apply P3. now apply Q3. - intros P Q HI [AP BP P1 P2 P3]. exists AP BP ; try easy. intros x y Hx Hy. apply HI. now apply P3. Qed. Global Instance filter_prod_proper' {T1 T2 : Type} {F : (T1 -> Prop) -> Prop} {G : (T2 -> Prop) -> Prop} {FF : ProperFilter' F} {FG : ProperFilter' G} : ProperFilter' (filter_prod F G). Proof. split. intros [Q R HQ HR HQR]. apply FG. apply filter_imp with (2 := HR). intros y Hy. apply FF. apply filter_imp with (2 := HQ). intros x Hx. now apply (HQR x y). apply filter_prod_filter. apply FF. apply FG. Qed. Global Instance filter_prod_proper {T1 T2 : Type} {F : (T1 -> Prop) -> Prop} {G : (T2 -> Prop) -> Prop} {FF : ProperFilter F} {FG : ProperFilter G} : ProperFilter (filter_prod F G). Proof. split. intros P [Q1 Q2 H1 H2 HP]. case: (filter_ex _ H1) => x1 Hx1. case: (filter_ex _ H2) => x2 Hx2. exists (x1,x2). by apply HP. apply filter_prod_filter. apply FF. apply FG. Qed. Lemma filterlim_fst : forall {T U F G} {FG : Filter G}, filterlim (@fst T U) (filter_prod F G) F. Proof. intros T U F G FG P HP. exists P (fun _ => True) ; try easy. apply filter_true. Qed. Lemma filterlim_snd : forall {T U F G} {FF : Filter F}, filterlim (@snd T U) (filter_prod F G) G. Proof. intros T U F G FF P HP. exists (fun _ => True) P ; try easy. apply filter_true. Qed. Lemma filterlim_pair : forall {T U V F G H} {FF : Filter F}, forall (f : T -> U) (g : T -> V), filterlim f F G -> filterlim g F H -> filterlim (fun x => (f x, g x)) F (filter_prod G H). Proof. intros T U V F G H FF f g Cf Cg P [A B GA HB HP]. unfold filtermap. apply (filter_imp (fun x => A (f x) /\ B (g x))). intros x [Af Bg]. now apply HP. apply filter_and. now apply Cf. now apply Cg. Qed. Lemma filterlim_comp_2 : forall {T U V W F G H I} {FF : Filter F}, forall (f : T -> U) (g : T -> V) (h : U -> V -> W), filterlim f F G -> filterlim g F H -> filterlim (fun x => h (fst x) (snd x)) (filter_prod G H) I -> filterlim (fun x => h (f x) (g x)) F I. Proof. intros T U V W F G H I FF f g h Cf Cg Ch. change (fun x => h (f x) (g x)) with (fun x => h (fst (f x, g x)) (snd (f x, g x))). apply: filterlim_comp Ch. now apply filterlim_pair. Qed. Lemma filterlimi_comp_2 : forall {T U V W F G H I} {FF : Filter F}, forall (f : T -> U) (g : T -> V) (h : U -> V -> W -> Prop), filterlim f F G -> filterlim g F H -> filterlimi (fun x => h (fst x) (snd x)) (filter_prod G H) I -> filterlimi (fun x => h (f x) (g x)) F I. Proof. intros T U V W F G H I FF f g h Cf Cg Ch. change (fun x => h (f x) (g x)) with (fun x => h (fst (f x, g x)) (snd (f x, g x))). apply: filterlimi_comp Ch. now apply filterlim_pair. Qed. Lemma prod_filtermap_le {T1 T2 U1 U2 F G} {FF : Filter F} {FG : Filter G} (f1 : T1 -> U1) (f2 : T2 -> U2) : filter_le (filter_prod (filtermap f1 F) (filtermap f2 G)) (filtermap (fun x => (f1 (fst x), f2 (snd x))) (filter_prod F G)). Proof. intros P [Q1 Q2 H1 H2 H]. unfold filtermap. split with (fun y => exists x, Q1 x /\ f1 x = y) (fun y => exists x, Q2 x /\ f2 x = y). - apply: filter_imp H1. intros x Qx. now exists x. - apply: filter_imp H2. intros x Qx. now exists x. intros y1 y2 [x1 [Qx1 <-]] [x2 [Qx2 <-]]. now apply H. Qed. Lemma filtermap_prod_le {T1 T2 U1 U2 F G} {FF : Filter F} {FG : Filter G} (f1 : T1 -> U1) (f2 : T2 -> U2) : filter_le (filtermap (fun x => (f1 (fst x), f2 (snd x))) (filter_prod F G)) (filter_prod (filtermap f1 F) (filtermap f2 G)). Proof. intros P [Q1 Q2 H1 H2 H]. unfold filtermap. split with (fun x => Q1 (f1 x)) (fun x => Q2 (f2 x)). now apply: filter_imp H1. now apply: filter_imp H2. intros x1 x2 Qx1 Qx2. now apply H. Qed. Lemma filterlim_prod {E} {T} {U} {F : (T -> Prop) -> Prop} {FF : Filter F} (g : E -> U -> U -> Prop) (f : T -> U) : filterlim (fun x => (f (fst x), f (snd x))) (filter_prod F F) (fun P => exists e, forall u v, g e u v -> P (u, v)) <-> (forall e, exists P, F P /\ forall u v : T, P u -> P v -> g e (f u) (f v)). Proof. split. - intros H e. destruct (H (fun '(u, v) => g e u v)) as [P Q HP HQ H']. now exists e. exists (fun x => P x /\ Q x). split. now apply filter_and. intros u v Hu Hv. now apply H'. - intros H P [e He]. destruct (H e) as [Q [H1 H2]]. clear H. unfold filtermap. split with Q Q ; try easy. intros x y Hx Hy. now apply He, H2. Qed. (** Restriction of a filter to a domain *) Definition within {T : Type} D (F : (T -> Prop) -> Prop) (P : T -> Prop) := F (fun x => D x -> P x). Global Instance within_filter : forall T D F, Filter F -> Filter (@within T D F). Proof. intros T D F FF. unfold within. constructor. - now apply filter_forall. - intros P Q WP WQ. apply filter_imp with (fun x => (D x -> P x) /\ (D x -> Q x)). intros x [HP HQ] HD. split. now apply HP. now apply HQ. now apply filter_and. - intros P Q H FP. apply filter_imp with (fun x => (D x -> P x) /\ (P x -> Q x)). intros x [H1 H2] HD. apply H2, H1, HD. apply filter_and. exact FP. now apply filter_forall. Qed. Lemma filter_le_within : forall {T} {F : (T -> Prop) -> Prop} {FF : Filter F} D, filter_le (within D F) F. Proof. intros T F D P HP. unfold within. now apply filter_imp. Qed. Lemma filterlim_within_ext : forall {T U F G} {FF : Filter F} D (f g : T -> U), (forall x, D x -> f x = g x) -> filterlim f (within D F) G -> filterlim g (within D F) G. Proof. intros T U F G FF D f g Efg. apply filterlim_ext_loc. unfold within. now apply filter_forall. Qed. Definition subset_filter {T} (F : (T -> Prop) -> Prop) (dom : T -> Prop) (P : {x|dom x} -> Prop) : Prop := F (fun x => forall H : dom x, P (exist _ x H)). Global Instance subset_filter_filter : forall T F (dom : T -> Prop), Filter F -> Filter (subset_filter F dom). Proof. intros T F dom FF. constructor ; unfold subset_filter. - now apply filter_imp with (2 := filter_true). - intros P Q HP HQ. generalize (filter_and _ _ HP HQ). apply filter_imp. intros x [H1 H2] H. now split. - intros P Q H. apply filter_imp. intros x H' H0. now apply H. Qed. Lemma subset_filter_proper' : forall {T F} {FF : Filter F} (dom : T -> Prop), (forall P, F P -> ~ ~ exists x, dom x /\ P x) -> ProperFilter' (subset_filter F dom). Proof. intros T F FF dom. constructor. 2: now apply subset_filter_filter. intro H1. unfold subset_filter in H1. specialize (H (fun x : T => dom x -> False)). apply H in H1. apply H1. clear H ; clear H1. intro H2. destruct H2 as (x, Hx). destruct Hx as (Hx1, Hx2) ; now apply Hx2. Qed. Lemma subset_filter_proper : forall {T F} {FF : Filter F} (dom : T -> Prop), (forall P, F P -> exists x, dom x /\ P x) -> ProperFilter (subset_filter F dom). Proof. intros T F dom FF H. constructor. - unfold subset_filter. intros P HP. destruct (H _ HP) as [x [H1 H2]]. exists (exist _ x H1). now apply H2. - now apply subset_filter_filter. Qed. (** * Algebraic spaces *) (** ** Abelian monoids *) Module AbelianMonoid. Record mixin_of (G : Type) := Mixin { plus : G -> G -> G ; zero : G ; ax1 : forall x y, plus x y = plus y x ; ax2 : forall x y z, plus x (plus y z) = plus (plus x y) z ; ax3 : forall x, plus x zero = x ; }. Notation class_of := mixin_of (only parsing). Section ClassDef. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Definition class (cT : type) := let: Pack _ c _ := cT return class_of cT in c. End ClassDef. Module Exports. Coercion sort : type >-> Sortclass. Notation AbelianMonoid := type. End Exports. End AbelianMonoid. Export AbelianMonoid.Exports. (** Arithmetic operations *) Section AbelianMonoid1. Context {G : AbelianMonoid}. Definition zero := AbelianMonoid.zero _ (AbelianMonoid.class G). Definition plus := AbelianMonoid.plus _ (AbelianMonoid.class G). Lemma plus_comm : forall x y : G, plus x y = plus y x. Proof. apply AbelianMonoid.ax1. Qed. Lemma plus_assoc : forall x y z : G, plus x (plus y z) = plus (plus x y) z. Proof. apply AbelianMonoid.ax2. Qed. Lemma plus_zero_r : forall x : G, plus x zero = x. Proof. apply AbelianMonoid.ax3. Qed. Lemma plus_zero_l : forall x : G, plus zero x = x. Proof. intros x. now rewrite plus_comm plus_zero_r. Qed. End AbelianMonoid1. (** Sum *) Section Sums1. Context {G : AbelianMonoid}. Definition sum_n_m (a : nat -> G) n m := iter_nat plus zero a n m. Definition sum_n (a : nat -> G) n := sum_n_m a O n. Lemma sum_n_m_Chasles (a : nat -> G) (n m k : nat) : (n <= S m)%nat -> (m <= k)%nat -> sum_n_m a n k = plus (sum_n_m a n m) (sum_n_m a (S m) k). Proof. intros Hnm Hmk. apply iter_nat_Chasles. by apply plus_zero_l. by apply plus_assoc. by []. by []. Qed. Lemma sum_n_n (a : nat -> G) (n : nat) : sum_n_m a n n = a n. Proof. apply iter_nat_point. by apply plus_zero_r. Qed. Lemma sum_O (a : nat -> G) : sum_n a 0 = a O. Proof. by apply sum_n_n. Qed. Lemma sum_n_Sm (a : nat -> G) (n m : nat) : (n <= S m)%nat -> sum_n_m a n (S m) = plus (sum_n_m a n m) (a (S m)). Proof. intros Hnmk. rewrite (sum_n_m_Chasles _ _ m). by rewrite sum_n_n. by []. by apply Nat.le_succ_diag_r. Qed. Lemma sum_Sn_m (a : nat -> G) (n m : nat) : (n <= m)%nat -> sum_n_m a n m = plus (a n) (sum_n_m a (S n) m). Proof. intros Hnmk. rewrite (sum_n_m_Chasles _ _ n). by rewrite sum_n_n. by apply Nat.le_succ_diag_r. by []. Qed. Lemma sum_n_m_S (a : nat -> G) (n m : nat) : sum_n_m (fun n => a (S n)) n m = sum_n_m a (S n) (S m). Proof. apply iter_nat_S. Qed. Lemma sum_Sn (a : nat -> G) (n : nat) : sum_n a (S n) = plus (sum_n a n) (a (S n)). Proof. apply sum_n_Sm. by apply Nat.le_0_l. Qed. Lemma sum_n_m_zero (a : nat -> G) (n m : nat) : (m < n)%nat -> sum_n_m a n m = zero. Proof. intros Hnm. rewrite /sum_n_m. elim: n m a Hnm => [ | n IH] m a Hnm. by apply Nat.nlt_0_r in Hnm. case: m Hnm => [|m] Hnm //. rewrite -iter_nat_S. apply IH. by apply Nat.succ_lt_mono. Qed. Lemma sum_n_m_const_zero (n m : nat) : sum_n_m (fun _ => zero) n m = zero. Proof. rewrite /sum_n_m /iter_nat. elim: (seq.iota n (S m - n)) => //= h t ->. by apply plus_zero_l. Qed. Lemma sum_n_m_ext_loc (a b : nat -> G) (n m : nat) : (forall k, (n <= k <= m)%nat -> a k = b k) -> sum_n_m a n m = sum_n_m b n m. Proof. intros. by apply iter_nat_ext_loc. Qed. Lemma sum_n_m_ext (a b : nat -> G) n m : (forall n, a n = b n) -> sum_n_m a n m = sum_n_m b n m. Proof. intros H. by apply sum_n_m_ext_loc. Qed. Lemma sum_n_ext_loc : forall (a b : nat -> G) N, (forall n, (n <= N)%nat -> a n = b n) -> sum_n a N = sum_n b N. Proof. intros a b N H. apply sum_n_m_ext_loc => k [ _ Hk]. by apply H. Qed. Lemma sum_n_ext : forall (a b : nat -> G) N, (forall n, a n = b n) -> sum_n a N = sum_n b N. Proof. intros a b N H. by apply sum_n_ext_loc. Qed. Lemma sum_n_m_plus : forall (u v : nat -> G) (n m : nat), sum_n_m (fun k => plus (u k) (v k)) n m = plus (sum_n_m u n m) (sum_n_m v n m). Proof. intros u v n m. case: (le_dec n m) => Hnm. elim: m n u v Hnm => [ | m IH] ; case => [ | n] u v Hnm. by rewrite !sum_n_n. by apply Nat.nle_succ_0 in Hnm. rewrite !sum_n_Sm ; try by apply Nat.le_0_l. rewrite IH. rewrite -2!plus_assoc. apply f_equal. rewrite plus_comm -plus_assoc. apply f_equal, plus_comm. by apply Nat.le_0_l. rewrite /sum_n_m -!iter_nat_S -!/(sum_n_m _ n m). apply IH. by apply le_S_n. apply not_le in Hnm. rewrite !sum_n_m_zero //. by rewrite plus_zero_l. Qed. Lemma sum_n_plus : forall (u v : nat -> G) (n : nat), sum_n (fun k => plus (u k) (v k)) n = plus (sum_n u n) (sum_n v n). Proof. intros u v n. apply sum_n_m_plus. Qed. Lemma sum_n_switch : forall (u : nat -> nat -> G) (m n : nat), sum_n (fun i => sum_n (u i) n) m = sum_n (fun j => sum_n (fun i => u i j) m) n. Proof. intros u. rewrite /sum_n. induction m ; simpl ; intros n. rewrite sum_n_n. apply iter_nat_ext_loc => k Hk. rewrite sum_n_n. by []. rewrite !sum_n_Sm. rewrite IHm ; clear IHm. rewrite -sum_n_m_plus. apply sum_n_m_ext_loc => k Hk. rewrite sum_n_Sm //. by apply Nat.le_0_l. by apply Nat.le_0_l. Qed. End Sums1. (** ** Abelian groups *) Module AbelianGroup. Record mixin_of (G : AbelianMonoid) := Mixin { opp : G -> G ; ax1 : forall x, plus x (opp x) = zero }. Section ClassDef. Record class_of (G : Type) := Class { base : AbelianMonoid.class_of G ; mixin : mixin_of (AbelianMonoid.Pack _ base G) }. Local Coercion base : class_of >-> AbelianMonoid.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> AbelianMonoid.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Notation AbelianGroup := type. End Exports. End AbelianGroup. Export AbelianGroup.Exports. (** Arithmetic operations *) Section AbelianGroup1. Context {G : AbelianGroup}. Definition opp := AbelianGroup.opp _ (AbelianGroup.class G). Definition minus x y := (plus x (opp y)). Lemma plus_opp_r : forall x : G, plus x (opp x) = zero. Proof. apply AbelianGroup.ax1. Qed. Lemma plus_opp_l : forall x : G, plus (opp x) x = zero. Proof. intros x. rewrite plus_comm. apply plus_opp_r. Qed. Lemma opp_zero : opp zero = zero. Proof. rewrite <- (plus_zero_r (opp zero)). apply plus_opp_l. Qed. Lemma minus_zero_r : forall x : G, minus x zero = x. Proof. intros x. unfold minus. rewrite opp_zero. apply plus_zero_r. Qed. Lemma minus_eq_zero (x : G) : minus x x = zero. Proof. apply plus_opp_r. Qed. Lemma plus_reg_l : forall r x y : G, plus r x = plus r y -> x = y. Proof. intros r x y H. rewrite -(plus_zero_l x) -(plus_opp_l r) -plus_assoc. rewrite H. now rewrite plus_assoc plus_opp_l plus_zero_l. Qed. Lemma plus_reg_r : forall r x y : G, plus x r = plus y r -> x = y. Proof. intros z x y. rewrite !(plus_comm _ z). by apply plus_reg_l. Qed. Lemma opp_opp : forall x : G, opp (opp x) = x. Proof. intros x. apply plus_reg_r with (opp x). rewrite plus_opp_r. apply plus_opp_l. Qed. Lemma opp_plus : forall x y : G, opp (plus x y) = plus (opp x) (opp y). Proof. intros x y. apply plus_reg_r with (plus x y). rewrite plus_opp_l. rewrite plus_assoc. rewrite (plus_comm (opp x)). rewrite <- (plus_assoc (opp y)). rewrite plus_opp_l. rewrite plus_zero_r. apply sym_eq, plus_opp_l. Qed. Lemma opp_minus (x y : G) : opp (minus x y) = minus y x. Proof. rewrite /minus opp_plus opp_opp. by apply plus_comm. Qed. Lemma minus_trans (r x y : G) : minus x y = plus (minus x r) (minus r y). Proof. rewrite /minus -!plus_assoc. apply f_equal. by rewrite plus_assoc plus_opp_l plus_zero_l. Qed. End AbelianGroup1. (** Sum *) Section Sums2. Context {G : AbelianGroup}. Lemma sum_n_m_sum_n (a:nat -> G) (n m : nat) : (n <= m)%nat -> sum_n_m a (S n) m = minus (sum_n a m) (sum_n a n). Proof. intros Hnm. apply plus_reg_l with (sum_n a n). rewrite (plus_comm _ (minus _ _)) /minus -plus_assoc plus_opp_l plus_zero_r. rewrite /sum_n /sum_n_m. apply sym_eq, sum_n_m_Chasles. by apply Nat.le_0_l. by []. Qed. End Sums2. (** ** Noncommutative rings *) Module Ring. Record mixin_of (K : AbelianGroup) := Mixin { mult : K -> K -> K ; one : K ; ax1 : forall x y z, mult x (mult y z) = mult (mult x y) z ; ax2 : forall x, mult x one = x ; ax3 : forall x, mult one x = x ; ax4 : forall x y z, mult (plus x y) z = plus (mult x z) (mult y z) ; ax5 : forall x y z, mult x (plus y z) = plus (mult x y) (mult x z) }. Section ClassDef. Record class_of (K : Type) := Class { base : AbelianGroup.class_of K ; mixin : mixin_of (AbelianGroup.Pack _ base K) }. Local Coercion base : class_of >-> AbelianGroup.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. Definition AbelianGroup := AbelianGroup.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> AbelianGroup.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Coercion AbelianGroup : type >-> AbelianGroup.type. Canonical AbelianGroup. Notation Ring := type. End Exports. End Ring. Export Ring.Exports. (** Arithmetic operations *) Section Ring1. Context {K : Ring}. Definition mult : K -> K -> K := Ring.mult _ (Ring.class K). Definition one : K := Ring.one _ (Ring.class K). Lemma mult_assoc : forall x y z : K, mult x (mult y z) = mult (mult x y) z. Proof. apply Ring.ax1. Qed. Lemma mult_one_r : forall x : K, mult x one = x. Proof. apply Ring.ax2. Qed. Lemma mult_one_l : forall x : K, mult one x = x. Proof. apply Ring.ax3. Qed. Lemma mult_distr_r : forall x y z : K, mult (plus x y) z = plus (mult x z) (mult y z). Proof. apply: Ring.ax4. Qed. Lemma mult_distr_l : forall x y z : K, mult x (plus y z) = plus (mult x y) (mult x z). Proof. apply: Ring.ax5. Qed. Lemma mult_zero_r : forall x : K, mult x zero = zero. Proof. intros x. apply plus_reg_r with (mult x zero). rewrite <- mult_distr_l. rewrite plus_zero_r. now rewrite plus_zero_l. Qed. Lemma mult_zero_l : forall x : K, mult zero x = zero. Proof. intros x. apply plus_reg_r with (mult zero x). rewrite <- mult_distr_r. rewrite plus_zero_r. now rewrite plus_zero_l. Qed. Lemma opp_mult_r : forall x y : K, opp (mult x y) = mult x (opp y). Proof. intros x y. apply plus_reg_l with (mult x y). rewrite plus_opp_r -mult_distr_l. now rewrite plus_opp_r mult_zero_r. Qed. Lemma opp_mult_l : forall x y : K, opp (mult x y) = mult (opp x) y. Proof. intros x y. apply plus_reg_l with (mult x y). rewrite plus_opp_r -mult_distr_r. now rewrite plus_opp_r mult_zero_l. Qed. Lemma opp_mult_m1 : forall x : K, opp x = mult (opp one) x. Proof. intros x. rewrite -opp_mult_l opp_mult_r. by rewrite mult_one_l. Qed. Lemma sum_n_m_mult_r : forall (a : K) (u : nat -> K) (n m : nat), sum_n_m (fun k => mult (u k) a) n m = mult (sum_n_m u n m) a. Proof. intros a u n m. case: (le_dec n m) => Hnm. elim: m n u Hnm => [ | m IH] n u Hnm. apply Nat.le_0_r in Hnm. by rewrite -Hnm !sum_n_n. destruct n. rewrite !sum_n_Sm ; try by apply Nat.le_0_l. rewrite IH. by apply sym_eq, mult_distr_r. by apply Nat.le_0_l. rewrite -!sum_n_m_S. apply IH. by apply le_S_n. apply not_le in Hnm. rewrite !sum_n_m_zero //. by rewrite mult_zero_l. Qed. Lemma sum_n_m_mult_l : forall (a : K) (u : nat -> K) (n m : nat), sum_n_m (fun k => mult a (u k)) n m = mult a (sum_n_m u n m). Proof. intros a u n m. case: (le_dec n m) => Hnm. elim: m n u Hnm => [ | m IH] n u Hnm. apply Nat.le_0_r in Hnm. by rewrite -Hnm !sum_n_n. destruct n. rewrite !sum_n_Sm ; try by apply Nat.le_0_l. rewrite IH. by apply sym_eq, mult_distr_l. by apply Nat.le_0_l. rewrite -!sum_n_m_S. apply IH. by apply le_S_n. apply not_le in Hnm. rewrite !sum_n_m_zero //. by rewrite mult_zero_r. Qed. Lemma sum_n_mult_r : forall (a : K) (u : nat -> K) (n : nat), sum_n (fun k => mult (u k) a) n = mult (sum_n u n) a. Proof. intros ; by apply sum_n_m_mult_r. Qed. Lemma sum_n_mult_l : forall (a : K) (u : nat -> K) (n : nat), sum_n (fun k => mult a (u k)) n = mult a (sum_n u n). Proof. intros ; by apply sum_n_m_mult_l. Qed. (** pow_n *) Fixpoint pow_n (x : K) (N : nat) {struct N} : K := match N with | 0%nat => one | S i => mult x (pow_n x i) end. Lemma pow_n_plus : forall (x : K) (n m : nat), pow_n x (n+m) = mult (pow_n x n) (pow_n x m). Proof. intros x. elim => /= [ | n IH] m. by rewrite mult_one_l. by rewrite IH mult_assoc. Qed. Lemma pow_n_comm_1 : forall (x : K) (n : nat), mult (pow_n x n) x = mult x (pow_n x n). Proof. intros x n. elim: n => /= [ | n IH]. by rewrite mult_one_l mult_one_r. by rewrite -(mult_assoc _ (pow_n x n)) IH. Qed. Lemma pow_n_comm : forall (x : K) n m, mult (pow_n x n) (pow_n x m) = mult (pow_n x m) (pow_n x n). Proof. intros x n m. rewrite -2!pow_n_plus. by apply f_equal, Nat.add_comm. Qed. End Ring1. (** ** Rings with absolute value *) Module AbsRing. Record mixin_of (K : Ring) := Mixin { abs : K -> R ; ax1 : abs zero = 0 ; ax2 : abs (opp one) = 1 ; ax3 : forall x y : K, abs (plus x y) <= abs x + abs y ; ax4 : forall x y : K, abs (mult x y) <= abs x * abs y ; ax5 : forall x : K, abs x = 0 -> x = zero }. Section ClassDef. Record class_of (K : Type) := Class { base : Ring.class_of K ; mixin : mixin_of (Ring.Pack _ base K) }. Local Coercion base : class_of >-> Ring.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. Definition AbelianGroup := AbelianGroup.Pack cT xclass xT. Definition Ring := Ring.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> Ring.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Coercion AbelianGroup : type >-> AbelianGroup.type. Canonical AbelianGroup. Coercion Ring : type >-> Ring.type. Canonical Ring. Notation AbsRing := type. End Exports. End AbsRing. Export AbsRing.Exports. (** Usual properties *) Section AbsRing1. Context {K : AbsRing}. Definition abs : K -> R := AbsRing.abs _ (AbsRing.class K). Lemma abs_zero : abs zero = 0. Proof. apply AbsRing.ax1. Qed. Lemma abs_opp_one : abs (opp one) = 1. Proof. apply AbsRing.ax2. Qed. Lemma abs_triangle : forall x y : K, abs (plus x y) <= abs x + abs y. Proof. apply: AbsRing.ax3. Qed. Lemma abs_mult : forall x y : K, abs (mult x y) <= abs x * abs y. Proof. apply AbsRing.ax4. Qed. Lemma abs_eq_zero : forall x : K, abs x = 0 -> x = zero. Proof. apply AbsRing.ax5. Qed. Lemma abs_opp : forall x, abs (opp x) = abs x. Proof. intros x. apply Rle_antisym. - rewrite opp_mult_m1. rewrite -(Rmult_1_l (abs x)) -abs_opp_one. apply abs_mult. - rewrite -{1}[x]opp_opp. rewrite opp_mult_m1. rewrite -(Rmult_1_l (abs (opp x))) -abs_opp_one. apply abs_mult. Qed. Lemma abs_minus : forall x y : K, abs (minus x y) = abs (minus y x). Proof. intros x y. by rewrite /minus -abs_opp opp_plus opp_opp plus_comm. Qed. Lemma abs_one : abs one = 1. Proof. rewrite -abs_opp. exact abs_opp_one. Qed. Lemma abs_ge_0 : forall x, 0 <= abs x. Proof. intros x. apply Rmult_le_reg_l with 2. by apply Rlt_0_2. rewrite Rmult_0_r -abs_zero -(plus_opp_l x). apply Rle_trans with (1 := abs_triangle _ _). rewrite abs_opp. apply Req_le ; ring. Qed. Lemma abs_gt_0 : forall x : K, x <> zero -> 0 < abs x. Proof. intros x Hx. apply Rnot_le_lt. contradict Hx. apply abs_eq_zero. apply Rle_antisym with (1 := Hx). apply abs_ge_0. Qed. Lemma abs_minus_gt_0 : forall x y : K, x <> y -> 0 < abs (minus x y). Proof. intros x y Hxy. apply abs_gt_0. contradict Hxy. apply plus_reg_r with (opp y). now rewrite plus_opp_r. Qed. Lemma abs_pow_n : forall (x : K) n, abs (pow_n x n) <= (abs x)^n. Proof. induction n. apply Req_le, abs_one. simpl. apply: Rle_trans (abs_mult _ _) _. apply Rmult_le_compat_l with (2 := IHn). apply abs_ge_0. Qed. End AbsRing1. (** * Uniform spaces defined using balls *) Module UniformSpace. Record mixin_of (M : Type) := Mixin { point_of : M ; ball : M -> R -> M -> Prop ; ax1 : forall x (e : posreal), ball x e x ; ax2 : forall x y e, ball x e y -> ball y e x ; ax3 : forall x y z e1 e2, ball x e1 y -> ball y e2 z -> ball x (e1 + e2) z }. Notation class_of := mixin_of (only parsing). Section ClassDef. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Definition class (cT : type) := let: Pack _ c _ := cT return class_of cT in c. End ClassDef. Module Exports. Coercion sort : type >-> Sortclass. Notation UniformSpace := type. End Exports. End UniformSpace. Export UniformSpace.Exports. Section UniformSpace1. Context {M : UniformSpace}. Definition point_of := UniformSpace.point_of _ (UniformSpace.class M). Definition ball := UniformSpace.ball _ (UniformSpace.class M). Lemma ball_center : forall (x : M) (e : posreal), ball x e x. Proof. apply UniformSpace.ax1. Qed. Lemma ball_sym : forall (x y : M) (e : R), ball x e y -> ball y e x. Proof. apply UniformSpace.ax2. Qed. Lemma ball_triangle : forall (x y z : M) (e1 e2 : R), ball x e1 y -> ball y e2 z -> ball x (e1 + e2) z. Proof. apply UniformSpace.ax3. Qed. Lemma ball_le : forall (x : M) (e1 e2 : R), e1 <= e2 -> forall (y : M), ball x e1 y -> ball x e2 y. Proof. intros x e1 e2 H y H1. destruct H. assert (e2 - e1 > 0). by apply Rgt_minus. assert (ball y {| pos := (e2-e1); cond_pos := (H0) |} y). apply ball_center. replace e2 with (e1 + (e2 - e1)). apply ball_triangle with y ; assumption. by apply Rplus_minus. by rewrite <- H. Qed. Definition close (x y : M) : Prop := forall eps : posreal, ball x eps y. Lemma close_refl (x : M) : close x x. Proof. intros eps. apply ball_center. Qed. Lemma close_sym (x y : M) : close x y -> close y x. Proof. intros H eps. now apply ball_sym. Qed. Lemma close_trans (x y z : M) : close x y -> close y z -> close x z. Proof. intros H1 H2 eps. rewrite (double_var eps) -[eps / 2]/(pos (pos_div_2 eps)). now eapply ball_triangle. Qed. End UniformSpace1. (** ** Specific uniform spaces *) (** Rings with absolute value *) Section AbsRing_UniformSpace. Variable K : AbsRing. Definition AbsRing_ball (x : K) (eps : R) (y : K) := abs (minus y x) < eps. Lemma AbsRing_ball_center : forall (x : K) (e : posreal), AbsRing_ball x e x. Proof. intros x e. rewrite /AbsRing_ball /minus plus_opp_r abs_zero. apply cond_pos. Qed. Lemma AbsRing_ball_sym : forall (x y : K) (e : R), AbsRing_ball x e y -> AbsRing_ball y e x. Proof. intros x y e. by rewrite /AbsRing_ball abs_minus. Qed. Lemma AbsRing_ball_triangle : forall (x y z : K) (e1 e2 : R), AbsRing_ball x e1 y -> AbsRing_ball y e2 z -> AbsRing_ball x (e1 + e2) z. Proof. intros x y z e1 e2 H1 H2. unfold AbsRing_ball. replace (minus z x) with (plus (minus y x) (minus z y)). apply: Rle_lt_trans (abs_triangle _ _) _. now apply Rplus_lt_compat. rewrite plus_comm /minus plus_assoc. apply (f_equal (fun y => plus y _)). rewrite <- plus_assoc. now rewrite plus_opp_l plus_zero_r. Qed. Definition AbsRing_UniformSpace_mixin := UniformSpace.Mixin _ zero _ AbsRing_ball_center AbsRing_ball_sym AbsRing_ball_triangle. Canonical AbsRing_UniformSpace := UniformSpace.Pack K AbsRing_UniformSpace_mixin K. End AbsRing_UniformSpace. (** Functional metric spaces *) Section fct_UniformSpace. Variable (T : Type) (U : UniformSpace). Definition fct_ball (x : T -> U) (eps : R) (y : T -> U) := forall t : T, ball (x t) eps (y t). Lemma fct_ball_center : forall (x : T -> U) (e : posreal), fct_ball x e x. Proof. intros x e t. exact: ball_center. Qed. Lemma fct_ball_sym : forall (x y : T -> U) (e : R), fct_ball x e y -> fct_ball y e x. Proof. intros x y e H t. exact: ball_sym. Qed. Lemma fct_ball_triangle : forall (x y z : T -> U) (e1 e2 : R), fct_ball x e1 y -> fct_ball y e2 z -> fct_ball x (e1 + e2) z. Proof. intros x y z e1 e2 H1 H2 t. now apply ball_triangle with (y t). Qed. Definition fct_UniformSpace_mixin := UniformSpace.Mixin _ (fun _ => point_of) _ fct_ball_center fct_ball_sym fct_ball_triangle. Canonical fct_UniformSpace := UniformSpace.Pack (T -> U) fct_UniformSpace_mixin (T -> U). End fct_UniformSpace. (** ** Local predicates *) (** locally_dist *) Definition locally_dist {T : Type} (d : T -> R) (P : T -> Prop) := exists delta : posreal, forall y, d y < delta -> P y. Global Instance locally_dist_filter : forall T (d : T -> R), Filter (locally_dist d). Proof. intros T d. constructor. - now exists (mkposreal _ Rlt_0_1). - intros P Q [dP HP] [dQ HQ]. exists (mkposreal _ (Rmin_stable_in_posreal dP dQ)). simpl. intros y Hy. split. apply HP. apply Rlt_le_trans with (1 := Hy). apply Rmin_l. apply HQ. apply Rlt_le_trans with (1 := Hy). apply Rmin_r. - intros P Q H [dP HP]. exists dP. intros y Hy. apply H. now apply HP. Qed. (** locally *) Section Locally. Context {T : UniformSpace}. Definition locally (x : T) (P : T -> Prop) := exists eps : posreal, forall y, ball x eps y -> P y. Global Instance locally_filter : forall x : T, ProperFilter (locally x). Proof. intros x. constructor ; [idtac|constructor]. - intros P [eps H]. exists x. apply H. apply ball_center. - now exists (mkposreal _ Rlt_0_1). - intros P Q [dP HP] [dQ HQ]. exists (mkposreal _ (Rmin_stable_in_posreal dP dQ)). simpl. intros y Hy. split. apply HP. apply ball_le with (2 := Hy). apply Rmin_l. apply HQ. apply ball_le with (2 := Hy). apply Rmin_r. - intros P Q H [dP HP]. exists dP. intros y Hy. apply H. now apply HP. Qed. Lemma locally_locally : forall (x : T) (P : T -> Prop), locally x P -> locally x (fun y => locally y P). Proof. intros x P [dp Hp]. exists (pos_div_2 dp). intros y Hy. exists (pos_div_2 dp) => /= z Hz. apply Hp. rewrite (double_var dp). now apply ball_triangle with y. Qed. Lemma locally_singleton : forall (x : T) (P : T -> Prop), locally x P -> P x. Proof. intros x P [dp H]. apply H. by apply ball_center. Qed. Lemma locally_ball : forall (x : T) (eps : posreal), locally x (ball x eps). Proof. intros x eps. now exists eps. Qed. Lemma locally_not' : forall (x : T) (P : T -> Prop), not (forall eps : posreal, not (forall y, ball x eps y -> not (P y))) -> {d : posreal | forall y, ball x d y -> not (P y)}. Proof. intros x P H. set (Q := fun z => z <= 1 /\ forall y, ball x z y -> not (P y)). destruct (completeness Q) as [d [H1 H2]]. - exists 1. now intros y [Hy _]. - exists 0. split. apply Rle_0_1. intros y Hy Py. apply H. intros eps He. apply He with (2 := Py). apply ball_le with (2 := Hy). apply Rlt_le, eps. assert (Zd : 0 < d). apply Rnot_le_lt. intros Hd. apply H. intros eps He. apply (Rlt_irrefl (Rmin 1 eps)). apply Rle_lt_trans with d. apply H1. split. apply Rmin_l. intros y By. apply He. apply ball_le with (2 := By). apply Rmin_r. apply Rle_lt_trans with (1 := Hd). apply Rmin_case. apply Rlt_0_1. apply cond_pos. exists (mkposreal _ (is_pos_div_2 (mkposreal _ Zd))). simpl. intros y Hy HP. apply (Rlt_not_le _ _ (Rlt_eps2_eps _ Zd)). apply H2. intros z Hz. apply Rnot_lt_le. contradict HP. apply Hz. apply ball_le with (2 := Hy). now apply Rlt_le. Qed. Lemma locally_not : forall (x : T) (P : T -> Prop), not (forall eps : posreal, not (forall y, ball x eps y -> not (P y))) -> locally x (fun y => not (P y)). Proof. intros x P H. destruct (locally_not' x P H) as [eps He]. now exists eps. Qed. Lemma locally_ex_not : forall (x : T) (P : T -> Prop), locally x (fun y => not (P y)) -> {d : posreal | forall y, ball x d y -> not (P y)}. Proof. intros x P H. apply locally_not'. destruct H as [eps He]. intros H. now apply (H eps). Qed. Lemma locally_ex_dec : forall (x : T) (P : T -> Prop), (forall x, P x \/ ~P x) -> locally x P -> {d : posreal | forall y, ball x d y -> P y}. Proof. intros x P P_dec H. destruct (locally_ex_not x (fun y => not (P y))) as [d Hd]. apply: filter_imp H. intros y Py HP. now apply HP. exists d. intros y Hy. destruct (P_dec y) as [HP|HP]. exact HP. exfalso. now apply (Hd y). Qed. Definition is_filter_lim (F : (T -> Prop) -> Prop) (x : T) := forall P, locally x P -> F P. Lemma is_filter_lim_filter_le : forall {F G} (x : T), filter_le G F -> is_filter_lim F x -> is_filter_lim G x. Proof. intros F G x L Fx P HP. apply L. now apply Fx. Qed. Lemma is_filter_lim_close {F} {FF : ProperFilter F} (x y : T) : is_filter_lim F x -> is_filter_lim F y -> close x y. Proof. intros Hx Hy eps. specialize (Hy _ (locally_ball y (pos_div_2 eps))). specialize (Hx _ (locally_ball x (pos_div_2 eps))). generalize (filter_and _ _ Hx Hy) => {Hx Hy} H. destruct (filter_ex _ H) as [z Hz]. rewrite (double_var eps). apply ball_triangle with z. apply Hz. apply ball_sym, Hz. Qed. Lemma is_filter_lim_locally_close (x y : T) : is_filter_lim (locally x) y -> close x y. Proof. by apply is_filter_lim_close. Qed. End Locally. Lemma filterlim_const : forall {T} {U : UniformSpace} {F : (T -> Prop) -> Prop} {FF : Filter F}, forall a : U, filterlim (fun _ => a) F (locally a). Proof. intros T U F FF a P [eps HP]. unfold filtermap. apply filter_forall. intros _. apply HP. apply ball_center. Qed. Section Locally_fct. Context {T : Type} {U : UniformSpace}. Lemma filterlim_locally : forall {F} {FF : Filter F} (f : T -> U) y, filterlim f F (locally y) <-> forall eps : posreal, F (fun x => ball y eps (f x)). Proof. intros F FF f y. split. - intros Cf eps. apply (Cf (fun x => ball y eps x)). now exists eps. - intros Cf P [eps He]. apply: filter_imp (Cf eps). intros t. apply He. Qed. Lemma filterlimi_locally : forall {F} {FF : Filter F} (f : T -> U -> Prop) y, filterlimi f F (locally y) <-> forall eps : posreal, F (fun x => exists z, f x z /\ ball y eps z). Proof. intros F FF f y. split. - intros Cf eps. apply (Cf (fun x => ball y eps x)). now exists eps. - intros Cf P [eps He]. unfold filtermapi. apply: filter_imp (Cf eps). intros t [z [Hz1 Hz2]]. exists z. apply (conj Hz1). now apply He. Qed. Lemma filterlim_locally_close : forall {F} {FF: ProperFilter F} (f : T -> U) l l', filterlim f F (locally l) -> filterlim f F (locally l') -> close l l'. Proof. intros F FF f l l' Hl Hl' eps. assert (locally l (ball l (pos_div_2 eps))). by apply locally_ball. specialize (Hl (ball l (pos_div_2 eps)) H). assert (locally l' (ball l' (pos_div_2 eps))). by apply locally_ball. specialize (Hl' (ball l' (pos_div_2 eps)) H0). unfold filtermap in Hl, Hl'. generalize (filter_and _ _ Hl Hl') => {H0} H. apply filter_ex in H. case: H => x H. rewrite (double_var eps). apply ball_triangle with (f x). by apply H. by apply ball_sym, H. Qed. Lemma filterlimi_locally_close : forall {F} {FF: ProperFilter F} (f : T -> U -> Prop) l l', F (fun x => forall y1 y2, f x y1 -> f x y2 -> y1 = y2) -> filterlimi f F (locally l) -> filterlimi f F (locally l') -> close l l'. Proof. intros F FF f l l' Hf Hl Hl' eps. assert (H: locally l (ball l (pos_div_2 eps))). by apply locally_ball. specialize (Hl (ball l (pos_div_2 eps)) H). assert (H': locally l' (ball l' (pos_div_2 eps))). by apply locally_ball. specialize (Hl' (ball l' (pos_div_2 eps)) H'). unfold filtermapi in Hl, Hl'. generalize (filter_and _ _ Hf (filter_and _ _ Hl Hl')) => {H' Hl Hl' Hf} H. apply filter_ex in H. destruct H as [x [Hf [[y [H1 H1']] [y' [H2 H2']]]]]. rewrite (double_var eps). apply ball_triangle with y. exact H1'. apply ball_sym. rewrite (Hf _ _ H1 H2). exact H2'. Qed. End Locally_fct. Lemma is_filter_lim_filtermap {T: UniformSpace} {U : UniformSpace} : forall F x (f : T -> U), filterlim f (locally x) (locally (f x)) -> is_filter_lim F x -> is_filter_lim (filtermap f F) (f x). Proof. intros F x f Cf Fx P HP. apply Cf in HP. now apply Fx. Qed. (** locally' *) Definition locally' {T : UniformSpace} (x : T) := within (fun y => y <> x) (locally x). Global Instance locally'_filter : forall {T : UniformSpace} (x : T), Filter (locally' x). Proof. intros T x. apply within_filter. apply locally_filter. Qed. (** closely *) Section closely. Context {T : UniformSpace}. Definition closely (P : T * T -> Prop) := exists eps : posreal, forall u v : T, ball u eps v -> P (u, v). Global Instance closely_filter : ProperFilter closely. Proof. split. { intros P [eps He]. exists (point_of, point_of). apply He. apply ball_center. } split. - now exists (mkposreal _ Rlt_0_1). - intros P Q [eP HP] [eQ HQ]. exists (mkposreal _ (Rmin_stable_in_posreal eP eQ)). intros u v H. split. apply HP. apply ball_le with (2 := H). apply Rmin_l. apply HQ. apply ball_le with (2 := H). apply Rmin_r. - intros P Q H [eps HP]. exists eps. intros u v H'. now apply H, HP. Qed. End closely. Lemma filterlim_closely {T} {U : UniformSpace} {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) : filterlim (fun x => (f (fst x), f (snd x))) (filter_prod F F) closely <-> (forall eps : posreal, exists P, F P /\ forall u v : T, P u -> P v -> ball (f u) eps (f v)). Proof. apply filterlim_prod. Qed. (** Pointed filter *) Section at_point. Context {T : UniformSpace}. Definition at_point (a : T) (P : T -> Prop) : Prop := P a. Global Instance at_point_filter (a : T) : ProperFilter (at_point a). Proof. split. - intros P Pa. now exists a. - split ; try easy. intros P Q PQ Ha. now apply PQ. Qed. End at_point. (** ** Open sets in uniform spaces *) Section Open. Context {T : UniformSpace}. Definition open (D : T -> Prop) := forall x, D x -> locally x D. Lemma locally_open : forall (D E : T -> Prop), open D -> (forall x : T, D x -> E x) -> forall x : T, D x -> locally x E. Proof. intros D E OD H x Dx. apply filter_imp with (1 := H). now apply OD. Qed. Lemma open_ext : forall D E : T -> Prop, (forall x, D x <-> E x) -> open D -> open E. Proof. intros D E H OD x Ex. generalize (OD x (proj2 (H x) Ex)). apply filter_imp. intros y. apply H. Qed. Lemma open_and : forall D E : T -> Prop, open D -> open E -> open (fun x => D x /\ E x). Proof. intros D E OD OE x [Dx Ex]. apply filter_and. now apply OD. now apply OE. Qed. Lemma open_or : forall D E : T -> Prop, open D -> open E -> open (fun x => D x \/ E x). Proof. intros D E OD OE x [Dx|Ex]. generalize (OD x Dx). apply filter_imp. intros y Dy. now left. generalize (OE x Ex). apply filter_imp. intros y Ey. now right. Qed. Lemma open_true : open (fun x : T => True). Proof. intros x _. apply filter_true. Qed. Lemma open_false : open (fun x : T => False). Proof. now intros x Hx. Qed. End Open. Lemma open_comp : forall {T U : UniformSpace} (f : T -> U) (D : U -> Prop), (forall x, D (f x) -> filterlim f (locally x) (locally (f x))) -> open D -> open (fun x : T => D (f x)). Proof. intros T U f D Cf OD x Dfx. apply Cf. exact Dfx. now apply OD. Qed. (** ** Closed sets in uniform spaces *) Section Closed. Context {T : UniformSpace}. Definition closed (D : T -> Prop) := forall x, not (locally x (fun x : T => not (D x))) -> D x. Lemma open_not : forall D : T -> Prop, closed D -> open (fun x => not (D x)). Proof. intros D CD x Dx. apply locally_not. intros H. apply Dx, CD. intros [eps He]. now apply (H eps). Qed. Lemma closed_not : forall D : T -> Prop, open D -> closed (fun x => not (D x)). Proof. intros D OD x Lx Dx. apply Lx. apply: filter_imp (OD _ Dx). intros t Dt nDt. now apply nDt. Qed. Lemma closed_ext : forall D E : T -> Prop, (forall x, D x <-> E x) -> closed D -> closed E. Proof. intros D E DE CD x Hx. apply DE, CD. contradict Hx. apply: filter_imp Hx. move => {} x Dx Ex. now apply Dx, DE. Qed. Lemma closed_and : forall D E : T -> Prop, closed D -> closed E -> closed (fun x => D x /\ E x). Proof. intros D E CD CE x Hx. split. apply CD. contradict Hx. apply: filter_imp Hx. move => {} x nDx [Dx _]. now apply nDx. apply CE. contradict Hx. apply: filter_imp Hx. move => {} x nEx [_ Ex]. now apply nEx. Qed. (* Lemma closed_or : forall D E : T -> Prop, closed D -> closed E -> closed (fun x => D x \/ E x). Proof. intros D E CD CE x Hx. generalize (open_and _ _ CD CE). apply open_ext. clear ; intuition. Qed. *) Lemma closed_true : closed (fun x : T => True). Proof. now intros _ _. Qed. Lemma closed_false : closed (fun x : T => False). Proof. intros x Hx. apply Hx. now apply filter_forall. Qed. End Closed. Lemma closed_comp : forall {T U : UniformSpace} (f : T -> U) (D : U -> Prop), (forall x, filterlim f (locally x) (locally (f x))) -> closed D -> closed (fun x : T => D (f x)). Proof. intros T U f D Cf CD x Dfx. apply CD. contradict Dfx. exact: Cf Dfx. Qed. Lemma closed_filterlim_loc : forall {T} {U : UniformSpace} {F} {FF : ProperFilter' F} (f : T -> U) (D : U -> Prop), forall y, filterlim f F (locally y) -> F (fun x => D (f x)) -> closed D -> D y. Proof. intros T U F FF f D y Ffy Df CD. apply CD. intros LD. apply filter_not_empty. specialize (Ffy _ LD). unfold filtermap in Ffy. apply: filter_imp (filter_and _ _ Df Ffy). intros x Dfx. now apply Dfx. Qed. Lemma closed_filterlim : forall {T} {U : UniformSpace} {F} {FF : ProperFilter' F} (f : T -> U) (D : U -> Prop), forall y, filterlim f F (locally y) -> (forall x, D (f x)) -> closed D -> D y. Proof. intros T U F FF f D y Ffy Df. apply: closed_filterlim_loc Ffy _. now apply filter_forall. Qed. (** ** Complete uniform spaces *) Definition cauchy {T : UniformSpace} (F : (T -> Prop) -> Prop) := forall eps : posreal, exists x, F (ball x eps). Module CompleteSpace. Record mixin_of (T : UniformSpace) := Mixin { lim : ((T -> Prop) -> Prop) -> T ; ax1 : forall F, ProperFilter F -> cauchy F -> forall eps : posreal, F (ball (lim F) eps) ; ax2 : forall F1 F2, filter_le F1 F2 -> filter_le F2 F1 -> close (lim F1) (lim F2) }. Section ClassDef. Record class_of (T : Type) := Class { base : UniformSpace.class_of T ; mixin : mixin_of (UniformSpace.Pack _ base T) }. Local Coercion base : class_of >-> UniformSpace.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition UniformSpace := UniformSpace.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> UniformSpace.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion UniformSpace : type >-> UniformSpace.type. Canonical UniformSpace. Notation CompleteSpace := type. End Exports. End CompleteSpace. Export CompleteSpace.Exports. Section CompleteSpace1. Context {T : CompleteSpace}. Definition lim : ((T -> Prop) -> Prop) -> T := CompleteSpace.lim _ (CompleteSpace.class T). Lemma complete_cauchy : forall F : (T -> Prop) -> Prop, ProperFilter F -> cauchy F -> forall eps : posreal, F (ball (lim F) eps). Proof. apply CompleteSpace.ax1. Qed. Lemma close_lim : forall F1 F2 : (T -> Prop) -> Prop, filter_le F1 F2 -> filter_le F2 F1 -> close (lim F1) (lim F2). Proof. apply CompleteSpace.ax2. Qed. Definition iota (P : T -> Prop) := lim (fun A => (forall x, P x -> A x)). Lemma iota_correct_weak : forall P : T -> Prop, (forall x y, P x -> P y -> close x y) -> forall x, P x -> close (iota P) x. Proof. intros P HP x Hx eps. set (F := fun A : T -> Prop => forall t : T, P t -> A t). assert (forall eps : posreal, F (ball (lim F) eps)) as HF. apply complete_cauchy. constructor. intros Q FQ. exists x. now apply FQ. constructor. now intro x0. intros A B HA HB x0 Hx0. split. now apply HA. now apply HB. intros A B HAB HA x0 Hx0. apply HAB ; now apply HA. intro e. exists x. intros y Hy. now apply HP. assert (F (ball (lim F) eps)) as Heps. apply HF. clear HF. now apply Heps. Qed. Lemma close_iota : forall P Q : T -> Prop, (forall x, P x <-> Q x) -> close (iota P) (iota Q). Proof. intros P Q H. apply close_lim ; intros R HR x Hx ; apply HR, H, Hx. Qed. End CompleteSpace1. Lemma cauchy_distance' : forall {T : UniformSpace} {F} {FF : ProperFilter F}, cauchy F <-> filter_le (filter_prod F F) (@closely T). Proof. intros T F FF. split. - intros H P [eps HP]. case: (H (pos_div_2 eps)) => {H} x Hx. split with (1 := Hx) (2 := Hx). move => u v Hu Hv. apply HP. rewrite (double_var eps). apply ball_triangle with x. by apply ball_sym. exact Hv. - intros H eps. destruct (H (fun '(u,v) => ball u eps v)) as [P Q HP HQ H']. now exists eps. destruct (filter_ex P HP) as [x Hx]. exists x. move: (fun v => H' x v Hx) => {H'} H. now apply filter_imp with (1 := H). Qed. Lemma cauchy_distance : forall {T : UniformSpace} {F} {FF : ProperFilter F}, cauchy F <-> (forall eps : posreal, exists P, F P /\ forall u v : T, P u -> P v -> ball u eps v). Proof. intros T F FF. split. - intros H eps. case: (H (pos_div_2 eps)) => {H} x Hx. exists (ball x (pos_div_2 eps)). split. by []. move => u v Hu Hv. rewrite (double_var eps). apply ball_triangle with x. by apply ball_sym. exact Hv. - intros H eps. case: (H eps) => {H} P [HP H]. destruct (filter_ex P HP) as [x Hx]. exists x. move: (fun v => H x v Hx) => {} H. apply filter_imp with (1 := H). by []. Qed. Section fct_CompleteSpace. Context {T : Type} {U : CompleteSpace}. Lemma filterlim_locally_closely : forall {F} {FF : ProperFilter F} (f : T -> U), filterlim (fun x => (f (fst x), f (snd x))) (filter_prod F F) closely <-> exists y, filterlim f F (locally y). Proof. intros F FF f. split. - intros H. exists (lim (filtermap f F)). intros P [eps HP]. refine (_ (complete_cauchy (filtermap f F) _ _ eps)). + now apply filter_imp. + apply cauchy_distance'. apply filter_le_trans with (2 := H). apply prod_filtermap_le. - intros [y Hy] P [eps HP]. split with (fun x => ball y (pos_div_2 eps) (f x)) (fun x => ball y (pos_div_2 eps) (f x)). apply Hy, locally_ball. apply Hy, locally_ball. intros u v Hu Hv. apply HP. rewrite (double_var eps). apply ball_triangle with (2 := Hv). now apply ball_sym. Qed. Lemma filterlim_locally_cauchy : forall {F} {FF : ProperFilter F} (f : T -> U), (forall eps : posreal, exists P, F P /\ forall u v : T, P u -> P v -> ball (f u) eps (f v)) <-> exists y, filterlim f F (locally y). Proof. intros F FF f. apply iff_trans with (2 := filterlim_locally_closely f). apply iff_sym, filterlim_closely. Qed. Lemma filterlimi_locally_cauchy : forall {F} {FF : ProperFilter F} (f : T -> U -> Prop), F (fun x => (exists y, f x y) /\ (forall y1 y2, f x y1 -> f x y2 -> y1 = y2)) -> ((forall eps : posreal, exists P, F P /\ forall u v : T, P u -> P v -> forall u' v': U, f u u' -> f v v' -> ball u' eps v') <-> exists y, filterlimi f F (locally y)). Proof. intros F FF f Hf. assert (FF': ProperFilter (filtermapi f F)). apply filtermapi_proper_filter. exact: filter_imp Hf. exact FF. split. - intros H. exists (lim (filtermapi f F)). intros P [eps HP]. refine (_ (complete_cauchy (filtermapi f F) _ _ eps)). + now apply filter_imp. + clear eps P HP. intros eps. case: (H eps) => {H} [P [FP H]]. assert (FfP := filter_and _ _ Hf FP). destruct (filter_ex _ FfP) as [x [[[fx Hfx] _] Px]]. exists fx. unfold filtermapi. apply: filter_imp FfP. intros x' [[[fx' Hfx'] _] Px']. exists fx'. apply (conj Hfx'). exact: H Hfx Hfx'. - intros [y Hy] eps. exists (fun x => forall fx, f x fx -> ball y (pos_div_2 eps) fx). split. assert (Hb: locally y (ball y (pos_div_2 eps))). now exists (pos_div_2 eps). assert (H := filter_and _ _ Hf (Hy _ Hb)). apply: filter_imp H. intros x [[_ H] [fx2 [Hfx2 H']]] fx Hfx. now rewrite <- (H fx2). intros u v Hu Hv fu fv Hfu Hfv. rewrite (double_var eps). apply ball_triangle with y. apply ball_sym. now apply Hu. now apply Hv. Qed. Definition lim_fct (F : ((T -> U) -> Prop) -> Prop) (t : T) := lim (fun P => F (fun g => P (g t))). Lemma complete_cauchy_fct : forall (F : ((T -> U) -> Prop) -> Prop), ProperFilter F -> (forall eps : posreal, exists f : T -> U, F (ball f eps)) -> forall eps : posreal, F (ball (lim_fct F) eps). Proof. move => F FF HFc. set Fr := fun (t : T) (P : U -> Prop) => F (fun g => P (g t)). have FFr : forall t, ProperFilter (Fr t). case: FF => HF FF t. split. - move => P Hp. case: (HF _ Hp) => f Hf. by exists (f t). - split. + by apply FF. + move => P P' Hp Hp'. by apply FF. + move => P P' Hpp'. apply FF. move => f ; by apply Hpp'. assert (HFrc : forall t, forall eps : posreal, exists x : U, Fr t (ball x eps)). move => t eps. case: (HFc eps) => f Hf. exists (f t). move: Hf ; apply FF => g. by []. assert (forall t (eps : posreal), (Fr t) (fun x => ball (lim_fct F t) eps x)). move => t. apply complete_cauchy. apply FFr. exact (HFrc t). move => eps. generalize (proj1 cauchy_distance HFc) => {} HFc. case: (HFc (pos_div_2 eps)) => {HFc} P ; simpl ; case => HP H0. apply filter_imp with (2 := HP). move => g Hg t. move: (fun h => H0 g h Hg) => {} H0. move: (H t (pos_div_2 eps)) ; simpl => {} H. unfold Fr in H ; generalize (filter_and _ _ H HP) => {} H. apply filter_ex in H ; case: H => h H. rewrite (double_var eps). apply ball_triangle with (h t). by apply H. apply ball_sym, H0. by apply H. Qed. Lemma close_lim_fct : forall F1 F2 : ((T -> U) -> Prop) -> Prop, filter_le F1 F2 -> filter_le F2 F1 -> close (lim_fct F1) (lim_fct F2). Proof. intros F1 F2 H12 H21 eps t. apply close_lim => P. apply H12. apply H21. Qed. Definition fct_CompleteSpace_mixin := CompleteSpace.Mixin _ lim_fct complete_cauchy_fct close_lim_fct. Canonical fct_CompleteSpace := CompleteSpace.Pack (T -> U) (CompleteSpace.Class _ _ fct_CompleteSpace_mixin) (T -> U). End fct_CompleteSpace. (** ** Limit switching *) Section Filterlim_switch. Context {T1 T2 : Type}. Lemma filterlim_switch_1 {U : UniformSpace} F1 (FF1 : ProperFilter F1) F2 (FF2 : Filter F2) (f : T1 -> T2 -> U) g h (l : U) : filterlim f F1 (locally g) -> (forall x, filterlim (f x) F2 (locally (h x))) -> filterlim h F1 (locally l) -> filterlim g F2 (locally l). Proof. intros Hfg Hfh Hhl P. case: FF1 => HF1 FF1. apply filterlim_locally. move => eps. have FF := (filter_prod_filter _ _ F1 F2 FF1 FF2). assert (filter_prod F1 F2 (fun x => ball (g (snd x)) (eps / 2 / 2) (f (fst x) (snd x)))). apply Filter_prod with (fun x : T1 => ball g (eps / 2 / 2) (f x)) (fun _ => True). move: (proj1 (@filterlim_locally _ _ F1 FF1 f g) Hfg (pos_div_2 (pos_div_2 eps))) => {Hfg} /= Hfg. by []. by apply FF2. simpl ; intros. apply H. move: H => {} Hfg. assert (filter_prod F1 F2 (fun x : T1 * T2 => ball l (eps / 2) (h (fst x)))). apply Filter_prod with (fun x : T1 => ball l (eps / 2) (h x)) (fun _ => True). move: (proj1 (@filterlim_locally _ _ F1 FF1 h l) Hhl (pos_div_2 eps)) => {Hhl} /= Hhl. by []. by apply FF2. by []. move: H => {} Hhl. case: (@filter_and _ _ FF _ _ Hhl Hfg) => {Hhl Hfg} /= ; intros. move: (fun x => proj1 (@filterlim_locally _ _ F2 FF2 (f x) (h x)) (Hfh x) (pos_div_2 (pos_div_2 eps))) => {Hfh} /= Hfh. case: (HF1 Q f0) => x Hx. move: (@filter_and _ _ FF2 _ _ (Hfh x) g0) => {Hfh}. apply filter_imp => y Hy. rewrite (double_var eps). apply ball_triangle with (h x). apply (p x y). by []. by apply Hy. rewrite (double_var (eps / 2)). apply ball_triangle with (f x y). by apply Hy. apply ball_sym, p. by []. by apply Hy. Qed. Lemma filterlim_switch_2 {U : CompleteSpace} F1 (FF1 : ProperFilter F1) F2 (FF2 : ProperFilter F2) (f : T1 -> T2 -> U) g h : filterlim f F1 (locally g) -> (forall x, filterlim (f x) F2 (locally (h x))) -> exists l : U, filterlim h F1 (locally l). Proof. move => Hfg Hfh. case : (proj1 (filterlim_locally_cauchy h)). move => eps. generalize (proj2 (filterlim_locally_cauchy f)) => Hf. assert (exists y : T2 -> U, filterlim f F1 (locally y)). exists g => P Hp. apply Hfg. case: Hp => d Hp. exists d => y Hy. apply: Hp. by apply Hy. move: H => {} Hfg. move: (Hf Hfg (pos_div_2 eps)) => {Hf Hfg} /= Hf. case: FF2 => HF2 FF2. generalize (fun x => proj1 (filterlim_locally (f x) (h x)) (Hfh x) (pos_div_2 (pos_div_2 eps))) => {} Hfh. case: Hf => P [Hp Hf]. exists P ; split. by []. move => u v Hu Hv. move: (Hfh u) => /= Hu'. move: (Hfh v) => /= Hv'. move: (@filter_and _ F2 FF2 _ _ Hu' Hv') => {Hu' Hv'} Hfh. case: (HF2 _ Hfh) => {Hfh} y Hy. replace (pos eps) with (eps / 2 / 2 + (eps / 2 + eps / 2 / 2)) by field. apply ball_triangle with (f u y). by apply Hy. apply ball_triangle with (f v y). by apply Hf. now apply ball_sym. move => l Hl. by exists l. Qed. Lemma filterlim_switch {U : CompleteSpace} F1 (FF1 : ProperFilter F1) F2 (FF2 : ProperFilter F2) (f : T1 -> T2 -> U) g h : filterlim f F1 (locally g) -> (forall x, filterlim (f x) F2 (locally (h x))) -> exists l : U, filterlim h F1 (locally l) /\ filterlim g F2 (locally l). Proof. move => Hfg Hfh. destruct (filterlim_switch_2 F1 FF1 F2 FF2 f g h Hfg Hfh) as [l Hhl]. exists l ; split. exact Hhl. case: FF2 => HF2 FF2. now apply (filterlim_switch_1 F1 FF1 F2 FF2 f g h l). Qed. End Filterlim_switch. Lemma filterlim_switch_dom {T1 T2 : Type} {U : CompleteSpace} F1 (FF1 : ProperFilter F1) F2 (FF2 : Filter F2) (dom : T2 -> Prop) (HF2 : forall P, F2 P -> exists x, dom x /\ P x) (f : T1 -> T2 -> U) g h : filterlim (fun x (y : {z : T2 | dom z}) => f x (proj1_sig y)) F1 (locally (T := fct_UniformSpace _ _) (fun y : {z : T2 | dom z} => g (proj1_sig y))) -> (forall x, filterlim (f x) (within dom F2) (locally (h x))) -> exists l : U, filterlim h F1 (locally l) /\ filterlim g (within dom F2) (locally l). Proof. set (T2' := { y : T2 | dom y }). set (f' := fun x (y : T2') => f x (proj1_sig y)). set (F2' := fun P : T2' -> Prop => F2 (fun x => forall (H:dom x), P (exist _ x H))). set (g' := fun y : T2' => g (proj1_sig y)). intros Hfg Hfh. refine (filterlim_switch F1 FF1 F2' _ f' g' h _ _). now apply subset_filter_proper. intros H P. now apply Hfg. intros x P HP. now apply Hfh. Qed. (** * Modules *) Module ModuleSpace. Record mixin_of (K : Ring) (V : AbelianGroup) := Mixin { scal : K -> V -> V ; ax1 : forall x y u, scal x (scal y u) = scal (mult x y) u ; ax2 : forall u, scal one u = u ; ax3 : forall x u v, scal x (plus u v) = plus (scal x u) (scal x v) ; ax4 : forall x y u, scal (plus x y) u = plus (scal x u) (scal y u) }. Section ClassDef. Variable K : Ring. Record class_of (V : Type) := Class { base : AbelianGroup.class_of V ; mixin : mixin_of K (AbelianGroup.Pack _ base V) }. Local Coercion base : class_of >-> AbelianGroup.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. Definition AbelianGroup := AbelianGroup.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> AbelianGroup.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Coercion AbelianGroup : type >-> AbelianGroup.type. Canonical AbelianGroup. Notation ModuleSpace := type. End Exports. End ModuleSpace. Export ModuleSpace.Exports. Section ModuleSpace1. Context {K : Ring} {V : ModuleSpace K}. Definition scal : K -> V -> V := ModuleSpace.scal _ _ (ModuleSpace.class K V). Lemma scal_assoc : forall (x y : K) (u : V), scal x (scal y u) = scal (mult x y) u. Proof. apply ModuleSpace.ax1. Qed. Lemma scal_one : forall (u : V), scal one u = u. Proof. apply ModuleSpace.ax2. Qed. Lemma scal_distr_l : forall (x : K) (u v : V), scal x (plus u v) = plus (scal x u) (scal x v). Proof. apply: ModuleSpace.ax3. Qed. Lemma scal_distr_r : forall (x y : K) (u : V), scal (plus x y) u = plus (scal x u) (scal y u). Proof. apply ModuleSpace.ax4. Qed. Lemma scal_zero_r : forall x : K, scal x zero = zero. Proof. intros x. apply plus_reg_r with (scal x zero). rewrite <- scal_distr_l. rewrite plus_zero_r. now rewrite plus_zero_l. Qed. Lemma scal_zero_l : forall u : V, scal zero u = zero. Proof. intros u. apply plus_reg_r with (r := scal zero u). rewrite plus_zero_l. rewrite <- scal_distr_r. now rewrite plus_zero_r. Qed. Lemma scal_opp_l : forall (x : K) (u : V), scal (opp x) u = opp (scal x u). Proof. intros x u. apply plus_reg_r with (r := (scal x u)). rewrite plus_opp_l. rewrite <- scal_distr_r. rewrite plus_opp_l. apply scal_zero_l. Qed. Lemma scal_opp_r : forall (x : K) (u : V), scal x (opp u) = opp (scal x u). Proof. intros x u. apply plus_reg_r with (r := (scal x u)). rewrite plus_opp_l. rewrite <- scal_distr_l. rewrite plus_opp_l. apply scal_zero_r. Qed. Lemma scal_opp_one : forall u : V, scal (opp one) u = opp u. Proof. intros u. rewrite scal_opp_l. now rewrite scal_one. Qed. Lemma scal_minus_distr_l (x : K) (u v : V) : scal x (minus u v) = minus (scal x u) (scal x v). Proof. by rewrite /minus scal_distr_l scal_opp_r. Qed. Lemma scal_minus_distr_r (x y : K) (u : V) : scal (minus x y) u = minus (scal x u) (scal y u). Proof. by rewrite /minus scal_distr_r scal_opp_l. Qed. Lemma sum_n_m_scal_l : forall (a : K) (u : nat -> V) (n m : nat), sum_n_m (fun k => scal a (u k)) n m = scal a (sum_n_m u n m). Proof. intros a u n m. case: (le_dec n m) => Hnm. elim: m n u Hnm => [ | m IH] n u Hnm. apply Nat.le_0_r in Hnm. by rewrite -Hnm !sum_n_n. destruct n. rewrite !sum_n_Sm ; try by apply Nat.le_0_l. rewrite IH. by apply sym_eq, scal_distr_l. by apply Nat.le_0_l. rewrite -!sum_n_m_S. apply IH. by apply le_S_n. apply not_le in Hnm. rewrite !sum_n_m_zero //. by rewrite scal_zero_r. Qed. Lemma sum_n_scal_l : forall (a : K) (u : nat -> V) (n : nat), sum_n (fun k => scal a (u k)) n = scal a (sum_n u n). Proof. intros a u n. apply sum_n_m_scal_l. Qed. End ModuleSpace1. (** Rings are modules *) Section Ring_ModuleSpace. Variable (K : Ring). Definition Ring_ModuleSpace_mixin := ModuleSpace.Mixin K _ _ mult_assoc mult_one_l mult_distr_l mult_distr_r. Canonical Ring_ModuleSpace := ModuleSpace.Pack K K (ModuleSpace.Class _ _ _ Ring_ModuleSpace_mixin) K. End Ring_ModuleSpace. Section AbsRing_ModuleSpace. Variable (K : AbsRing). Definition AbsRing_ModuleSpace_mixin := ModuleSpace.Mixin K _ _ mult_assoc mult_one_l mult_distr_l mult_distr_r. Canonical AbsRing_ModuleSpace := ModuleSpace.Pack K K (ModuleSpace.Class _ _ _ AbsRing_ModuleSpace_mixin) K. End AbsRing_ModuleSpace. (** ** Modules with a norm *) Module NormedModuleAux. Section ClassDef. Variable K : AbsRing. Record class_of (T : Type) := Class { base : ModuleSpace.class_of K T ; mixin : UniformSpace.mixin_of T }. Local Coercion base : class_of >-> ModuleSpace.class_of. Local Coercion mixin : class_of >-> UniformSpace.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. Definition AbelianGroup := AbelianGroup.Pack cT xclass xT. Definition ModuleSpace := ModuleSpace.Pack _ cT xclass xT. Definition UniformSpace := UniformSpace.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> ModuleSpace.class_of. Coercion mixin : class_of >-> UniformSpace.class_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Coercion AbelianGroup : type >-> AbelianGroup.type. Canonical AbelianGroup. Coercion ModuleSpace : type >-> ModuleSpace.type. Canonical ModuleSpace. Coercion UniformSpace : type >-> UniformSpace.type. Canonical UniformSpace. Notation NormedModuleAux := type. End Exports. End NormedModuleAux. Export NormedModuleAux.Exports. Module NormedModule. Record mixin_of (K : AbsRing) (V : NormedModuleAux K) := Mixin { norm : V -> R ; norm_factor : R ; ax1 : forall (x y : V), norm (plus x y) <= norm x + norm y ; ax2 : forall (l : K) (x : V), norm (scal l x) <= abs l * norm x ; ax3 : forall (x y : V) (eps : R), norm (minus y x) < eps -> ball x eps y ; ax4 : forall (x y : V) (eps : posreal), ball x eps y -> norm (minus y x) < norm_factor * eps ; ax5 : forall x : V, norm x = 0 -> x = zero }. Section ClassDef. Variable K : AbsRing. Record class_of (T : Type) := Class { base : NormedModuleAux.class_of K T ; mixin : mixin_of K (NormedModuleAux.Pack K T base T) }. Local Coercion base : class_of >-> NormedModuleAux.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. Definition AbelianGroup := AbelianGroup.Pack cT xclass xT. Definition ModuleSpace := ModuleSpace.Pack _ cT xclass xT. Definition UniformSpace := UniformSpace.Pack cT xclass xT. Definition NormedModuleAux := NormedModuleAux.Pack _ cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> NormedModuleAux.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Coercion AbelianGroup : type >-> AbelianGroup.type. Canonical AbelianGroup. Coercion ModuleSpace : type >-> ModuleSpace.type. Canonical ModuleSpace. Coercion UniformSpace : type >-> UniformSpace.type. Canonical UniformSpace. Coercion NormedModuleAux : type >-> NormedModuleAux.type. Canonical NormedModuleAux. Notation NormedModule := type. End Exports. End NormedModule. Export NormedModule.Exports. Section NormedModule1. Context {K : AbsRing} {V : NormedModule K}. Definition norm : V -> R := NormedModule.norm K _ (NormedModule.class K V). Definition norm_factor : R := NormedModule.norm_factor K _ (NormedModule.class K V). Lemma norm_triangle : forall x y : V, norm (plus x y) <= norm x + norm y. Proof. apply NormedModule.ax1. Qed. Lemma norm_scal : forall (l : K) (x : V), norm (scal l x) <= abs l * norm x. Proof. apply NormedModule.ax2. Qed. Lemma norm_compat1 : forall (x y : V) (eps : R), norm (minus y x) < eps -> ball x eps y. Proof. apply NormedModule.ax3. Qed. Lemma norm_compat2 : forall (x y : V) (eps : posreal), ball x eps y -> norm (minus y x) < norm_factor * eps. Proof. apply: NormedModule.ax4. Qed. Lemma norm_eq_zero : forall x : V, norm x = 0 -> x = zero. Proof. apply NormedModule.ax5. Qed. Lemma norm_zero : norm zero = 0. Proof. apply Rle_antisym. - rewrite -(scal_zero_l zero). rewrite -(Rmult_0_l (norm zero)). rewrite -(@abs_zero K). apply norm_scal. - apply Rplus_le_reg_r with (norm zero). rewrite Rplus_0_l. rewrite -{1}[zero]plus_zero_r. exact (norm_triangle zero zero). Qed. Lemma norm_factor_gt_0 : 0 < norm_factor. Proof. rewrite <- (Rmult_1_r norm_factor). rewrite <- norm_zero. rewrite -(plus_opp_r zero). apply (norm_compat2 _ _ (mkposreal _ Rlt_0_1)). apply ball_center. Qed. Lemma norm_opp : forall x : V, norm (opp x) = norm x. Proof. intros x. apply Rle_antisym. - rewrite -scal_opp_one. rewrite -(Rmult_1_l (norm x)) -(@abs_opp_one K). apply norm_scal. - rewrite -{1}[x]opp_opp -scal_opp_one. rewrite -(Rmult_1_l (norm (opp x))) -(@abs_opp_one K). apply norm_scal. Qed. Lemma norm_ge_0 : forall x : V, 0 <= norm x. Proof. intros x. apply Rmult_le_reg_l with 2. by apply Rlt_0_2. rewrite Rmult_0_r -norm_zero -(plus_opp_r x). apply Rle_trans with (norm x + norm (opp x)). apply norm_triangle. apply Req_le ; rewrite norm_opp. ring. Qed. Lemma norm_gt_0 : forall x : V, x <> zero -> 0 < norm x. Proof. intros x Hx. apply Rnot_le_lt. contradict Hx. apply norm_eq_zero. apply Rle_antisym with (1 := Hx). apply norm_ge_0. Qed. Lemma norm_minus_gt_0 : forall x y : V, x <> y -> 0 < norm (minus x y). Proof. intros x y Hxy. apply norm_gt_0. contradict Hxy. apply plus_reg_r with (opp y). now rewrite plus_opp_r. Qed. Lemma norm_triangle_inv : forall x y : V, Rabs (norm x - norm y) <= norm (minus x y). Proof. intros x y. apply Rabs_le_between' ; split. rewrite -(norm_opp (minus _ _)). apply Rle_minus_l ; eapply Rle_trans. 2 : apply norm_triangle. apply Req_le, f_equal. by rewrite /minus opp_plus plus_assoc plus_opp_r plus_zero_l opp_opp. eapply Rle_trans. 2 : apply norm_triangle. apply Req_le, f_equal. by rewrite /minus plus_comm -plus_assoc plus_opp_l plus_zero_r. Qed. Lemma eq_dec : forall x y : V, { x = y } + { x <> y }. Proof. intros x y. destruct (Req_EM_T (norm (minus y x)) 0) as [H|H]. - left. apply plus_reg_r with (opp x). rewrite plus_opp_r. now apply eq_sym, norm_eq_zero. - right. contradict H. rewrite H minus_eq_zero. apply norm_zero. Qed. Lemma eq_close : forall x y : V, close x y -> x = y. Proof. intros x y H. apply plus_reg_r with (opp x). rewrite plus_opp_r. apply eq_sym, norm_eq_zero. apply Rle_antisym. 2: apply norm_ge_0. apply prop_eps. intros eps He. assert (He' : 0 < eps / norm_factor). apply Rdiv_lt_0_compat with (1 := He). apply norm_factor_gt_0. specialize (H (mkposreal _ He')). replace eps with (norm_factor * (eps / norm_factor)). apply norm_compat2 with (1 := H). field. apply Rgt_not_eq, norm_factor_gt_0. Qed. Definition ball_norm (x : V) (eps : R) (y : V) := norm (minus y x) < eps. Definition locally_norm (x : V) (P : V -> Prop) := exists eps : posreal, forall y, ball_norm x eps y -> P y. Lemma locally_le_locally_norm : forall x, filter_le (locally x) (locally_norm x). Proof. intros x P [eps H]. assert (He : 0 < / norm_factor * eps). apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. apply norm_factor_gt_0. apply cond_pos. exists (mkposreal _ He). intros y By. apply H. unfold ball_norm. rewrite -(Rmult_1_l eps) -(Rinv_r norm_factor). rewrite Rmult_assoc. apply norm_compat2 with (1 := By). apply Rgt_not_eq. apply norm_factor_gt_0. Qed. Lemma locally_norm_le_locally : forall x, filter_le (locally_norm x) (locally x). Proof. intros x P [eps H]. exists eps. intros y By. apply H. now apply norm_compat1. Qed. Lemma locally_norm_ball_norm : forall (x : V) (eps : posreal), locally_norm x (ball_norm x eps). Proof. intros x eps. now exists eps. Qed. Lemma locally_norm_ball : forall (x : V) (eps : posreal), locally_norm x (ball x eps). Proof. intros x eps. apply locally_norm_le_locally. apply locally_ball. Qed. Lemma locally_ball_norm : forall (x : V) (eps : posreal), locally x (ball_norm x eps). Proof. intros x eps. apply locally_le_locally_norm. apply locally_norm_ball_norm. Qed. Lemma ball_norm_triangle (x y z : V) (e1 e2 : R) : ball_norm x e1 y -> ball_norm y e2 z -> ball_norm x (e1 + e2) z. Proof. intros H1 H2. eapply Rle_lt_trans, Rplus_lt_compat. 2: by apply H1. 2: by apply H2. rewrite Rplus_comm. eapply Rle_trans, norm_triangle. apply Req_le, f_equal. rewrite /minus -!plus_assoc. apply f_equal. by rewrite plus_assoc plus_opp_l plus_zero_l. Qed. Lemma ball_norm_center (x : V) (e : posreal) : ball_norm x e x. Proof. eapply Rle_lt_trans, e. rewrite minus_eq_zero norm_zero. by apply Req_le. Qed. Lemma ball_norm_dec : forall (x y : V) (eps : posreal), {ball_norm x eps y} + {~ ball_norm x eps y}. Proof. intros x y eps. apply Rlt_dec. Qed. Lemma ball_norm_sym : forall (x y : V) (eps : posreal), ball_norm x eps y -> ball_norm y eps x. Proof. intros x y eps Hxy. unfold ball_norm. rewrite <- norm_opp. rewrite opp_minus. apply Hxy. Qed. Lemma ball_norm_le : forall (x : V) (e1 e2 : posreal), e1 <= e2 -> forall y, ball_norm x e1 y -> ball_norm x e2 y. Proof. intros x e1 e2 He y H1. now apply Rlt_le_trans with e1. Qed. Lemma ball_norm_eq : forall x y : V, (forall eps : posreal, ball_norm x eps y) -> x = y. Proof. intros x y H. apply plus_reg_r with (opp x). rewrite plus_opp_r. apply eq_sym, norm_eq_zero. apply Rle_antisym. 2: apply norm_ge_0. apply prop_eps. intros eps He. exact (H (mkposreal eps He)). Qed. Lemma is_filter_lim_unique : forall {F} {FF : ProperFilter' F} (x y : V), is_filter_lim F x -> is_filter_lim F y -> x = y. Proof. intros F FF x y Hx Hy. apply ball_norm_eq => eps. assert (Hx': F (ball_norm x (pos_div_2 eps))). apply Hx. apply locally_ball_norm. assert (Hy': F (ball_norm y (pos_div_2 eps))). apply Hy. apply locally_ball_norm. apply Rnot_le_lt. intros H. apply (@filter_not_empty V F FF). apply: filter_imp (filter_and _ _ Hx' Hy'). clear -H. intros z [Bx By]. revert H. apply Rlt_not_le. rewrite (double_var eps). change (eps / 2) with (pos (pos_div_2 eps)). apply ball_norm_triangle with (1 := Bx). now apply ball_norm_sym. Qed. Lemma is_filter_lim_locally_unique : forall (x y : V), is_filter_lim (locally x) y -> x = y. Proof. intros x y H. apply eq_close. now apply is_filter_lim_locally_close. Qed. Definition closely_norm (P : V * V -> Prop) := exists eps : posreal, forall x y, ball_norm x eps y -> P (x, y). Lemma closely_le_closely_norm : filter_le closely closely_norm. Proof. intros P [eps H]. assert (He : 0 < / norm_factor * eps). apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. apply norm_factor_gt_0. apply cond_pos. exists (mkposreal _ He). intros u v Buv. apply H. unfold ball_norm. rewrite -(Rmult_1_l eps) -(Rinv_r norm_factor). rewrite Rmult_assoc. apply norm_compat2 with (1 := Buv). apply Rgt_not_eq. apply norm_factor_gt_0. Qed. Lemma closely_norm_le_closely : filter_le closely_norm closely. Proof. intros P [eps H]. exists eps. intros u v Buv. apply H. now apply norm_compat1. Qed. End NormedModule1. Section NormedModule2. Context {T : Type} {K : AbsRing} {V : NormedModule K}. Lemma filterlim_closely_norm {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> V) : filterlim (fun x => (f (fst x), f (snd x))) (filter_prod F F) closely_norm <-> (forall eps : posreal, exists P, F P /\ forall u v : T, P u -> P v -> ball_norm (f u) eps (f v)). Proof. apply filterlim_prod. Qed. Lemma filterlim_locally_unique : forall {F} {FF : ProperFilter' F} (f : T -> V) (x y : V), filterlim f F (locally x) -> filterlim f F (locally y) -> x = y. Proof. intros F FF f x y. apply is_filter_lim_unique. Qed. Lemma filterlimi_locally_unique : forall {F} {FF : ProperFilter' F} (f : T -> V -> Prop) (x y : V), F (fun x => forall y1 y2, f x y1 -> f x y2 -> y1 = y2) -> filterlimi f F (locally x) -> filterlimi f F (locally y) -> x = y. Proof. intros F FF f x y Hf Hx Hy. apply ball_norm_eq => eps. specialize (Hx (ball_norm x (pos_div_2 eps)) (locally_ball_norm _ _)). specialize (Hy (ball_norm y (pos_div_2 eps)) (locally_ball_norm _ _)). unfold filtermapi in Hx, Hy. apply Rnot_le_lt. intros H. apply (@filter_not_empty _ F FF). apply: filter_imp (filter_and _ _ (filter_and _ _ Hx Hy) Hf). clear -H. intros z [[[x' [Hx Bx]] [y' [Hy By]]] Hf]. apply: Rlt_not_le H. rewrite (double_var eps). change (eps / 2) with (pos (pos_div_2 eps)). apply ball_norm_triangle with (1 := Bx). apply ball_norm_sym. now rewrite (Hf _ _ Hx Hy). Qed. End NormedModule2. (** Rings with absolute values are normed modules *) Section AbsRing_NormedModule. Variable (K : AbsRing). Canonical AbsRing_NormedModuleAux := NormedModuleAux.Pack K K (NormedModuleAux.Class _ _ (ModuleSpace.class _ (AbsRing_ModuleSpace K)) (UniformSpace.class (AbsRing_UniformSpace K))) K. Lemma AbsRing_norm_compat2 : forall (x y : AbsRing_NormedModuleAux) (eps : posreal), ball x eps y -> abs (minus y x) < 1 * eps. Proof. intros x y eps H. now rewrite Rmult_1_l. Qed. Definition AbsRing_NormedModule_mixin := NormedModule.Mixin K _ abs 1 abs_triangle abs_mult (fun x y e H => H) AbsRing_norm_compat2 abs_eq_zero. Canonical AbsRing_NormedModule := NormedModule.Pack K _ (NormedModule.Class _ _ _ AbsRing_NormedModule_mixin) K. End AbsRing_NormedModule. (** Normed vector spaces have some continuous functions *) Section NVS_continuity. Context {K : AbsRing} {V : NormedModule K}. Lemma filterlim_plus : forall x y : V, filterlim (fun z : V * V => plus (fst z) (snd z)) (filter_prod (locally x) (locally y)) (locally (plus x y)). Proof. intros x y. apply (filterlim_filter_le_1 (F := filter_prod (locally_norm x) (locally_norm y))). intros P [Q R LQ LR H]. exists Q R. now apply locally_le_locally_norm. now apply locally_le_locally_norm. exact H. apply (filterlim_filter_le_2 (G := locally_norm (plus x y))). apply locally_norm_le_locally. intros P [eps HP]. exists (ball_norm x (pos_div_2 eps)) (ball_norm y (pos_div_2 eps)). by apply locally_norm_ball_norm. by apply locally_norm_ball_norm. intros u v Hu Hv. apply HP. rewrite /ball_norm /= (double_var eps). apply Rle_lt_trans with (2 := Rplus_lt_compat _ _ _ _ Hu Hv). apply Rle_trans with (2 := norm_triangle _ _). apply Req_le, f_equal. rewrite /minus /= opp_plus -2!plus_assoc. apply f_equal. rewrite 2!plus_assoc. apply f_equal2. by apply plus_comm. by []. Qed. Lemma filterlim_scal (k : K) (x : V) : filterlim (fun z => scal (fst z) (snd z)) (filter_prod (locally k) (locally x)) (locally (scal k x)). Proof. apply filterlim_locally => /= eps. eapply filter_imp. move => /= u Hu. rewrite (double_var eps). apply ball_triangle with (scal (fst u) x). apply norm_compat1. rewrite -scal_minus_distr_r. eapply Rle_lt_trans. apply norm_scal. eapply Rle_lt_trans. apply Rmult_le_compat_l. by apply abs_ge_0. apply Rlt_le, Rlt_plus_1. apply <- Rlt_div_r. 2: apply Rle_lt_0_plus_1, norm_ge_0. by eapply (proj1 Hu). apply norm_compat1. rewrite -scal_minus_distr_l. eapply Rle_lt_trans. apply norm_scal. eapply Rle_lt_trans. apply Rmult_le_compat_r. by apply norm_ge_0. replace (fst u) with (plus k (minus (fst u) k)). eapply Rle_trans. apply abs_triangle. apply Rplus_le_compat_l. apply Rlt_le. instantiate (1 := 1). eapply (proj1 (proj2 Hu)). by rewrite plus_comm -plus_assoc plus_opp_l plus_zero_r. rewrite Rmult_comm. apply <- Rlt_div_r. 2: apply Rle_lt_0_plus_1, abs_ge_0. by apply (proj2 (proj2 Hu)). repeat apply filter_and. assert (Hd : 0 < eps / 2 / (norm x + 1)). apply Rdiv_lt_0_compat. by apply is_pos_div_2. apply Rle_lt_0_plus_1, norm_ge_0. eexists. apply (locally_ball_norm (V := AbsRing_NormedModule K) _ (mkposreal _ Hd)). apply filter_true. by []. eexists. apply (locally_ball_norm (V := AbsRing_NormedModule K) _ (mkposreal _ Rlt_0_1)). apply filter_true. by []. assert (Hd : 0 < eps / 2 / (abs k + 1)). apply Rdiv_lt_0_compat. by apply is_pos_div_2. apply Rle_lt_0_plus_1, abs_ge_0. eexists. apply filter_true. apply (locally_ball_norm _ (mkposreal _ Hd)). by []. Qed. Lemma filterlim_scal_r (k : K) (x : V) : filterlim (fun z : V => scal k z) (locally x) (locally (scal k x)). Proof. eapply filterlim_comp_2. by apply filterlim_const. by apply filterlim_id. by apply filterlim_scal. Qed. Lemma filterlim_scal_l (k : K) (x : V) : filterlim (fun z => scal z x) (locally k) (locally (scal k x)). Proof. eapply filterlim_comp_2. by apply filterlim_id. by apply filterlim_const. by apply filterlim_scal. Qed. Lemma filterlim_opp : forall x : V, filterlim opp (locally x) (locally (opp x)). Proof. intros x. rewrite -scal_opp_one. apply filterlim_ext with (2 := filterlim_scal_r _ _). apply: scal_opp_one. Qed. End NVS_continuity. Lemma filterlim_mult {K : AbsRing} (x y : K) : filterlim (fun z => mult (fst z) (snd z)) (filter_prod (locally x) (locally y)) (locally (mult x y)). Proof. by apply @filterlim_scal. Qed. Lemma filterlim_locally_ball_norm : forall {K : AbsRing} {T} {U : NormedModule K} {F : (T -> Prop) -> Prop} {FF : Filter F} (f : T -> U) (y : U), filterlim f F (locally y) <-> forall eps : posreal, F (fun x => ball_norm y eps (f x)). Proof. intros K T U F FF f y. split. - intros Cf eps. apply (Cf (fun x => ball_norm y eps x)). apply locally_le_locally_norm. apply locally_norm_ball_norm. - intros Cf. apply (filterlim_filter_le_2 _ (locally_norm_le_locally y)). intros P [eps He]. apply: filter_imp (Cf eps). intros t. apply He. Qed. (** ** Complete Normed Modules *) Module CompleteNormedModule. Section ClassDef. Variable K : AbsRing. Record class_of (T : Type) := Class { base : NormedModule.class_of K T ; mixin : CompleteSpace.mixin_of (UniformSpace.Pack T base T) }. Local Coercion base : class_of >-> NormedModule.class_of. Definition base2 T (cT : class_of T) : CompleteSpace.class_of T := CompleteSpace.Class _ (base T cT) (mixin T cT). Local Coercion base2 : class_of >-> CompleteSpace.class_of. Structure type := Pack { sort; _ : class_of sort ; _ : Type }. Local Coercion sort : type >-> Sortclass. Variable cT : type. Definition class := let: Pack _ c _ := cT return class_of cT in c. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition AbelianMonoid := AbelianMonoid.Pack cT xclass xT. Definition AbelianGroup := AbelianGroup.Pack cT xclass xT. Definition ModuleSpace := ModuleSpace.Pack _ cT xclass xT. Definition NormedModuleAux := NormedModuleAux.Pack _ cT xclass xT. Definition NormedModule := NormedModule.Pack _ cT xclass xT. Definition UniformSpace := UniformSpace.Pack cT xclass xT. Definition CompleteSpace := CompleteSpace.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> NormedModule.class_of. Coercion mixin : class_of >-> CompleteSpace.mixin_of. Coercion base2 : class_of >-> CompleteSpace.class_of. Coercion sort : type >-> Sortclass. Coercion AbelianMonoid : type >-> AbelianMonoid.type. Canonical AbelianMonoid. Coercion AbelianGroup : type >-> AbelianGroup.type. Canonical AbelianGroup. Coercion ModuleSpace : type >-> ModuleSpace.type. Canonical ModuleSpace. Coercion NormedModuleAux : type >-> NormedModuleAux.type. Canonical NormedModuleAux. Coercion NormedModule : type >-> NormedModule.type. Canonical NormedModule. Coercion UniformSpace : type >-> UniformSpace.type. Canonical UniformSpace. Coercion CompleteSpace : type >-> CompleteSpace.type. Canonical CompleteSpace. Notation CompleteNormedModule := type. End Exports. End CompleteNormedModule. Export CompleteNormedModule.Exports. Section CompleteNormedModule1. Context {K : AbsRing} {V : CompleteNormedModule K}. Lemma iota_unique : forall (P : V -> Prop) (x : V), (forall y, P y -> y = x) -> P x -> iota P = x. Proof. intros P x HP Px. apply eq_close. intros eps. apply: iota_correct_weak Px eps. intros x' y Px' Py eps. rewrite (HP _ Py) -(HP _ Px'). apply ball_center. Qed. Lemma iota_correct : forall P : V -> Prop, (exists! x : V, P x) -> P (iota P). Proof. intros P [x [Px HP]]. rewrite (iota_unique _ x) ; try exact Px. intros y Py. now apply sym_eq, HP. Qed. Lemma iota_is_filter_lim {F} {FF : ProperFilter' F} (l : V) : is_filter_lim F l -> iota (is_filter_lim F) = l. Proof. intros Hl. apply: iota_unique (Hl) => l' Hl'. exact: is_filter_lim_unique Hl' Hl. Qed. Context {T : Type}. Lemma iota_filterlim_locally {F} {FF : ProperFilter' F} (f : T -> V) l : filterlim f F (locally l) -> iota (fun x => filterlim f F (locally x)) = l. Proof. apply iota_is_filter_lim. Qed. Lemma iota_filterlimi_locally {F} {FF : ProperFilter' F} (f : T -> V -> Prop) l : F (fun x => forall y1 y2, f x y1 -> f x y2 -> y1 = y2) -> filterlimi f F (locally l) -> iota (fun x => filterlimi f F (locally x)) = l. Proof. intros Hf Hl. apply: iota_unique (Hl) => l' Hl'. exact: filterlimi_locally_unique Hf Hl' Hl. Qed. End CompleteNormedModule1. (** * Extended Types *) (** ** Pairs *) Section prod_AbelianMonoid. Context {U V : AbelianMonoid}. Definition prod_plus (x y : U * V) := (plus (fst x) (fst y), plus (snd x) (snd y)). Definition prod_zero : U * V := (zero, zero). Lemma prod_plus_comm : forall x y : U * V, prod_plus x y = prod_plus y x. Proof. intros x y. apply (f_equal2 pair) ; apply plus_comm. Qed. Lemma prod_plus_assoc : forall x y z : U * V, prod_plus x (prod_plus y z) = prod_plus (prod_plus x y) z. Proof. intros x y z. apply (f_equal2 pair) ; apply plus_assoc. Qed. Lemma prod_plus_zero_r : forall x : U * V, prod_plus x prod_zero = x. Proof. intros [u v]. apply (f_equal2 pair) ; apply plus_zero_r. Qed. End prod_AbelianMonoid. Definition prod_AbelianMonoid_mixin (U V : AbelianMonoid) := AbelianMonoid.Mixin (U * V) _ _ prod_plus_comm prod_plus_assoc prod_plus_zero_r. Canonical prod_AbelianMonoid (U V : AbelianMonoid) := AbelianMonoid.Pack (U * V) (prod_AbelianMonoid_mixin U V) (U * V). Section prod_AbelianGroup. Context {U V : AbelianGroup}. Definition prod_opp (x : U * V) := (opp (fst x), opp (snd x)). Lemma prod_plus_opp_r : forall x : U * V, prod_plus x (prod_opp x) = prod_zero. Proof. intros x. apply (f_equal2 pair) ; apply plus_opp_r. Qed. End prod_AbelianGroup. Definition prod_AbelianGroup_mixin (U V : AbelianGroup) := AbelianGroup.Mixin _ _ (@prod_plus_opp_r U V). Canonical prod_AbelianGroup (U V : AbelianGroup) := AbelianGroup.Pack (U * V) (AbelianGroup.Class _ _ (prod_AbelianGroup_mixin U V)) (U * V). Section prod_UniformSpace. Context {U V : UniformSpace}. Definition prod_ball (x : U * V) (eps : R) (y : U * V) := ball (fst x) eps (fst y) /\ ball (snd x) eps (snd y). Lemma prod_ball_center : forall (x : U * V) (eps : posreal), prod_ball x eps x. Proof. intros x eps. split ; apply ball_center. Qed. Lemma prod_ball_sym : forall (x y : U * V) (eps : R), prod_ball x eps y -> prod_ball y eps x. Proof. intros x y eps [H1 H2]. split ; now apply ball_sym. Qed. Lemma prod_ball_triangle : forall (x y z : U * V) (e1 e2 : R), prod_ball x e1 y -> prod_ball y e2 z -> prod_ball x (e1 + e2) z. Proof. intros x y z e1 e2 [H1 H2] [H3 H4]. split ; eapply ball_triangle ; eassumption. Qed. End prod_UniformSpace. Definition prod_UniformSpace_mixin (U V : UniformSpace) := UniformSpace.Mixin (U * V) (point_of, point_of) _ prod_ball_center prod_ball_sym prod_ball_triangle. Canonical prod_UniformSpace (U V : UniformSpace) := UniformSpace.Pack (U * V) (prod_UniformSpace_mixin U V) (U * V). Section prod_ModuleSpace. Context {K : Ring} {U V : ModuleSpace K}. Definition prod_scal (x : K) (u : U * V) := (scal x (fst u), scal x (snd u)). Lemma prod_scal_assoc : forall (x y : K) (u : U * V), prod_scal x (prod_scal y u) = prod_scal (mult x y) u. Proof. intros x y u. apply (f_equal2 pair) ; apply scal_assoc. Qed. Lemma prod_scal_one : forall u : U * V, prod_scal one u = u. Proof. intros [u v]. apply (f_equal2 pair) ; apply scal_one. Qed. Lemma prod_scal_distr_l : forall (x : K) (u v : U * V), prod_scal x (prod_plus u v) = prod_plus (prod_scal x u) (prod_scal x v). Proof. intros x u v. apply (f_equal2 pair) ; apply scal_distr_l. Qed. Lemma prod_scal_distr_r : forall (x y : K) (u : U * V), prod_scal (plus x y) u = prod_plus (prod_scal x u) (prod_scal y u). Proof. intros x y u. apply (f_equal2 pair) ; apply scal_distr_r. Qed. End prod_ModuleSpace. Definition prod_ModuleSpace_mixin (K : Ring) (U V : ModuleSpace K) := ModuleSpace.Mixin K _ _ (@prod_scal_assoc K U V) prod_scal_one prod_scal_distr_l prod_scal_distr_r. Canonical prod_ModuleSpace (K : Ring) (U V : ModuleSpace K) := ModuleSpace.Pack K (U * V) (ModuleSpace.Class _ _ _ (prod_ModuleSpace_mixin K U V)) (U * V). Canonical prod_NormedModuleAux (K : AbsRing) (U V : NormedModuleAux K) := NormedModuleAux.Pack K (U * V) (NormedModuleAux.Class _ _ (ModuleSpace.class K _) (UniformSpace.class (prod_UniformSpace U V))) (U * V). Lemma sqrt_plus_sqr : forall x y : R, Rmax (Rabs x) (Rabs y) <= sqrt (x ^ 2 + y ^ 2) <= sqrt 2 * Rmax (Rabs x) (Rabs y). Proof. intros x y. split. - rewrite -!sqrt_Rsqr_abs. apply Rmax_case ; apply sqrt_le_1_alt, Rminus_le_0 ; rewrite /Rsqr /= ; ring_simplify ; by apply pow2_ge_0. - apply Rmax_case_strong ; intros H0 ; rewrite -!sqrt_Rsqr_abs ; rewrite -?sqrt_mult ; try (by apply Rle_0_sqr) ; try (by apply Rlt_le, Rlt_0_2) ; apply sqrt_le_1_alt ; simpl ; [ rewrite Rplus_comm | ] ; rewrite /Rsqr ; apply Rle_minus_r ; ring_simplify ; apply Rsqr_le_abs_1 in H0 ; by rewrite /pow !Rmult_1_r. Qed. Section prod_NormedModule. Context {K : AbsRing} {U V : NormedModule K}. Definition prod_norm (x : U * V) := sqrt (norm (fst x) ^ 2 + norm (snd x) ^ 2). Lemma prod_norm_triangle : forall x y : U * V, prod_norm (plus x y) <= prod_norm x + prod_norm y. Proof. intros [xu xv] [yu yv]. rewrite /prod_norm /= !Rmult_1_r. apply Rle_trans with (sqrt (Rsqr (norm xu + norm yu) + Rsqr (norm xv + norm yv))). - apply sqrt_le_1_alt. apply Rplus_le_compat. apply Rsqr_le_abs_1. rewrite -> 2!Rabs_pos_eq. apply: norm_triangle. apply Rplus_le_le_0_compat ; apply norm_ge_0. apply norm_ge_0. apply Rsqr_le_abs_1. rewrite -> 2!Rabs_pos_eq. apply: norm_triangle. apply Rplus_le_le_0_compat ; apply norm_ge_0. apply norm_ge_0. - apply Rsqr_incr_0_var. apply Rminus_le_0. unfold Rsqr ; simpl ; ring_simplify. rewrite /pow ?Rmult_1_r. rewrite ?sqrt_sqrt ; ring_simplify. replace (-2 * norm xu * norm yu - 2 * norm xv * norm yv) with (-(2 * (norm xu * norm yu + norm xv * norm yv))) by ring. rewrite Rmult_assoc -sqrt_mult. rewrite Rplus_comm. apply -> Rminus_le_0. apply Rmult_le_compat_l. apply Rlt_le, Rlt_0_2. apply Rsqr_incr_0_var. apply Rminus_le_0. rewrite /Rsqr ?sqrt_sqrt ; ring_simplify. replace (norm xu ^ 2 * norm yv ^ 2 - 2 * norm xu * norm xv * norm yu * norm yv + norm xv ^ 2 * norm yu ^ 2) with ((norm xu * norm yv - norm xv * norm yu) ^ 2) by ring. apply pow2_ge_0. repeat apply Rplus_le_le_0_compat ; apply Rmult_le_pos ; apply pow2_ge_0. apply sqrt_pos. apply Rplus_le_le_0_compat ; apply Rle_0_sqr. apply Rplus_le_le_0_compat ; apply Rle_0_sqr. replace (norm xu ^ 2 + 2 * norm xu * norm yu + norm yu ^ 2 + norm xv ^ 2 + 2 * norm xv * norm yv + norm yv ^ 2) with ((norm xu + norm yu) ^ 2 + (norm xv + norm yv) ^ 2) by ring. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply pow2_ge_0. apply Rplus_le_le_0_compat ; apply sqrt_pos. Qed. Lemma prod_norm_scal : forall (l : K) (x : U * V), prod_norm (scal l x) <= abs l * prod_norm x. Proof. intros l [xu xv]. rewrite /prod_norm /= -(sqrt_Rsqr (abs l)). 2: apply abs_ge_0. rewrite !Rmult_1_r. rewrite -sqrt_mult. 2: apply Rle_0_sqr. apply sqrt_le_1_alt. rewrite Rmult_plus_distr_l. unfold Rsqr. apply Rplus_le_compat. replace (abs l * abs l * (norm xu * norm xu)) with ((abs l * norm xu) * (abs l * norm xu)) by ring. apply Rmult_le_compat. apply norm_ge_0. apply norm_ge_0. exact (norm_scal l xu). exact (norm_scal l xu). replace (abs l * abs l * (norm xv * norm xv)) with ((abs l * norm xv) * (abs l * norm xv)) by ring. apply Rmult_le_compat. apply norm_ge_0. apply norm_ge_0. exact (norm_scal l xv). exact (norm_scal l xv). apply Rplus_le_le_0_compat ; apply Rle_0_sqr. Qed. Lemma prod_norm_compat1 : forall (x y : U * V) (eps : R), prod_norm (minus y x) < eps -> ball x eps y. Proof. intros [xu xv] [yu yv] eps H. generalize (Rle_lt_trans _ _ _ (proj1 (sqrt_plus_sqr _ _)) H). rewrite -> !Rabs_pos_eq by apply norm_ge_0. intros H'. split ; apply norm_compat1 ; apply Rle_lt_trans with (2 := H'). apply Rmax_l. apply Rmax_r. Qed. Definition prod_norm_factor := sqrt 2 * Rmax (@norm_factor K U) (@norm_factor K V). Lemma prod_norm_compat2 : forall (x y : U * V) (eps : posreal), ball x eps y -> prod_norm (minus y x) < prod_norm_factor * eps. Proof. intros [xu xv] [yu yv] eps [Bu Bv]. apply Rle_lt_trans with (1 := proj2 (sqrt_plus_sqr _ _)). simpl. rewrite Rmult_assoc. apply Rmult_lt_compat_l. apply sqrt_lt_R0. apply Rlt_0_2. rewrite -> !Rabs_pos_eq by apply norm_ge_0. rewrite Rmax_mult. apply Rmax_case. apply Rlt_le_trans with (2 := Rmax_l _ _). now apply norm_compat2. apply Rlt_le_trans with (2 := Rmax_r _ _). now apply norm_compat2. apply Rlt_le. apply cond_pos. Qed. Lemma prod_norm_eq_zero : forall x : U * V, prod_norm x = 0 -> x = zero. Proof. intros [xu xv] H. apply sqrt_eq_0 in H. rewrite !(pow_Rsqr _ 1) !pow_1 in H. apply Rplus_sqr_eq_0 in H. destruct H as [H1 H2]. apply norm_eq_zero in H1. apply norm_eq_zero in H2. simpl in H1, H2. now rewrite H1 H2. apply Rplus_le_le_0_compat ; apply pow2_ge_0. Qed. End prod_NormedModule. Definition prod_NormedModule_mixin (K : AbsRing) (U V : NormedModule K) := NormedModule.Mixin K _ (@prod_norm K U V) prod_norm_factor prod_norm_triangle prod_norm_scal prod_norm_compat1 prod_norm_compat2 prod_norm_eq_zero. Canonical prod_NormedModule (K : AbsRing) (U V : NormedModule K) := NormedModule.Pack K (U * V) (NormedModule.Class K (U * V) _ (prod_NormedModule_mixin K U V)) (U * V). Lemma norm_prod {K : AbsRing} {U : NormedModule K} {V : NormedModule K} (x : U) (y : V) : Rmax (norm x) (norm y) <= norm (x,y) <= sqrt 2 * Rmax (norm x) (norm y). Proof. rewrite -(Rabs_pos_eq (norm x)). rewrite -(Rabs_pos_eq (norm y)). apply sqrt_plus_sqr. by apply norm_ge_0. by apply norm_ge_0. Qed. (** ** Iterated Products *) Fixpoint Tn (n : nat) (T : Type) : Type := match n with | O => unit | S n => prod T (Tn n T) end. Notation "[ x1 , .. , xn ]" := (pair x1 .. (pair xn tt) .. ). Fixpoint mk_Tn {T} (n : nat) (u : nat -> T) : Tn n T := match n with | O => (tt : Tn O T) | S n => (u O, mk_Tn n (fun n => u (S n))) end. Fixpoint coeff_Tn {T} {n : nat} (x0 : T) : (Tn n T) -> nat -> T := match n with | O => fun (_ : Tn O T) (_ : nat) => x0 | S n' => fun (v : Tn (S n') T) (i : nat) => match i with | O => fst v | S i => coeff_Tn x0 (snd v) i end end. Lemma mk_Tn_bij {T} {n : nat} (x0 : T) (v : Tn n T) : mk_Tn n (coeff_Tn x0 v) = v. Proof. induction n ; simpl. now apply unit_ind. rewrite IHn ; by destruct v. Qed. Lemma coeff_Tn_bij {T} {n : nat} (x0 : T) (u : nat -> T) : forall i, (i < n)%nat -> coeff_Tn x0 (mk_Tn n u) i = u i. Proof. revert u ; induction n => /= u i Hi. by apply Nat.nlt_0_r in Hi. destruct i. by []. now apply (IHn (fun n => u (S n))), Nat.succ_lt_mono. Qed. Lemma coeff_Tn_ext {T} {n : nat} (x1 x2 : T) (v1 v2 : Tn n T) : v1 = v2 <-> forall i, (i < n)%nat -> coeff_Tn x1 v1 i = coeff_Tn x2 v2 i. Proof. split. + move => -> {v1}. induction n => i Hi. by apply Nat.nlt_0_r in Hi. destruct i ; simpl. by []. by apply IHn, Nat.succ_lt_mono. + induction n => H. apply unit_ind ; move: (v1) ; now apply unit_ind. apply injective_projections. by apply (H O), Nat.lt_0_succ. apply IHn => i Hi. by apply (H (S i)), (proj1 (Nat.succ_lt_mono _ _)). Qed. Lemma mk_Tn_ext {T} (n : nat) (u1 u2 : nat -> T) : (forall i, (i < n)%nat -> (u1 i) = (u2 i)) <-> (mk_Tn n u1) = (mk_Tn n u2). Proof. move: u1 u2 ; induction n ; simpl ; split ; intros. by []. by apply Nat.nlt_0_r in H0. apply f_equal2. by apply H, Nat.lt_0_succ. apply IHn => i Hi. by apply H, (proj1 (Nat.succ_lt_mono _ _)). destruct i. by apply (f_equal (@fst _ _)) in H. move: i {H0} (proj2 (Nat.succ_lt_mono _ _) H0). apply IHn. by apply (f_equal (@snd _ _)) in H. Qed. (* Global Instance AbelianGroup_Tn {T} : AbelianGroup T -> forall n, AbelianGroup (Tn n T) | 10. Proof. intro GT. elim => /= [ | n IH]. - apply Build_AbelianGroup with (fun _ _ => tt) (fun _ => tt) tt ; auto. by apply unit_ind. - by apply AbelianGroup_prod. Defined. Global Instance MetricBall_Tn : forall T, MetricBall T -> forall n, MetricBall (Tn n T) | 10. Proof. intros T MT n. elim: n => [ | n MTn]. by apply Build_MetricBall with (fun _ _ _ => True). by apply MetricBall_prod. Defined. Global Instance VectorSpace_mixin_Tn {T} {K} {FK : Ring K} : forall GT : AbelianGroup T, VectorSpace_mixin T K GT -> forall n, VectorSpace_mixin (Tn n T) K (AbelianGroup_Tn GT n) | 10. Proof. intros GT VV. elim => [ | n VVn]. apply Build_VectorSpace_mixin with (fun _ _ => tt) ; by apply unit_ind. by apply VectorSpace_mixin_prod. Defined. Global Instance VectorSpace_Tn {T} {K} {FK : Ring K} : VectorSpace T K -> forall n, VectorSpace (Tn n T) K | 10. Proof. intros VV n. apply Build_VectorSpace with (AbelianGroup_Tn _ n). now apply VectorSpace_mixin_Tn, VV. Defined. Global Instance NormedVectorSpace_Tn {T} {K} {FK : AbsRing K} : NormedVectorSpace T K -> forall n, NormedVectorSpace (Tn n T) K | 10. Proof. move => VT. elim => [ | n NVTn]. - econstructor. apply Build_NormedVectorSpace_mixin with (fun _ => 0). move => _ _. rewrite Rplus_0_l ; by apply Rle_refl. move => l _ ; rewrite Rmult_0_r ; by apply Rle_refl. easy. exists (mkposreal _ Rlt_0_1). intros x y eps _. rewrite Rmult_1_l. apply cond_pos. - by apply NormedVectorSpace_prod. Defined. *) (** *) Fixpoint Fn (n : nat) (T U : Type) : Type := match n with | O => U | S n => T -> Fn n T U end. (* Global Instance MetricBall_Fn {T M} (n : nat) : MetricBall M -> MetricBall (Fn n T M) | 10. Proof. intros MM. elim: n => /= [ | n IHn]. exact MM. exact (MetricBall_fct IHn). Defined. *) (** ** Matrices *) Section Matrices. Context {T : Type}. Definition matrix (m n : nat) := Tn m (Tn n T). Definition coeff_mat {m n : nat} (x0 : T) (A : matrix m n) (i j : nat) := coeff_Tn x0 (coeff_Tn (mk_Tn _ (fun _ => x0)) A i) j. Definition mk_matrix (m n : nat) (U : nat -> nat -> T) : matrix m n := mk_Tn m (fun i => (mk_Tn n (U i))). Lemma mk_matrix_bij {m n : nat} (x0 : T) (A : matrix m n) : mk_matrix m n (coeff_mat x0 A) = A. Proof. unfold mk_matrix, coeff_mat. unfold matrix in A. rewrite -{2}(mk_Tn_bij (mk_Tn _ (fun _ => x0)) A). apply mk_Tn_ext. intros i Hi. by rewrite mk_Tn_bij. Qed. Lemma coeff_mat_bij {m n : nat} (x0 : T) (u : nat -> nat -> T) : forall i j, (i < m)%nat -> (j < n)%nat -> coeff_mat x0 (mk_matrix m n u) i j = u i j. Proof. intros i j Hi Hj. unfold mk_matrix, coeff_mat. by rewrite 2?coeff_Tn_bij . Qed. Lemma coeff_mat_ext_aux {m n : nat} (x1 x2 : T) (v1 v2 : matrix m n) : v1 = v2 <-> forall i j, (i < m)%nat -> (j < n)%nat -> (coeff_mat x1 v1 i j) = (coeff_mat x2 v2 i j). Proof. split => Hv. + move => i j Hi Hj. by repeat apply coeff_Tn_ext. + unfold matrix in v1, v2. rewrite -(mk_matrix_bij x1 v1) -(mk_matrix_bij x2 v2). unfold mk_matrix. apply mk_Tn_ext => i Hi. apply mk_Tn_ext => j Hj. by apply Hv. Qed. Lemma coeff_mat_ext {m n : nat} (x0 : T) (v1 v2 : matrix m n) : v1 = v2 <-> forall i j, (coeff_mat x0 v1 i j) = (coeff_mat x0 v2 i j). Proof. split. by move => ->. intro H. now apply (coeff_mat_ext_aux x0 x0 v1 v2). Qed. Lemma mk_matrix_ext (m n : nat) (u1 u2 : nat -> nat -> T) : (forall i j, (i < m)%nat -> (j < n)%nat -> (u1 i j) = (u2 i j)) <-> (mk_matrix m n u1) = (mk_matrix m n u2). Proof. split => H. + apply (mk_Tn_ext m) => i Hi. apply (mk_Tn_ext n) => j Hj. by apply H. + intros i j Hi Hj. apply (mk_Tn_ext n). apply (mk_Tn_ext m (fun i => mk_Tn n (u1 i)) (fun i => mk_Tn n (u2 i))). apply H. by []. by []. Qed. End Matrices. Section MatrixMonoid. Context {G : AbelianMonoid} {m n : nat}. Definition Mzero := mk_matrix m n (fun i j => @zero G). Definition Mplus (A B : @matrix G m n) := mk_matrix m n (fun i j => plus (coeff_mat zero A i j) (coeff_mat zero B i j)). Lemma Mplus_comm : forall A B : @matrix G m n, Mplus A B = Mplus B A. Proof. intros A B. apply mk_matrix_ext => i j Hi Hj. by apply plus_comm. Qed. Lemma Mplus_assoc : forall A B C : @matrix G m n, Mplus A (Mplus B C) = Mplus (Mplus A B) C. Proof. intros A B C. apply mk_matrix_ext => /= i j Hi Hj. rewrite ?coeff_mat_bij => //. by apply plus_assoc. Qed. Lemma Mplus_zero_r : forall A : @matrix G m n, Mplus A Mzero = A. Proof. intros A. apply (coeff_mat_ext_aux zero zero) => i j Hi Hj. rewrite ?coeff_mat_bij => //=. by apply plus_zero_r. Qed. Definition matrix_AbelianMonoid_mixin := AbelianMonoid.Mixin _ _ _ Mplus_comm Mplus_assoc Mplus_zero_r. Canonical matrix_AbelianMonoid := AbelianMonoid.Pack _ matrix_AbelianMonoid_mixin (@matrix G m n). End MatrixMonoid. Section MatrixGroup. Context {G : AbelianGroup} {m n : nat}. Definition Mopp (A : @matrix G m n) := mk_matrix m n (fun i j => opp (coeff_mat zero A i j)). Lemma Mplus_opp_r : forall A : @matrix G m n, Mplus A (Mopp A) = Mzero. Proof. intros A. apply (coeff_mat_ext_aux zero zero) => i j Hi Hj. rewrite ?coeff_mat_bij => //=. by apply plus_opp_r. Qed. Definition matrix_AbelianGroup_mixin := AbelianGroup.Mixin _ _ Mplus_opp_r. Canonical matrix_AbelianGroup := AbelianGroup.Pack _ (AbelianGroup.Class _ _ matrix_AbelianGroup_mixin) (@matrix G m n). End MatrixGroup. Section MatrixRing. Context {T : Ring}. Fixpoint Mone_seq i j : T := match i,j with | O, O => one | O, S _ | S _, O => zero | S i, S j => Mone_seq i j end. Definition Mone {n} : matrix n n := mk_matrix n n Mone_seq. Lemma Mone_seq_diag : forall i j : nat, i = j -> Mone_seq i j = @one T. Proof. move => i j <- {j}. by induction i. Qed. Lemma Mone_seq_not_diag : forall i j : nat, i <> j -> Mone_seq i j = @zero T. Proof. elim => //= [ | i IHi] j Hij ; destruct j => //=. apply IHi. contradict Hij. by rewrite Hij. Qed. Definition Mmult {n m k} (A : @matrix T n m) (B : @matrix T m k) := mk_matrix n k (fun i j => sum_n (fun l => mult (coeff_mat zero A i l) (coeff_mat zero B l j)) (pred m)). Lemma Mmult_assoc {n m k l} : forall (A : matrix n m) (B : matrix m k) (C : matrix k l), Mmult A (Mmult B C) = Mmult (Mmult A B) C. Proof. intros A B C. apply mk_matrix_ext => n' l' Hn' Hl'. unfold Mmult at 1. - transitivity (sum_n (fun l0 : nat => mult (coeff_mat zero A n' l0) (sum_n (fun l1 : nat => mult (coeff_mat zero B l0 l1) (coeff_mat zero C l1 l')) (pred k))) (pred m)). destruct m ; simpl. unfold coeff_mat ; simpl. by rewrite 2!mult_zero_l. apply sum_n_m_ext_loc ; simpl => m' [ _ Hm']. apply f_equal. rewrite coeff_mat_bij //. by apply Nat.lt_succ_r, Hm'. - transitivity (sum_n (fun l0 : nat => sum_n (fun l1 : nat => mult (coeff_mat zero A n' l0) (mult (coeff_mat zero B l0 l1) (coeff_mat zero C l1 l'))) (pred k)) (pred m)). destruct m ; simpl. rewrite /sum_n !sum_n_n. unfold coeff_mat ; simpl. rewrite mult_zero_l. rewrite sum_n_m_mult_l. by rewrite mult_zero_l. apply sum_n_m_ext_loc ; simpl => m' [_ Hm']. apply sym_eq, sum_n_m_mult_l. rewrite sum_n_switch. destruct k ; simpl. unfold coeff_mat ; simpl. rewrite mult_zero_l. rewrite /sum_n sum_n_m_mult_r. by rewrite mult_zero_r. apply sum_n_m_ext_loc => k' [_ Hk']. transitivity (mult (sum_n (fun l1 : nat => mult (coeff_mat zero A n' l1) (coeff_mat zero B l1 k')) (pred m)) (coeff_mat zero C k' l')). rewrite -sum_n_m_mult_r. apply sum_n_m_ext_loc => m' [_ Hm']. apply mult_assoc. apply f_equal2. unfold Mmult ; rewrite coeff_mat_bij //. by apply Nat.lt_succ_r. by []. Qed. Lemma Mmult_one_r {m n} : forall x : matrix m n, Mmult x Mone = x. Proof. intros A. rewrite -{2}(mk_matrix_bij zero A). apply mk_matrix_ext => /= i j Hi Hj. destruct n ; simpl. by apply Nat.nlt_0_r in Hj. move: (coeff_mat zero A) => {} A. erewrite sum_n_ext_loc ; last first. move => /= k Hk. rewrite /Mone coeff_mat_bij //. by apply Nat.lt_succ_r. rewrite /sum_n (sum_n_m_Chasles _ _ j) //. 2: by apply Nat.le_0_l. 2: by apply Nat.lt_succ_r. rewrite (sum_n_m_ext_loc _ (fun _ => zero) (S j)). rewrite sum_n_m_const_zero plus_zero_r. rewrite -/(sum_n _ _). destruct j => //. by rewrite sum_O Mone_seq_diag // mult_one_r. rewrite sum_Sn. rewrite (sum_n_ext_loc _ (fun _ => zero)). rewrite /sum_n sum_n_m_const_zero plus_zero_l. by rewrite Mone_seq_diag // mult_one_r. move => k Hk. rewrite Mone_seq_not_diag. by apply mult_zero_r. by apply MyNat.lt_neq, Nat.lt_succ_r. move => k [Hk _]. rewrite Mone_seq_not_diag. by apply mult_zero_r. by apply sym_not_eq, MyNat.lt_neq. Qed. Lemma Mmult_one_l {m n} : forall x : matrix m n, Mmult Mone x = x. Proof. intros A. rewrite -{2}(mk_matrix_bij zero A). apply mk_matrix_ext => /= i j Hi Hj. destruct m ; simpl. by apply Nat.nlt_0_r in Hi. move: (coeff_mat zero A) => {} A. erewrite sum_n_ext_loc ; last first. move => /= k Hk. rewrite /Mone coeff_mat_bij //. by apply Nat.lt_succ_r. rewrite /sum_n (sum_n_m_Chasles _ _ i) //. 2: by apply Nat.le_0_l. 2: by apply Nat.lt_succ_r. rewrite (sum_n_m_ext_loc _ (fun _ => zero) (S i)). rewrite sum_n_m_const_zero plus_zero_r. rewrite -/(sum_n _ _). destruct i => //. by rewrite sum_O Mone_seq_diag // mult_one_l. rewrite sum_Sn. rewrite (sum_n_ext_loc _ (fun _ => zero)). rewrite /sum_n sum_n_m_const_zero plus_zero_l. by rewrite Mone_seq_diag // mult_one_l. move => k Hk. rewrite Mone_seq_not_diag. by apply mult_zero_l. by apply sym_not_eq, MyNat.lt_neq, Nat.lt_succ_r. move => k [Hk _]. rewrite Mone_seq_not_diag. by apply mult_zero_l. by apply MyNat.lt_neq. Qed. Lemma Mmult_distr_r {m n k} : forall (A B : @matrix T m n) (C : @matrix T n k), Mmult (Mplus A B) C = Mplus (Mmult A C) (Mmult B C). Proof. intros A B C. unfold Mmult, plus ; simpl ; unfold Mplus. apply mk_matrix_ext => i j Hi Hj. rewrite ?coeff_mat_bij => //=. rewrite -sum_n_m_plus. destruct n ; simpl. unfold coeff_mat ; simpl. by rewrite ?mult_zero_l plus_zero_l. apply sum_n_m_ext_loc => l [_ Hl]. rewrite ?coeff_mat_bij => //=. by apply mult_distr_r. by apply Nat.lt_succ_r. Qed. Lemma Mmult_distr_l {m n k} : forall (A : @matrix T m n) (B C : @matrix T n k), Mmult A (Mplus B C) = Mplus (Mmult A B) (Mmult A C). Proof. intros A B C. unfold Mmult, plus ; simpl ; unfold Mplus. apply mk_matrix_ext => i j Hi Hj. rewrite ?coeff_mat_bij => //=. rewrite -sum_n_m_plus. destruct n ; simpl. unfold coeff_mat ; simpl. by rewrite ?mult_zero_l plus_zero_l. apply sum_n_m_ext_loc => l [_ Hl]. rewrite ?coeff_mat_bij => //=. by apply mult_distr_l. by apply Nat.lt_succ_r. Qed. Definition matrix_Ring_mixin {n} := Ring.Mixin _ _ _ (@Mmult_assoc n n n n) Mmult_one_r Mmult_one_l Mmult_distr_r Mmult_distr_l. Canonical matrix_Ring {n} := Ring.Pack (@matrix T n n) (Ring.Class _ _ matrix_Ring_mixin) (@matrix T n n). Definition matrix_ModuleSpace_mixin {m n} := ModuleSpace.Mixin (@matrix_Ring m) (@matrix_AbelianGroup T m n) Mmult Mmult_assoc Mmult_one_l Mmult_distr_l Mmult_distr_r. Canonical matrix_ModuleSpace {m n} := ModuleSpace.Pack _ (@matrix T m n) (ModuleSpace.Class _ _ _ matrix_ModuleSpace_mixin) (@matrix T m n). End MatrixRing. (** * The topology on natural numbers *) Definition eventually (P : nat -> Prop) := exists N : nat, forall n, (N <= n)%nat -> P n. Global Instance eventually_filter : ProperFilter eventually. Proof. constructor. intros P [N H]. exists N. apply H. apply Nat.le_refl. constructor. - now exists 0%nat. - intros P Q [NP HP] [NQ HQ]. exists (max NP NQ). intros n Hn. split. apply HP. apply Nat.le_trans with (2 := Hn). apply Nat.le_max_l. apply HQ. apply Nat.le_trans with (2 := Hn). apply Nat.le_max_r. - intros P Q H [NP HP]. exists NP. intros n Hn. apply H. now apply HP. Qed. (** * The topology on real numbers *) Definition R_AbelianMonoid_mixin := AbelianMonoid.Mixin _ _ _ Rplus_comm (fun x y z => sym_eq (Rplus_assoc x y z)) Rplus_0_r. Canonical R_AbelianMonoid := AbelianMonoid.Pack _ R_AbelianMonoid_mixin R. Definition R_AbelianGroup_mixin := AbelianGroup.Mixin _ _ Rplus_opp_r. Canonical R_AbelianGroup := AbelianGroup.Pack _ (AbelianGroup.Class _ _ R_AbelianGroup_mixin) R. Definition R_Ring_mixin := Ring.Mixin _ _ _ (fun x y z => sym_eq (Rmult_assoc x y z)) Rmult_1_r Rmult_1_l Rmult_plus_distr_r Rmult_plus_distr_l. Canonical R_Ring := Ring.Pack R (Ring.Class _ _ R_Ring_mixin) R. Lemma Rabs_m1 : Rabs (-1) = 1. Proof. rewrite Rabs_Ropp. exact Rabs_R1. Qed. Definition R_AbsRing_mixin := AbsRing.Mixin _ _ Rabs_R0 Rabs_m1 Rabs_triang (fun x y => Req_le _ _ (Rabs_mult x y)) Rabs_eq_0. Canonical R_AbsRing := AbsRing.Pack R (AbsRing.Class _ _ R_AbsRing_mixin) R. Definition R_UniformSpace_mixin := AbsRing_UniformSpace_mixin R_AbsRing. Canonical R_UniformSpace := UniformSpace.Pack R R_UniformSpace_mixin R. Definition R_complete_lim (F : (R -> Prop) -> Prop) : R := Lub_Rbar (fun x : R => F (ball (x + 1) (mkposreal _ Rlt_0_1))). Lemma R_complete_ax1 : forall F : (R -> Prop) -> Prop, ProperFilter' F -> (forall eps : posreal, exists x : R, F (ball x eps)) -> forall eps : posreal, F (ball (R_complete_lim F) eps). Proof. intros F FF HF eps. unfold R_complete_lim. generalize (Lub_Rbar_correct (fun x : R => F (ball (x + 1) (mkposreal _ Rlt_0_1)))). generalize (Lub_Rbar (fun x : R => F (ball (x + 1) (mkposreal _ Rlt_0_1)))). intros [x| |] [Hx1 Hx2]. - set (eps' := pos_div_2 (mkposreal _ (Rmin_case _ _ _ Rlt_R0_R2 (cond_pos eps)))). destruct (HF eps') as [z Hz]. assert (H1 : z - Rmin 2 eps / 2 + 1 <= x + 1). apply Rplus_le_compat_r. apply Hx1. revert Hz. apply filter_imp. unfold ball ; simpl ; intros u Bu. apply (Rabs_lt_between' u z) in Bu. apply Rabs_lt_between'. clear -Bu. destruct Bu as [Bu1 Bu2]. assert (H := Rmin_l 2 eps). split ; lra. assert (H2 : x + 1 <= z + Rmin 2 eps / 2 + 1). apply Rplus_le_compat_r. apply (Hx2 (Finite _)). intros v Hv. apply Rbar_not_lt_le => Hlt. apply filter_not_empty. generalize (filter_and _ _ Hz Hv). apply filter_imp. unfold ball ; simpl ; intros w [Hw1 Hw2]. apply (Rabs_lt_between' w z) in Hw1. destruct Hw1 as [_ Hw1]. apply (Rabs_lt_between' w (v + 1)) in Hw2. destruct Hw2 as [Hw2 _]. clear -Hw1 Hw2 Hlt. simpl in Hw1, Hw2, Hlt. lra. revert Hz. apply filter_imp. unfold ball ; simpl ; intros u Hu. apply (Rabs_lt_between' u z) in Hu. apply Rabs_lt_between'. assert (H3 := Rmin_l 2 eps). assert (H4 := Rmin_r 2 eps). clear -H1 H2 Hu H3 H4. destruct Hu. split ; lra. - destruct (HF (mkposreal _ Rlt_0_1)) as [y Fy]. elim (Hx2 (y + 1)). intros x Fx. apply Rbar_not_lt_le => Hlt. apply filter_not_empty. generalize (filter_and _ _ Fy Fx). apply filter_imp. intros z [Hz1 Hz2]. revert Hlt. apply Rbar_le_not_lt. apply Rplus_le_reg_r with (-(y - 1)). replace (y + 1 + -(y - 1)) with 2 by ring. apply Rabs_le_between. apply Rlt_le. generalize (ball_triangle y z (x + 1) 1 1) => /= H. replace (x + -(y - 1)) with ((x + 1) - y) by ring. apply H. apply Hz1. apply ball_sym in Hz2. apply Hz2. - destruct (HF (mkposreal _ Rlt_0_1)) as [y Fy]. elim (Hx1 (y - 1)). now replace (y - 1 + 1) with y by ring. Qed. Lemma R_complete : forall F : (R -> Prop) -> Prop, ProperFilter F -> (forall eps : posreal, exists x : R, F (ball x eps)) -> forall eps : posreal, F (ball (R_complete_lim F) eps). Proof. intros F FF. apply R_complete_ax1. by apply Proper_StrongProper. Qed. Lemma R_complete_ax2 : forall F1 F2 : (R -> Prop) -> Prop, filter_le F1 F2 -> filter_le F2 F1 -> R_complete_lim F1 = R_complete_lim F2. Proof. intros F1 F2 H12 H21. unfold R_complete_lim. apply f_equal, Lub_Rbar_eqset. split. apply H21. apply H12. Qed. Lemma R_complete_close : forall F1 F2 : (R -> Prop) -> Prop, filter_le F1 F2 -> filter_le F2 F1 -> close (R_complete_lim F1) (R_complete_lim F2). Proof. intros F1 F2 H12 H21. replace (R_complete_lim F2) with (R_complete_lim F1). intros eps. apply ball_center. exact: R_complete_ax2. Qed. Definition R_CompleteSpace_mixin := CompleteSpace.Mixin _ R_complete_lim R_complete R_complete_close. Canonical R_CompleteSpace := CompleteSpace.Pack R (CompleteSpace.Class _ _ R_CompleteSpace_mixin) R. Definition R_ModuleSpace_mixin := AbsRing_ModuleSpace_mixin R_AbsRing. Canonical R_ModuleSpace := ModuleSpace.Pack _ R (ModuleSpace.Class _ _ _ R_ModuleSpace_mixin) R. Canonical R_NormedModuleAux := NormedModuleAux.Pack _ R (NormedModuleAux.Class _ _ (ModuleSpace.class _ R_ModuleSpace) (UniformSpace.class R_UniformSpace)) R. Definition R_NormedModule_mixin := AbsRing_NormedModule_mixin R_AbsRing. Canonical R_NormedModule := NormedModule.Pack _ R (NormedModule.Class _ _ _ R_NormedModule_mixin) R. Canonical R_CompleteNormedModule := CompleteNormedModule.Pack _ R (CompleteNormedModule.Class R_AbsRing _ (NormedModule.class _ R_NormedModule) R_CompleteSpace_mixin) R. Definition at_left x := within (fun u : R => Rlt u x) (locally x). Definition at_right x := within (fun u : R => Rlt x u) (locally x). Global Instance at_right_proper_filter : forall (x : R), ProperFilter (at_right x). Proof. constructor. intros P [d Hd]. exists (x + d / 2). apply Hd. apply @norm_compat1 ; rewrite /norm /minus /plus /opp /= /abs /=. ring_simplify (x + d / 2 + - x). rewrite Rabs_pos_eq. apply Rlt_div_l. by apply Rlt_0_2. apply Rminus_lt_0 ; ring_simplify ; by apply d. apply Rlt_le, is_pos_div_2. apply Rminus_lt_0 ; ring_simplify ; by apply is_pos_div_2. apply within_filter, locally_filter. Qed. Global Instance at_left_proper_filter : forall (x : R), ProperFilter (at_left x). Proof. constructor. intros P [d Hd]. exists (x - d / 2). apply Hd. apply @norm_compat1 ; rewrite /norm /minus /plus /opp /= /abs /=. ring_simplify (x - d / 2 + - x). rewrite Rabs_Ropp Rabs_pos_eq. apply Rlt_div_l. by apply Rlt_0_2. apply Rminus_lt_0 ; ring_simplify ; by apply d. apply Rlt_le, is_pos_div_2. apply Rminus_lt_0 ; ring_simplify ; by apply is_pos_div_2. apply within_filter, locally_filter. Qed. (* *) Lemma sum_n_Reals : forall a N, sum_n a N = sum_f_R0 a N. Proof. intros a; induction N; simpl. apply sum_n_n. by rewrite sum_Sn IHN. Qed. Lemma sum_n_m_Reals a n m : (n <= m)%nat -> sum_n_m a n m = sum_f n m a. Proof. induction m => //= Hnm. apply Nat.le_0_r in Hnm. by rewrite Hnm sum_n_n /=. case: (le_dec n m) => H. rewrite sum_n_Sm // IHm //. rewrite sum_f_n_Sm //. replace n with (S m). rewrite sum_n_n. by rewrite /sum_f Nat.sub_diag /=. apply Nat.le_antisymm => //. apply not_le in H. by apply Nat.le_succ_l. Qed. Lemma sum_n_m_const (n m : nat) (a : R) : sum_n_m (fun _ => a) n m = INR (S m - n) * a. Proof. rewrite /sum_n_m /iter_nat (iter_const _ a). by rewrite -{2}(seq.size_iota n (S m - n)). Qed. Lemma sum_n_const (n : nat) (a : R) : sum_n (fun _ => a) n = INR (S n) * a. Proof. by rewrite /sum_n sum_n_m_const Nat.sub_0_r. Qed. Lemma norm_sum_n_m {K : AbsRing} {V : NormedModule K} (a : nat -> V) (n m : nat) : norm (sum_n_m a n m) <= sum_n_m (fun n => norm (a n)) n m. Proof. case: (le_dec n m) => Hnm. elim: m n a Hnm => /= [ | m IH] n a Hnm. apply Nat.le_0_r in Hnm. rewrite -Hnm !sum_n_n. by apply Rle_refl. destruct n. rewrite /sum_n !sum_n_Sm ; try by apply Nat.le_0_l. eapply Rle_trans. apply norm_triangle. apply Rplus_le_compat_r, IH, Nat.le_0_l. rewrite -!sum_n_m_S. apply IH. by apply le_S_n. apply not_le in Hnm. rewrite !sum_n_m_zero // norm_zero. by apply Rle_refl. Qed. Lemma sum_n_m_le (a b : nat -> R) (n m : nat) : (forall k, a k <= b k) -> sum_n_m a n m <= sum_n_m b n m. Proof. intros H. case: (le_dec n m) => Hnm. elim: m n a b Hnm H => /= [ | m IH] n a b Hnm H. apply Nat.le_0_r in Hnm ; rewrite -Hnm. rewrite !sum_n_n ; by apply H. destruct n. rewrite !sum_n_Sm ; try by apply Nat.le_0_l. apply Rplus_le_compat. apply IH => // ; by apply Nat.le_0_l. by apply H. rewrite -!sum_n_m_S. apply IH => //. by apply le_S_n. apply not_le in Hnm. rewrite !sum_n_m_zero //. by apply Rle_refl. Qed. Lemma pow_n_pow : forall (x : R) k, pow_n x k = x^k. Proof. intros x; induction k; simpl. easy. now rewrite IHk. Qed. (** Continuity of norm *) Lemma filterlim_norm {K : AbsRing} {V : NormedModule K} : forall (x : V), filterlim norm (locally x) (locally (norm x)). Proof. intros x. apply (filterlim_filter_le_1 _ (locally_le_locally_norm x)). apply filterlim_locally => eps /=. exists eps ; move => /= y Hy. apply Rle_lt_trans with (2 := Hy). apply norm_triangle_inv. Qed. Lemma filterlim_norm_zero {U} {K : AbsRing} {V : NormedModule K} {F : (U -> Prop) -> Prop} {FF : Filter F} (f : U -> V) : filterlim (fun x => norm (f x)) F (locally 0) -> filterlim f F (locally (zero (G := V))). Proof. intros Hf. apply filterlim_locally_ball_norm => eps. generalize (proj1 (filterlim_locally_ball_norm _ _) Hf eps) ; unfold ball_norm ; simpl. apply filter_imp => /= x. rewrite !minus_zero_r {1}/norm /= /abs /= Rabs_pos_eq //. by apply norm_ge_0. Qed. Lemma filterlim_bounded {K : AbsRing} {V : NormedModule K} (a : nat -> V) : (exists x, filterlim a eventually (locally x)) -> {M : R | forall n, norm (a n) <= M}. Proof. intros Ha. assert (exists x : R, filterlim (fun n => norm (a n)) eventually (locally x)). destruct Ha as [l Hl]. exists (norm l). eapply filterlim_comp. by apply Hl. by apply filterlim_norm. clear Ha. destruct (LPO_ub_dec (fun n => norm (a n))) as [[M HM]|HM]. now exists M. exfalso. case: H => l Hl. assert (H := proj1 (filterlim_locally (F := eventually) _ l) Hl (mkposreal _ Rlt_0_1)). clear Hl ; simpl in H ; rewrite /ball /= /AbsRing_ball in H. destruct H as [N HN]. specialize (HM (seq.foldr Rmax (1 + norm l) (seq.map (fun n => norm (a n)) (seq.iota 0 N)))). destruct HM as [n Hn]. revert Hn. apply Rle_not_lt. elim: N a n HN => /=[ |N IH] a n HN. rewrite Rplus_comm. apply Rlt_le, Rabs_lt_between'. eapply Rle_lt_trans, HN. rewrite /abs /=. eapply Rle_trans, (norm_triangle_inv (norm (a n)) l). apply Req_le, f_equal, f_equal2 => //. apply sym_eq, Rabs_pos_eq, norm_ge_0. by apply Nat.le_0_l. case: n => [ | n]. apply Rmax_l. eapply Rle_trans, Rmax_r. eapply Rle_trans. apply (IH (fun n => a (S n))). intros k Hk. apply HN. by apply le_n_S. clear. apply Req_le. elim: N 0%nat => /=[ |N IH] n0. by []. apply f_equal. apply IH. Qed. (** Some open sets of [R] *) Lemma open_lt : forall y : R, open (fun u : R => u < y). Proof. intros y x Hxy. apply Rminus_lt_0 in Hxy. exists (mkposreal _ Hxy). intros z Bz. replace y with (x + (y - x)) by ring. apply Rabs_lt_between'. apply Bz. Qed. Lemma open_gt : forall y : R, open (fun u : R => y < u). Proof. intros y x Hxy. apply Rminus_lt_0 in Hxy. exists (mkposreal _ Hxy). intros z Bz. replace y with (x - (x - y)) by ring. apply Rabs_lt_between'. apply Bz. Qed. Lemma open_neq : forall y : R, open (fun u : R => u <> y). Proof. intros y. apply (open_ext (fun u => u < y \/ y < u)). intros u. split. apply Rlt_dichotomy_converse. apply Rdichotomy. apply open_or. apply open_lt. apply open_gt. Qed. (** Some closed sets of [R] *) Lemma closed_le : forall y : R, closed (fun u : R => u <= y). Proof. intros y. apply closed_ext with (fun u => not (Rlt y u)). intros x. split. apply Rnot_lt_le. apply Rle_not_lt. apply closed_not. apply open_gt. Qed. Lemma closed_ge : forall y : R, closed (fun u : R => y <= u). Proof. intros y. apply closed_ext with (fun u => not (Rlt u y)). intros x. split. apply Rnot_lt_le. apply Rle_not_lt. apply closed_not. apply open_lt. Qed. Lemma closed_eq : forall y : R, closed (fun u : R => u = y). Proof. intros y. apply closed_ext with (fun u => not (u <> y)). intros x. destruct (Req_dec x y) ; intuition. apply closed_not. apply open_neq. Qed. (** Local properties in [R] *) Lemma locally_interval (P : R -> Prop) (x : R) (a b : Rbar) : Rbar_lt a x -> Rbar_lt x b -> (forall (y : R), Rbar_lt a y -> Rbar_lt y b -> P y) -> locally x P. Proof. move => Hax Hxb Hp. case: (Rbar_lt_locally _ _ _ Hax Hxb) => d Hd. exists d => y Hy. now apply Hp ; apply Hd. Qed. (** * Topology on [R]² *) Definition locally_2d (P : R -> R -> Prop) x y := exists delta : posreal, forall u v, Rabs (u - x) < delta -> Rabs (v - y) < delta -> P u v. Lemma locally_2d_locally : forall P x y, locally_2d P x y <-> locally (x,y) (fun z => P (fst z) (snd z)). Proof. intros P x y. split ; intros [d H] ; exists d. - simpl. intros [u v] H'. now apply H ; apply H'. - intros u v Hu Hv. apply (H (u,v)). by split. Qed. Lemma locally_2d_impl_strong : forall (P Q : R -> R -> Prop) x y, locally_2d (fun u v => locally_2d P u v -> Q u v) x y -> locally_2d P x y -> locally_2d Q x y. Proof. intros P Q x y Li LP. apply locally_2d_locally in Li. apply locally_2d_locally in LP. apply locally_locally in LP. apply locally_2d_locally. generalize (filter_and _ _ Li LP). apply filter_imp. intros [u v] [H1 H2]. apply H1. now apply locally_2d_locally. Qed. Lemma locally_2d_singleton : forall (P : R -> R -> Prop) x y, locally_2d P x y -> P x y. Proof. intros P x y LP. apply locally_2d_locally in LP. apply locally_singleton with (1 := LP). Qed. Lemma locally_2d_impl : forall (P Q : R -> R -> Prop) x y, locally_2d (fun u v => P u v -> Q u v) x y -> locally_2d P x y -> locally_2d Q x y. Proof. intros P Q x y (d,H). apply locally_2d_impl_strong. exists d => u v Hu Hv Hp. apply H => //. now apply locally_2d_singleton. Qed. Lemma locally_2d_forall : forall (P : R -> R -> Prop) x y, (forall u v, P u v) -> locally_2d P x y. Proof. intros P x y Hp. now exists (mkposreal _ Rlt_0_1) => u v _ _. Qed. Lemma locally_2d_and : forall (P Q : R -> R -> Prop) x y, locally_2d P x y -> locally_2d Q x y -> locally_2d (fun u v => P u v /\ Q u v) x y. Proof. intros P Q x y H. apply: locally_2d_impl. apply: locally_2d_impl H. apply locally_2d_forall. now split. Qed. Lemma locally_2d_align : forall (P Q : R -> R -> Prop) x y, ( forall eps : posreal, (forall u v, Rabs (u - x) < eps -> Rabs (v - y) < eps -> P u v) -> forall u v, Rabs (u - x) < eps -> Rabs (v - y) < eps -> Q u v ) -> locally_2d P x y -> locally_2d Q x y. Proof. intros P Q x y K (d,H). exists d => u v Hu Hv. now apply (K d). Qed. Lemma locally_2d_1d_const_x : forall (P : R -> R -> Prop) x y, locally_2d P x y -> locally y (fun t => P x t). Proof. intros P x y (d,Hd). exists d; intros z Hz. apply Hd. rewrite Rminus_eq_0 Rabs_R0; apply cond_pos. exact Hz. Qed. Lemma locally_2d_1d_const_y : forall (P : R -> R -> Prop) x y, locally_2d P x y -> locally x (fun t => P t y). Proof. intros P x y (d,Hd). exists d; intros z Hz. apply Hd. exact Hz. rewrite Rminus_eq_0 Rabs_R0; apply cond_pos. Qed. Lemma locally_2d_1d_strong : forall (P : R -> R -> Prop) x y, locally_2d P x y -> locally_2d (fun u v => forall t, 0 <= t <= 1 -> locally t (fun z => locally_2d P (x + z * (u - x)) (y + z * (v - y)))) x y. Proof. intros P x y. apply locally_2d_align => eps HP u v Hu Hv t Ht. assert (Zm: 0 <= Rmax (Rabs (u - x)) (Rabs (v - y))). apply Rmax_case ; apply Rabs_pos. destruct Zm as [Zm|Zm]. (* *) assert (H1: Rmax (Rabs (u - x)) (Rabs (v - y)) < eps). now apply Rmax_case. set (d1 := mkposreal _ (Rlt_Rminus _ _ H1)). assert (H2: 0 < pos_div_2 d1 / Rmax (Rabs (u - x)) (Rabs (v - y))). apply Rmult_lt_0_compat. apply cond_pos. now apply Rinv_0_lt_compat. set (d2 := mkposreal _ H2). exists d2 => z Hz. exists (pos_div_2 d1) => p q Hp Hq. apply HP. (* . *) replace (p - x) with (p - (x + z * (u - x)) + (z - t + t) * (u - x)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). replace (pos eps) with (pos_div_2 d1 + (eps - pos_div_2 d1)) by ring. apply Rplus_lt_le_compat with (1 := Hp). rewrite Rabs_mult. apply Rle_trans with ((d2 + 1) * Rmax (Rabs (u - x)) (Rabs (v - y))). apply Rmult_le_compat. apply Rabs_pos. apply Rabs_pos. apply Rle_trans with (1 := Rabs_triang _ _). apply Rplus_le_compat. now apply Rlt_le. now rewrite Rabs_pos_eq. apply Rmax_l. rewrite /d2 /d1 /=. field_simplify. apply Rle_refl. now apply Rgt_not_eq. (* . *) replace (q - y) with (q - (y + z * (v - y)) + (z - t + t) * (v - y)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). replace (pos eps) with (pos_div_2 d1 + (eps - pos_div_2 d1)) by ring. apply Rplus_lt_le_compat with (1 := Hq). rewrite Rabs_mult. apply Rle_trans with ((d2 + 1) * Rmax (Rabs (u - x)) (Rabs (v - y))). apply Rmult_le_compat. apply Rabs_pos. apply Rabs_pos. apply Rle_trans with (1 := Rabs_triang _ _). apply Rplus_le_compat. now apply Rlt_le. now rewrite Rabs_pos_eq. apply Rmax_r. rewrite /d2 /d1 /=. field_simplify. apply Rle_refl. now apply Rgt_not_eq. (* *) apply filter_forall => z. exists eps => p q. replace (u - x) with 0. replace (v - y) with 0. rewrite Rmult_0_r 2!Rplus_0_r. apply HP. apply sym_eq. apply Rabs_eq_0. apply Rle_antisym. rewrite Zm. apply Rmax_r. apply Rabs_pos. apply sym_eq. apply Rabs_eq_0. apply Rle_antisym. rewrite Zm. apply Rmax_l. apply Rabs_pos. Qed. Lemma locally_2d_1d : forall (P : R -> R -> Prop) x y, locally_2d P x y -> locally_2d (fun u v => forall t, 0 <= t <= 1 -> locally_2d P (x + t * (u - x)) (y + t * (v - y))) x y. Proof. intros P x y H. apply locally_2d_1d_strong in H. apply: locally_2d_impl H. apply locally_2d_forall => u v H t Ht. specialize (H t Ht). apply locally_singleton with (1 := H). Qed. Lemma locally_2d_ex_dec : forall P x y, (forall x y, P x y \/ ~P x y) -> locally_2d P x y -> {d : posreal | forall u v, Rabs (u-x) < d -> Rabs (v-y) < d -> P u v}. Proof. intros P x y P_dec H. destruct (locally_ex_dec (x, y) (fun z => P (fst z) (snd z))) as [d Hd]. - now intros [u v]. - destruct H as [e H]. exists e. intros [u v] Huv. apply H. apply Huv. apply Huv. exists d. intros u v Hu Hv. apply (Hd (u, v)). simpl. now split. Qed. (** * Some Topology on [Rbar] *) Definition Rbar_locally' (a : Rbar) (P : R -> Prop) := match a with | Finite a => locally' a P | p_infty => exists M : R, forall x, M < x -> P x | m_infty => exists M : R, forall x, x < M -> P x end. Definition Rbar_locally (a : Rbar) (P : R -> Prop) := match a with | Finite a => locally a P | p_infty => exists M : R, forall x, M < x -> P x | m_infty => exists M : R, forall x, x < M -> P x end. Global Instance Rbar_locally'_filter : forall x, ProperFilter (Rbar_locally' x). Proof. intros [x| |] ; (constructor ; [idtac | constructor]). - intros P [eps HP]. exists (x + eps / 2). apply HP. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. ring_simplify (x + eps / 2 + - x). rewrite Rabs_pos_eq. apply Rminus_lt_0. replace (eps - eps / 2) with (eps / 2) by field. apply is_pos_div_2. apply Rlt_le, is_pos_div_2. apply Rgt_not_eq, Rminus_lt_0 ; ring_simplify. apply is_pos_div_2. - now exists (mkposreal _ Rlt_0_1). - intros P Q [dP HP] [dQ HQ]. exists (mkposreal _ (Rmin_stable_in_posreal dP dQ)). simpl. intros y Hy H. split. apply HP with (2 := H). apply Rlt_le_trans with (1 := Hy). apply Rmin_l. apply HQ with (2 := H). apply Rlt_le_trans with (1 := Hy). apply Rmin_r. - intros P Q H [dP HP]. exists dP. intros y Hy H'. apply H. now apply HP. - intros P [N HP]. exists (N + 1). apply HP. apply Rlt_plus_1. - now exists 0. - intros P Q [MP HP] [MQ HQ]. exists (Rmax MP MQ). intros y Hy. split. apply HP. apply Rle_lt_trans with (2 := Hy). apply Rmax_l. apply HQ. apply Rle_lt_trans with (2 := Hy). apply Rmax_r. - intros P Q H [dP HP]. exists dP. intros y Hy. apply H. now apply HP. - intros P [N HP]. exists (N - 1). apply HP. apply Rlt_minus_l, Rlt_plus_1. - now exists 0. - intros P Q [MP HP] [MQ HQ]. exists (Rmin MP MQ). intros y Hy. split. apply HP. apply Rlt_le_trans with (1 := Hy). apply Rmin_l. apply HQ. apply Rlt_le_trans with (1 := Hy). apply Rmin_r. - intros P Q H [dP HP]. exists dP. intros y Hy. apply H. now apply HP. Qed. Global Instance Rbar_locally_filter : forall x, ProperFilter (Rbar_locally x). Proof. intros [x| |]. - apply locally_filter. - exact (Rbar_locally'_filter p_infty). - exact (Rbar_locally'_filter m_infty). Qed. (** Open sets in [Rbar] *) Lemma open_Rbar_lt : forall y, open (fun u : R => Rbar_lt u y). Proof. intros [y| |]. - apply open_lt. - apply open_true. - apply open_false. Qed. Lemma open_Rbar_gt : forall y, open (fun u : R => Rbar_lt y u). Proof. intros [y| |]. - apply open_gt. - apply open_false. - apply open_true. Qed. Lemma open_Rbar_lt' : forall x y, Rbar_lt x y -> Rbar_locally x (fun u => Rbar_lt u y). Proof. intros [x| |] y Hxy. - now apply open_Rbar_lt. - easy. - destruct y as [y| |]. now exists y. now apply filter_forall. easy. Qed. Lemma open_Rbar_gt' : forall x y, Rbar_lt y x -> Rbar_locally x (fun u => Rbar_lt y u). Proof. intros [x| |] y Hxy. - now apply open_Rbar_gt. - destruct y as [y| |]. now exists y. easy. now apply filter_forall. - now destruct y as [y| |]. Qed. Lemma Rbar_locally'_le : forall x, filter_le (Rbar_locally' x) (Rbar_locally x). Proof. intros [x| |] P [eps HP] ; exists eps ; intros ; now apply HP. Qed. Lemma Rbar_locally'_le_finite : forall x : R, filter_le (Rbar_locally' x) (locally x). Proof. intros x P [eps HP] ; exists eps ; intros ; now apply HP. Qed. (** * Some limits on real functions *) Definition Rbar_loc_seq (x : Rbar) (n : nat) := match x with | Finite x => x + / (INR n + 1) | p_infty => INR n | m_infty => - INR n end. Lemma filterlim_Rbar_loc_seq : forall x, filterlim (Rbar_loc_seq x) eventually (Rbar_locally' x). Proof. intros x P. unfold Rbar_loc_seq. case: x => /= [x | | ] [delta Hp]. (* x \in R *) case: (nfloor_ex (/delta)) => [ | N [_ HN]]. by apply Rlt_le, Rinv_0_lt_compat, delta. exists N => n Hn. apply Hp ; simpl. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. ring_simplify (x + / (INR n + 1) + - x). rewrite Rabs_pos_eq. rewrite -(Rinv_involutive delta). apply Rinv_lt_contravar. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat. by apply delta. exact: INRp1_pos. apply Rlt_le_trans with (1 := HN). by apply Rplus_le_compat_r, le_INR. by apply Rgt_not_eq, delta. by apply Rlt_le, RinvN_pos. apply Rgt_not_eq, Rminus_lt_0. ring_simplify. by apply RinvN_pos. (* x = p_infty *) case: (nfloor_ex (Rmax 0 delta)) => [ | N [_ HN]]. by apply Rmax_l. exists (S N) => n Hn. apply Hp. apply Rle_lt_trans with (1 := Rmax_r 0 _). apply Rlt_le_trans with (1 := HN). rewrite -S_INR ; by apply le_INR. (* x = m_infty *) case: (nfloor_ex (Rmax 0 (-delta))) => [ | N [_ HN]]. by apply Rmax_l. exists (S N) => n Hn. apply Hp. rewrite -(Ropp_involutive delta). apply Ropp_lt_contravar. apply Rle_lt_trans with (1 := Rmax_r 0 _). apply Rlt_le_trans with (1 := HN). rewrite -S_INR ; by apply le_INR. Qed. Lemma continuity_pt_locally : forall f x, continuity_pt f x <-> forall eps : posreal, locally x (fun u => Rabs (f u - f x) < eps). Proof. intros f x. split. intros H eps. move: (H eps (cond_pos eps)) => {H} [d [H1 H2]]. rewrite /= /R_dist /D_x /no_cond in H2. exists (mkposreal d H1) => y H. destruct (Req_dec x y) as [<-|Hxy]. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. by apply H2. intros H eps He. move: (H (mkposreal _ He)) => {H} [d H]. exists d. split. apply cond_pos. intros h [Zh Hh]. exact: H. Qed. Lemma continuity_pt_locally' : forall f x, continuity_pt f x <-> forall eps : posreal, locally' x (fun u => Rabs (f u - f x) < eps). Proof. intros f x. split. intros H eps. move: (H eps (cond_pos eps)) => {H} [d [H1 H2]]. rewrite /= /R_dist /D_x /no_cond in H2. exists (mkposreal d H1) => y H H'. destruct (Req_dec x y) as [<-|Hxy]. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. by apply H2. intros H eps He. move: (H (mkposreal _ He)) => {H} [d H]. exists d. split. apply cond_pos. intros h [Zh Hh]. apply H. exact Hh. apply proj2 in Zh. now contradict Zh. Qed. Lemma continuity_pt_filterlim : forall (f : R -> R) (x : R), continuity_pt f x <-> filterlim f (locally x) (locally (f x)). Proof. intros f x. eapply iff_trans. apply continuity_pt_locally. apply iff_sym. exact (filterlim_locally f (f x)). Qed. Lemma continuity_pt_filterlim' : forall f x, continuity_pt f x <-> filterlim f (locally' x) (locally (f x)). Proof. intros f x. eapply iff_trans. apply continuity_pt_locally'. apply iff_sym. exact (filterlim_locally f (f x)). Qed. Lemma locally_pt_comp (P : R -> Prop) (f : R -> R) (x : R) : locally (f x) P -> continuity_pt f x -> locally x (fun x => P (f x)). Proof. intros Lf Cf. apply continuity_pt_filterlim in Cf. now apply Cf. Qed. coquelicot-coquelicot-3.4.1/theories/Iter.v000066400000000000000000000116121455143432500207560ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Lia List ssreflect ssrbool. From mathcomp Require Import seq eqtype. Require Import Rcomplements. (** This file describes iterators on lists. This is mainly used for Riemannn sums. *) Section Iter. Context {I T : Type}. Context (op : T -> T -> T). Context (x0 : T). Context (neutral_l : forall x, op x0 x = x). Context (neutral_r : forall x, op x x0 = x). Context (assoc : forall x y z, op x (op y z) = op (op x y) z). Fixpoint iter (l : list I) (f : I -> T) := match l with | nil => x0 | cons h l' => op (f h) (iter l' f) end. Definition iter' (l : list I) (f : I -> T) := fold_right (fun i acc => op (f i) acc) x0 l. Lemma iter_iter' l f : iter l f = iter' l f. Proof. elim: l => [ | h l IH] //=. by rewrite IH. Qed. Lemma iter_cat l1 l2 f : iter (l1 ++ l2) f = op (iter l1 f) (iter l2 f). Proof. elim: l1 => [ | h1 l1 IH] /=. by rewrite neutral_l. by rewrite IH assoc. Qed. Lemma iter_ext l f1 f2 : (forall x, In x l -> f1 x = f2 x) -> iter l f1 = iter l f2. Proof. elim: l => [ | h l IH] /= Heq. by []. rewrite IH. rewrite Heq //. by left. intros x Hx. apply Heq. by right. Qed. Lemma iter_comp (l : list I) f (g : I -> I) : iter l (fun x => f (g x)) = iter (map g l) f. Proof. elim: l => [ | s l IH] //=. by rewrite IH. Qed. End Iter. Lemma iter_const {I} (l : list I) (a : R) : iter Rplus 0 l (fun _ => a) = INR (length l) * a. Proof. elim: l => /= [ | h l ->]. by rewrite /= Rmult_0_l. case: (length l) => [ | n] ; simpl ; ring. Qed. Lemma In_mem {T : eqType} (x : T) l : reflect (In x l) (in_mem x (mem l)). Proof. apply iffP with (P := x \in l). by case: (x \in l) => // ; constructor. elim: l => [ | h l IH] //= E. rewrite in_cons in E. case/orP: E => E. now left ; apply sym_eq ; apply / eqP. right ; by apply IH. elim: l => [ | h l IH] E //=. simpl in E. case : E => E. rewrite E ; apply mem_head. rewrite in_cons. rewrite IH. apply orbT. by []. Qed. Lemma In_iota (n m k : nat) : (n <= m <= k)%nat <-> In m (iota n (S k - n)). Proof. generalize (mem_iota n (S k - n) m). case: In_mem => // H H0. apply sym_eq in H0. case/andP: H0 => H0 H1. apply Rcomplements.SSR_leq in H0. apply SSR_leq in H1. change ssrnat.addn with Peano.plus in H1. split => // _. split => //. case: (le_dec n (S m)). intro ; lia. intro H2. rewrite (proj2 (Nat.sub_0_le _ _)) in H1 => //. contradict H2. by eapply Nat.le_trans, Nat.le_succ_diag_r. contradict H2. by eapply Nat.le_trans, Nat.le_succ_diag_r. change ssrnat.addn with Peano.plus in H0. split => // H1. case: H1 => /= H1 H2. apply sym_eq in H0. apply Bool.andb_false_iff in H0. case: H0 => //. move/SSR_leq: H1 ; by case: ssrnat.leq. rewrite Nat.add_comm Nat.sub_add; [| lia]. move/le_n_S/SSR_leq: H2 ; by case: ssrnat.leq. Qed. Section Iter_nat. Context {T : Type}. Context (op : T -> T -> T). Context (x0 : T). Context (neutral_l : forall x, op x0 x = x). Context (neutral_r : forall x, op x x0 = x). Context (assoc : forall x y z, op x (op y z) = op (op x y) z). Definition iter_nat (a : nat -> T) n m := iter op x0 (iota n (S m - n)) a. Lemma iter_nat_ext_loc (a b : nat -> T) (n m : nat) : (forall k, (n <= k <= m)%nat -> a k = b k) -> iter_nat a n m = iter_nat b n m. Proof. intros Heq. apply iter_ext. intros k Hk. apply Heq. by apply In_iota. Qed. Lemma iter_nat_point a n : iter_nat a n n = a n. Proof. unfold iter_nat. rewrite Nat.sub_succ_l // Nat.sub_diag /=. by apply neutral_r. Qed. Lemma iter_nat_Chasles a n m k : (n <= S m)%nat -> (m <= k)%nat -> iter_nat a n k = op (iter_nat a n m) (iter_nat a (S m) k). Proof. intros Hnm Hmk. rewrite -iter_cat //. pattern (S m) at 2 ; replace (S m) with (ssrnat.addn n (S m - n)). rewrite -?(iota_add n (S m - n)) -?(iotaD n (S m - n)). apply (f_equal (fun k => iter _ _ (iota n k) _)). change ssrnat.addn with Peano.plus. lia. change ssrnat.addn with Peano.plus. lia. Qed. Lemma iter_nat_S a n m : iter_nat (fun n => a (S n)) n m = iter_nat a (S n) (S m). Proof. rewrite /iter_nat iter_comp. apply (f_equal (fun l => iter _ _ l _)). rewrite MyNat.sub_succ. elim: (S m - n)%nat {1 3}(n) => {n m} [ | n IH] m //=. by rewrite IH. Qed. End Iter_nat. coquelicot-coquelicot-3.4.1/theories/KHInt.v000066400000000000000000000531061455143432500210340ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond #
# Copyright (C) 2014 Xavier Onfroy This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect ssrbool. From mathcomp Require Import seq. Require Import Rcomplements Hierarchy SF_seq RInt. (** This file describes the definition and properties of the Henstock–Kurzweil (KH) integral. *) Definition ith_step (ptd : @SF_seq R) i := nth 0 (SF_lx ptd) (S i) - nth 0 (SF_lx ptd) i. Definition fine (delta : R -> posreal) ptd := forall i : nat, (i < SF_size ptd)%nat -> ith_step ptd i < delta (nth 0 (SF_ly ptd) i). Definition KH_filter (P : SF_seq -> Prop) := exists delta, forall ptd, fine delta ptd -> P ptd. Global Instance KH_filter_filter : Filter KH_filter. Proof. split. exists (fun x => {| pos := 1; cond_pos := Rlt_0_1 |}). intros ptd H. easy. intros P Q HP HQ. destruct HP as (deltaP, HP). destruct HQ as (deltaQ, HQ). exists (fun x => {| pos := Rmin (deltaP x) (deltaQ x) ; cond_pos := (Rmin_stable_in_posreal (deltaP x) (deltaQ x))|}). intros ptd Hptd. split. apply HP. intros i Hi. eapply Rlt_le_trans. now apply (Hptd i). apply Rmin_l. apply HQ. intros i Hi. eapply Rlt_le_trans. now apply (Hptd i). apply Rmin_r. intros P Q HPQ HP. destruct HP as (delta, HP). exists delta. intros ptd Hptd. apply HPQ ; now apply HP. Qed. Definition KH_fine (a b : R) := within (fun ptd => pointed_subdiv ptd /\ SF_h ptd = Rmin a b /\ last (SF_h ptd) (SF_lx ptd) = Rmax a b) KH_filter. Lemma lub_cara : forall E l, is_lub E l -> forall e : posreal, ~ ~ (exists x, E x /\ l - e < x). Proof. intros E l H e. intro H0. assert (forall x, ~ (E x /\ l - e < x)) as H1. intros x Hx. apply H0 ; now exists x. clear H0. unfold is_lub in H. destruct H as (H, H0). assert ( ~ is_upper_bound E (l-e)) as H2. intro H2. apply H0 in H2. assert (0 < e) as H3. apply (cond_pos e). assert (l > l - e) as H4. apply tech_Rgt_minus. assumption. unfold Rgt in H4. destruct H2 as [H2 | H2]. assert (l < l) as H5. now apply Rlt_trans with (l-e). apply Rlt_irrefl in H5 ; contradiction. rewrite <- H2 in H4. apply Rlt_irrefl in H4 ; contradiction. unfold is_upper_bound in H2. assert (forall x : R, E x -> x <= l-e) as H3. clear H0 ; clear H. intro x. assert (~ (E x /\ l - e < x)) as H. apply H1. clear H1. intro H0. assert ({l-ex}). apply total_order_T. destruct H1 as [H1 | H1]. destruct H1 as [H1 | H1]. assert (E x /\ l-e < x). now split. contradiction. right ; rewrite H1 ; trivial. now left. contradiction. Qed. Lemma cousin : forall a b delta, ~ ~ exists ptd, pointed_subdiv ptd /\ fine delta ptd /\ SF_h ptd = Rmin a b /\ last (SF_h ptd) (SF_lx ptd) = Rmax a b. Proof. intros a b delta H. assert (forall ptd, ~ (pointed_subdiv ptd /\ fine delta ptd /\ SF_h ptd = Rmin a b /\ last (SF_h ptd) (SF_lx ptd) = Rmax a b)) as Hdelta. intros ptd Hptd. apply H ; now exists ptd. clear H. set (M := fun y => Rmin a b <= y <= Rmax a b /\ exists ptd, (pointed_subdiv ptd /\ fine delta ptd /\ SF_h ptd = Rmin a b /\ last (SF_h ptd) (SF_lx ptd) = y)). assert (exists b', is_lub M b') as Hb'. apply completeness_weak. exists (Rmax a b). intros y Hy. apply Hy. exists (Rmin a b). split. split. apply Rle_refl. apply Rmin_Rmax. exists (SF_nil (Rmin a b)). simpl. split. intros i Hi. apply Nat.nlt_0_r in Hi ; destruct Hi. split. intros i Hi. apply Nat.nlt_0_r in Hi ; destruct Hi. split ; easy. destruct Hb' as (b', H). assert (forall e : posreal, ~ ~ (exists y, M y /\ b' - e < y)) as H1. now apply lub_cara. apply (H1 (delta b')). intro H2. destruct H2 as (y, H2). clear H1. destruct H2 as (H2, H1). assert (M y) as Hy. assumption. destruct H2 as (H3, H2). destruct H2 as (s, H2). destruct H2 as (H2,H4). destruct H4 as (H4, H0). destruct H0 as (H5, H0). set (s' := SF_rcons s (b',b')). assert (pointed_subdiv s' /\ SF_h s' = Rmin a b /\ last (SF_h s') (SF_lx s') = b') as HH. split. unfold pointed_subdiv ; unfold s'. intros i Hi. rewrite SF_size_rcons in Hi. apply ->Nat.lt_succ_r in Hi. case (eq_nat_dec i (SF_size s)) => His. rewrite His. replace (nth 0 (SF_lx (SF_rcons s (b', b'))) (SF_size s)) with (last (SF_h s) (SF_lx s)). replace (nth 0 (SF_ly (SF_rcons s (b', b'))) (SF_size s)) with b'. replace (nth 0 (SF_lx (SF_rcons s (b', b'))) (S (SF_size s))) with b'. split. rewrite H0. unfold is_lub in H. apply H. apply Hy. apply Rle_refl. rewrite SF_lx_rcons. simpl fst. replace (S (SF_size s)) with (Peano.pred (size (rcons (SF_lx s) b')) ). rewrite nth_last. rewrite last_rcons. easy. rewrite size_rcons. rewrite <- SF_size_lx. simpl ; easy. rewrite SF_ly_rcons. simpl snd. replace (SF_size s) with (Peano.pred (size (rcons (SF_ly s) b'))). rewrite nth_last. rewrite last_rcons. easy. rewrite size_rcons. simpl. apply SF_size_ly. rewrite <- nth_last. rewrite SF_size_lx. simpl. rewrite SF_lx_rcons. simpl fst. rewrite nth_rcons. case Hleq : ssrnat.leq. assert (Peano.pred(size (SF_lx s)) = size (SF_t s)) as Hlxsize. rewrite SF_size_lx. simpl ; unfold SF_size ; simpl ; easy. unfold SF_size. rewrite <- Hlxsize. rewrite nth_last. rewrite nth_last. unfold SF_lx. rewrite last_cons. rewrite last_cons. easy. rewrite SF_size_lx in Hleq. by rewrite ssrnat.leqnn in Hleq. rewrite SF_lx_rcons. rewrite SF_ly_rcons. simpl fst. simpl snd. assert (i < SF_size s)%nat as Hsi. apply le_lt_eq_dec in Hi. now destruct Hi. split ; rewrite nth_rcons ; case Hcase : ssrnat.leq ; rewrite nth_rcons ; case Hcase2 : ssrnat.leq. now apply (H2 i). case Hcase3 : eqtype.eq_op. apply Rle_trans with (last (SF_h s) (SF_lx s)). replace (last (SF_h s) (SF_lx s)) with (last 0 (SF_lx s)). apply sorted_last. apply ptd_sort. apply H2. rewrite SF_size_lx. unfold lt. apply le_n_S. apply Hi. case Hs : (SF_lx s). assert (size (SF_lx s) = 0%nat) as Hss. rewrite Hs ; simpl ; easy. rewrite SF_size_lx in Hss. apply MyNat.neq_succ_0 in Hss ; destruct Hss. rewrite last_cons ; rewrite last_cons ; easy. rewrite H0. destruct H as (H, H'). now apply H. move :Hcase2 => /ssrnat.leP Hcase2. apply not_le in Hcase2 ; unfold gt in Hcase2. rewrite SF_size_ly in Hcase2. unfold lt in Hcase2. apply le_S_n in Hcase2. unfold lt in Hsi. assert (S i <= i)%nat as Hcase4. now apply Nat.le_trans with (SF_size s). apply Nat.nle_succ_diag_l in Hcase4 ; destruct Hcase4. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_lx in Hcase. apply le_n_S in Hi. contradiction. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_lx in Hcase. apply le_n_S in Hi. contradiction. now apply (H2 i). move :Hcase2 => /ssrnat.leP Hcase2. rewrite SF_size_lx in Hcase2. unfold lt in Hsi. apply le_n_S in Hsi. contradiction. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_ly in Hcase. unfold lt in Hsi. contradiction. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_ly in Hcase. unfold lt in Hsi. contradiction. unfold s'. split. unfold SF_rcons. simpl. apply H5. rewrite SF_lx_rcons. rewrite last_rcons. easy. apply (Hdelta s'). split. apply HH. split. unfold fine, s'. rewrite SF_size_rcons. unfold lt. intros i Hi. apply le_S_n in Hi. case (le_lt_eq_dec i (SF_size s)). assumption. intro Hi2. unfold ith_step. replace (nth 0 (SF_lx (SF_rcons s (b', b'))) (S i)) with (nth 0 (SF_lx s) (S i)). replace (nth 0 (SF_lx (SF_rcons s (b', b'))) i) with (nth 0 (SF_lx s) i). replace (nth 0 (SF_ly (SF_rcons s (b', b'))) i) with (nth 0 (SF_ly s) i). now apply (H4 i). rewrite SF_ly_rcons. simpl. rewrite nth_rcons. case Hcase : ssrnat.leq. easy. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_ly in Hcase. contradiction. rewrite SF_lx_rcons. rewrite nth_rcons. case Hcase : ssrnat.leq. easy. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_lx in Hcase. apply le_n_S in Hi. contradiction. rewrite SF_lx_rcons. rewrite nth_rcons. case Hcase : ssrnat.leq. easy. move :Hcase => /ssrnat.leP Hcase. rewrite SF_size_lx in Hcase. apply le_n_S in Hi2. contradiction. clear Hi ; intro Hi. rewrite Hi. unfold ith_step. rewrite SF_lx_rcons. rewrite SF_ly_rcons. replace (nth 0 (rcons (SF_lx s) (fst (b', b'))) (S (SF_size s))) with (last 0 (rcons (SF_lx s) (fst (b', b')))). replace (nth 0 (rcons (SF_lx s) (fst (b', b'))) (SF_size s)) with y. replace (nth 0 (rcons (SF_ly s) (snd (b', b'))) (SF_size s)) with (last 0 (rcons (SF_ly s) (snd (b', b')))). rewrite last_rcons ; rewrite last_rcons ; simpl. apply Rplus_lt_reg_l with y. rewrite Rplus_comm. rewrite Rplus_assoc. rewrite Rplus_opp_l. rewrite Rplus_0_r. apply Rplus_lt_reg_l with (- delta b'). rewrite Rplus_comm. replace (- delta b' + (y + delta b')) with y. assumption. rewrite Rplus_comm ; rewrite Rplus_assoc ; rewrite Rplus_opp_r ; rewrite Rplus_0_r ; easy. replace (SF_size s) with (Peano.pred (size (rcons (SF_ly s) (snd (b', b'))))). rewrite nth_last ; easy. rewrite size_rcons. simpl ; rewrite SF_size_ly ; easy. rewrite nth_rcons. rewrite SF_size_lx. case Hcase : ssrnat.leq. rewrite <- H0. replace (SF_size s) with (Peano.pred (size (SF_lx s))). rewrite nth_last. case Hs : (SF_lx s). assert (size (SF_lx s) = S (SF_size s)) as Hss. apply SF_size_lx. rewrite Hs in Hss. unfold size in Hss. apply O_S in Hss ; destruct Hss. rewrite last_cons ; rewrite last_cons ; easy. rewrite SF_size_lx ; simpl ; easy. move :Hcase => /ssrnat.leP Hcase. absurd (S (SF_size s) <= S (SF_size s))%nat. assumption. apply Nat.le_refl. replace (S (SF_size s)) with (Peano.pred (size (rcons (SF_lx s) (fst (b', b'))))). rewrite nth_last ; easy. rewrite size_rcons ; rewrite SF_size_lx ; simpl ; easy. destruct HH as (HH1, HH) ; split. apply HH. replace (Rmax a b) with b'. apply HH. assert ({b' < Rmax a b} + {b' = Rmax a b} + {b' > Rmax a b}) as Hb'. apply total_order_T. destruct Hb' as [Hb'1 | Hb'2]. destruct Hb'1 as [Hb'1 | Hb'3]. set (e:= Rmin ((Rmax a b) - b') ((delta b')/2) ). assert (0 < e) as He. apply Rmin_pos. now apply Rlt_Rminus. apply Rmult_lt_0_compat. apply (cond_pos (delta b')). apply Rinv_0_lt_compat. apply (Rlt_R0_R2). assert (e <= (delta b')/2) as Hed. apply Rmin_r. assert (e <= (Rmax a b) - b') as Hebb'. apply Rmin_l. assert (M (b' + e)) as H42. unfold M. split. split. apply Rle_trans with b'. apply Rle_trans with y. apply H3. now apply H. apply Rplus_le_reg_l with (- b'). rewrite Rplus_opp_l. rewrite <- Rplus_assoc. rewrite Rplus_opp_l. rewrite Rplus_0_l. now apply Rlt_le. apply Rplus_le_reg_l with (- b'). rewrite <- Rplus_assoc. rewrite Rplus_opp_l. rewrite Rplus_0_l. rewrite Rplus_comm. assumption. exists (SF_rcons s' (b'+e, b')). split. unfold pointed_subdiv. rewrite SF_size_rcons ; rewrite SF_lx_rcons ; rewrite SF_ly_rcons. intros i Hi. case (le_lt_eq_dec i (SF_size s')). apply le_S_n ; apply Hi. intro Hi2. replace (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) i) with (nth 0 (SF_lx s') i). replace (nth 0 (rcons (SF_ly s') (snd (b' + e, b'))) i) with (nth 0 (SF_ly s') i). replace (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) (S i)) with (nth 0 (SF_lx s') (S i)). now apply (HH1 i). rewrite nth_rcons. rewrite SF_size_lx. rewrite ssrnat.ltnS. by move /ssrnat.ltP :Hi2 => ->. rewrite nth_rcons. rewrite SF_size_ly. by move /ssrnat.ltP :Hi2 => ->. rewrite nth_rcons. rewrite SF_size_lx. by move /ssrnat.ltP :Hi => ->. intro Hi2. rewrite Hi2. replace (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) (SF_size s')) with b'. replace (nth 0 (rcons (SF_ly s') (snd (b' + e, b'))) (SF_size s')) with (nth 0 (rcons (SF_ly s') (snd (b' + e, b'))) (Peano.pred (size (rcons (SF_ly s') (snd (b' + e, b')))))). replace (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) (S (SF_size s'))) with (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) (Peano.pred (size (rcons (SF_lx s') (fst (b' + e, b')))))). rewrite nth_last. rewrite nth_last. rewrite last_rcons. rewrite last_rcons. simpl. split. apply Rle_refl. rewrite <- (Rplus_0_r b') at 1. apply Rplus_le_compat_l. now apply Rlt_le. rewrite size_rcons ; rewrite SF_size_lx ; simpl ; easy. rewrite size_rcons ; rewrite SF_size_ly ; simpl ; easy. rewrite nth_rcons. rewrite SF_size_lx. rewrite ssrnat.leqnn. unfold s'. rewrite SF_lx_rcons ; rewrite SF_size_rcons. rewrite -SF_size_lx. rewrite nth_rcons. rewrite ssrnat.ltnn. by rewrite eqtype.eq_refl. split. intro i. rewrite SF_size_rcons. intro Hi. case (le_lt_eq_dec i (SF_size s')). apply le_S_n. apply Hi. intro Hi2. replace (ith_step (SF_rcons s' (b' + e, b')) i) with (ith_step s' i). replace (nth 0 (SF_ly (SF_rcons s' (b' + e, b'))) i) with (nth 0 (SF_ly s') i). unfold s'. case (le_lt_eq_dec i (SF_size s)). unfold s' in Hi2 ; rewrite SF_size_rcons in Hi2. now apply le_S_n. intro Hi3. replace (ith_step (SF_rcons s (b', b')) i) with (ith_step s i). replace (nth 0 (SF_ly (SF_rcons s (b', b'))) i) with (nth 0 (SF_ly s) i). now apply (H4 i). rewrite SF_ly_rcons ; rewrite nth_rcons. rewrite SF_size_ly. by move /ssrnat.ltP :Hi3 => ->. unfold ith_step. rewrite SF_lx_rcons. rewrite 2!nth_rcons. rewrite SF_size_lx. rewrite ssrnat.ltnS. move /ssrnat.ltP :(Hi3) => ->. rewrite ssrnat.ltnS. apply Nat.lt_le_incl in Hi3. by move /ssrnat.leP :Hi3 => ->. intro Hi3. rewrite Hi3. unfold ith_step. rewrite SF_lx_rcons. replace (nth 0 (rcons (SF_lx s) (fst (b', b'))) (S (SF_size s))) with b'. replace (nth 0 (rcons (SF_lx s) (fst (b', b'))) (SF_size s)) with y. replace (nth 0 (SF_ly (SF_rcons s (b', b'))) (SF_size s)) with b'. apply Rplus_lt_reg_l with (y - delta b'). replace (y - delta b' + (b' - y)) with (b' - delta b') by ring. now replace (y - delta b' + delta b') with y by ring. rewrite SF_ly_rcons. replace (SF_size s) with (Peano.pred (size (rcons (SF_ly s) (snd (b', b'))))). rewrite nth_last. rewrite last_rcons. easy. rewrite size_rcons. simpl. apply SF_size_ly. rewrite nth_rcons. rewrite <- H0. rewrite <- nth_last. rewrite SF_size_lx. rewrite ssrnat.leqnn. simpl. apply set_nth_default. rewrite SF_size_lx. apply ssrnat.leqnn. replace (S (SF_size s)) with (Peano.pred (size (rcons (SF_lx s) (fst (b', b'))))). rewrite nth_last. rewrite last_rcons. easy. rewrite size_rcons ; rewrite SF_size_lx ; simpl ; easy. unfold s'. rewrite SF_ly_rcons. rewrite SF_ly_rcons. rewrite SF_ly_rcons. case (le_lt_eq_dec i (SF_size s)). unfold s' in Hi2 ; rewrite SF_size_rcons in Hi2 ; apply le_S_n ; apply Hi2. intro Hi3. rewrite nth_rcons ; rewrite nth_rcons ; rewrite nth_rcons. rewrite SF_size_ly. move /ssrnat.ltP :(Hi3) => ->. rewrite size_rcons. rewrite ssrnat.ltnS. rewrite SF_size_ly. apply Nat.lt_le_incl in Hi3. by move /ssrnat.leP :Hi3 => ->. intro Hi3 ; rewrite Hi3. replace (nth 0 (rcons (SF_ly s) (snd (b', b'))) (SF_size s)) with b'. rewrite nth_rcons. rewrite size_rcons. rewrite SF_size_ly. rewrite ssrnat.leqnn. replace (SF_size s) with (Peano.pred (size (rcons (SF_ly s) (snd (b', b'))))). rewrite nth_last. rewrite last_rcons ; easy. rewrite size_rcons ; rewrite SF_size_ly ; simpl ; easy. rewrite nth_rcons. rewrite SF_size_ly. rewrite ssrnat.ltnn. by rewrite eqtype.eq_refl. unfold ith_step. rewrite SF_lx_rcons. rewrite nth_rcons ; rewrite nth_rcons. rewrite SF_size_lx. rewrite ssrnat.ltnS. move /ssrnat.ltP :(Hi2) => ->. rewrite ssrnat.ltnS. apply Nat.lt_le_incl in Hi2. by move /ssrnat.leP :Hi2 => ->. intro Hi2 ; rewrite Hi2. unfold ith_step. rewrite SF_lx_rcons. rewrite SF_ly_rcons. replace (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) (S (SF_size s'))) with (b' + e). replace (nth 0 (rcons (SF_lx s') (fst (b' + e, b'))) (SF_size s')) with b'. replace (nth 0 (rcons (SF_ly s') (snd (b' + e, b'))) (SF_size s')) with b'. rewrite Rplus_comm. unfold Rminus. rewrite Rplus_assoc ; rewrite Rplus_opp_r ; rewrite Rplus_0_r. apply Rle_lt_trans with (delta b' / 2). assumption. apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. replace (SF_size s') with (Peano.pred (size (rcons (SF_ly s') (snd (b' + e, b'))))). rewrite nth_last. rewrite last_rcons. easy. rewrite size_rcons ; rewrite SF_size_ly ; simpl ; easy. rewrite nth_rcons. rewrite SF_size_lx. rewrite ssrnat.leqnn. replace (SF_size s') with (Peano.pred (size (SF_lx s'))). rewrite nth_last. destruct HH as (HH, HH') ; rewrite <- HH'. case Hcase2 : (SF_lx s'). assert (size (SF_lx s') = S (SF_size s')) as Hss. apply SF_size_lx. rewrite Hcase2 in Hss. apply O_S in Hss ; destruct Hss. rewrite last_cons ; rewrite last_cons ; easy. rewrite SF_size_lx ; simpl ; easy. replace (S (SF_size s')) with (Peano.pred (size (rcons (SF_lx s') (fst (b' + e, b'))))). rewrite nth_last ; rewrite last_rcons ; easy. rewrite size_rcons ; rewrite SF_size_lx ; simpl ; easy. rewrite SF_lx_rcons ; rewrite last_rcons. split. unfold SF_rcons ; simpl. apply H5. easy. apply H in H42. assert (b' < b' + e) as H43. rewrite <- (Rplus_0_r b') at 1. now apply Rplus_lt_compat_l. apply Rle_not_lt in H42. contradiction. apply Hb'3. assert (b' <= Rmax a b) as Hb'3. apply H. intros x Hx. apply Hx. apply Rle_not_gt in Hb'3. contradiction. Qed. Global Instance KH_fine_proper_filter a b : ProperFilter' (KH_fine a b). Proof. constructor. unfold KH_fine ; unfold within ; unfold KH_filter. intro H. destruct H as (delta, Hdelta). apply (cousin a b delta). intro H. destruct H as (ptd, Hptd). apply (Hdelta ptd). apply Hptd. split. apply Hptd. split ; apply Hptd. unfold KH_fine. apply within_filter. apply KH_filter_filter. Qed. Section is_KHInt. Context {V : NormedModule R_AbsRing}. Definition is_KHInt (f : R -> V) (a b : R) (If : V) := filterlim (fun ptd => scal (sign (b-a)) (Riemann_sum f ptd)) (KH_fine a b) (locally If). Definition ex_KHInt f a b := exists If : V, is_KHInt f a b If. Lemma is_KHInt_point : forall (f : R -> V) (a : R), is_KHInt f a a zero. Proof. intros f a. unfold is_KHInt. apply filterlim_ext with (fun ptd : @SF_seq R => @zero V). intro ptd. rewrite Rminus_eq_0 sign_0. rewrite scal_zero_l ; easy. intros P HP. unfold filtermap. destruct HP as (eps, HPeps). exists (fun x : R => {| pos := 1 ; cond_pos := Rlt_0_1 |}). intros ptd Hptd Hptd2. apply HPeps. apply ball_center. Qed. Lemma ex_KHInt_point : forall (f : R -> V) (a : R), ex_KHInt f a a. Proof. intros f a ; exists zero ; now apply is_KHInt_point. Qed. Lemma is_KHInt_const : forall (a b : R) (c : V), is_KHInt (fun x : R => c) a b (scal (b-a) c). Proof. intros a b c. intros P HP. destruct HP as (eps, HPeps). exists (fun x : R => eps). intros ptd Hptd Hptd2. apply HPeps. rewrite Riemann_sum_const. destruct Hptd2 as (Hptd0, Hptd1). destruct Hptd1 as (Hptd1, Hptd2). rewrite Hptd2. rewrite Hptd1. rewrite scal_assoc. replace (mult (sign (b - a)) (Rmax a b - Rmin a b)) with (b-a). apply ball_center. apply sym_eq, sign_min_max. Qed. Lemma ex_KHInt_const : forall (a b : R) (c : V), ex_KHInt (fun x : R => c) a b. Proof. intros a b c ; exists (scal (b-a) c) ; apply is_KHInt_const. Qed. End is_KHInt. Section KHInt. Context {V : CompleteNormedModule R_AbsRing}. Definition KHInt (f : R -> V) (a b : R) := iota (is_KHInt f a b). Lemma KHInt_correct : forall (f : R -> V) (a b : R), ex_KHInt f a b -> is_KHInt f a b (KHInt f a b). Proof. intros f a b [v Hv]. unfold KHInt. apply iota_correct. exists v. split. exact Hv. intros w Hw. apply filterlim_locally_unique with (1 := Hv) (2 := Hw). Qed. Lemma is_KHInt_unique : forall (f : R -> V) (a b : R) (l : V), is_KHInt f a b l -> KHInt f a b = l. Proof. intros f a b l H. apply filterlim_locally_unique with (2 := H). apply KHInt_correct. now exists l. Qed. Lemma KHInt_point : forall (f : R -> V) (a : R), KHInt f a a = zero. Proof. intros f a. apply is_KHInt_unique. apply: is_KHInt_point. Qed. Lemma KHInt_const : forall (a b : R) (v : V), KHInt (fun _ => v) a b = scal (b - a) v. Proof. intros a b v. apply is_KHInt_unique. apply: is_KHInt_const. Qed. Lemma is_RInt_KHInt : forall (f : R -> V) (a b : R) (l : V), is_RInt f a b l -> is_KHInt f a b l. Proof. intros f a b I. unfold is_RInt, is_KHInt. apply filterlim_filter_le_1. unfold filter_le, Riemann_fine, KH_fine, within, KH_filter, locally_dist. intros P [delta HPdelta]. exists (fun _ => delta). intros ptd Hptd1 Hptd2. apply HPdelta. 2: exact Hptd2. clear -Hptd1 Hptd2. unfold fine in Hptd1. revert Hptd1 Hptd2. assert ((forall i : nat, (i < SF_size ptd)%nat -> ith_step ptd i < delta) -> pointed_subdiv ptd /\ SF_h ptd >= Rmin a b /\ last (SF_h ptd) (SF_lx ptd) = Rmax a b -> seq_step (SF_lx ptd) < delta) as H0. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | h ptd IH] H. intros H0. apply cond_pos. intro H0. rewrite SF_lx_cons. unfold seq_step ; simpl. apply Rmax_case. specialize (H 0%nat). unfold ith_step in H. rewrite SF_lx_cons in H. simpl in H. rewrite Rabs_right. apply H. rewrite SF_size_cons. apply Nat.lt_0_succ. destruct H0 as (H0, H1). unfold pointed_subdiv in H0. apply Rge_minus. apply Rle_ge. specialize (H0 0%nat). apply Rle_trans with (nth 0 (SF_ly (SF_cons h ptd)) 0) ; apply H0 ; rewrite SF_size_cons ; apply Nat.lt_0_succ. apply IH. intros i Hi. specialize (H (S i)). unfold ith_step. unfold ith_step in H. change (nth 0 (SF_lx ptd) (S i)) with (nth 0 (SF_lx (SF_cons h ptd)) (S (S i))). change (nth 0 (SF_lx ptd) i) with (nth 0 (SF_lx (SF_cons h ptd)) (S i)). apply H. rewrite SF_size_cons ; now apply <-Nat.lt_succ_r. split. apply ptd_cons with h. apply H0. split. apply Rge_trans with (SF_h (SF_cons h ptd)). 2:apply H0. 2:apply H0. apply Rle_ge. destruct H0 as (H0, H1). unfold pointed_subdiv in H0. specialize (H0 0%nat). change (SF_h (SF_cons h ptd)) with (nth 0 (SF_lx (SF_cons h ptd)) 0). change (SF_h ptd) with (nth 0 (SF_lx (SF_cons h ptd)) 1). apply Rle_trans with (nth 0 (SF_ly (SF_cons h ptd)) 0) ; apply H0 ; rewrite SF_size_cons ; apply Nat.lt_0_succ. intros H1 H2. apply H0. apply H1. split. apply H2. split. destruct H2 as (H2, (H3, H4)). rewrite H3. apply Rge_refl. apply H2. Qed. End KHInt. coquelicot-coquelicot-3.4.1/theories/Lim_seq.v000066400000000000000000003001771455143432500214530ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Rbar Lub Markov Hierarchy. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). (** This file describes properties and definitions about limits of real sequences. This includes properties about the predicates [is_lim_seq] and [ex_lim_seq]. This file also defines several total functions using the Limited Principle of Omniscience. These total functions on [R] sequences are [Sup_seq], [Inf_seq], [LimSup_seq], [LimInf_seq] and of course [Lim_seq]. *) Open Scope R_scope. (** * Sup and Inf of sequences in Rbar *) (** ** Definitions *) Definition is_sup_seq (u : nat -> Rbar) (l : Rbar) := match l with | Finite l => forall (eps : posreal), (forall n, Rbar_lt (u n) (l+eps)) /\ (exists n, Rbar_lt (l-eps) (u n)) | p_infty => forall M : R, exists n, Rbar_lt M (u n) | m_infty => forall M : R, forall n, Rbar_lt (u n) M end. Definition is_inf_seq (u : nat -> Rbar) (l : Rbar) := match l with | Finite l => forall (eps : posreal), (forall n, Rbar_lt (Finite (l-eps)) (u n)) /\ (exists n, Rbar_lt (u n) (Finite (l+eps))) | p_infty => forall M : R, forall n, Rbar_lt (Finite M) (u n) | m_infty => forall M : R, exists n, Rbar_lt (u n) (Finite M) end. (** Equivalent forms *) Lemma is_inf_opp_sup_seq (u : nat -> Rbar) (l : Rbar) : is_inf_seq (fun n => Rbar_opp (u n)) (Rbar_opp l) <-> is_sup_seq u l. Proof. destruct l as [l | | ] ; split ; intros Hl. (* l = Finite l *) intro eps ; case (Hl eps) ; clear Hl ; intros lb (n, glb) ; split. intro n0 ; apply Rbar_opp_lt ; simpl ; rewrite (Ropp_plus_distr l eps) ; apply lb. exists n ; apply Rbar_opp_lt ; assert (Rw : -(l-eps) = -l+eps). ring. simpl ; rewrite Rw ; clear Rw ; auto. intro eps ; case (Hl eps) ; clear Hl ; intros ub (n, lub) ; split. intros n0 ; unfold Rminus ; rewrite <-(Ropp_plus_distr l eps) ; apply (Rbar_opp_lt (Finite (l+eps)) (u n0)) ; simpl ; apply ub. exists n ; assert (Rw : -(l-eps) = -l+eps). ring. simpl ; rewrite <-Rw ; apply (Rbar_opp_lt (u n) (Finite (l-eps))) ; auto. (* l = p_infty *) intro M ; case (Hl (-M)) ; clear Hl ; intros n Hl ; exists n ; apply Rbar_opp_lt ; auto. intro M ; case (Hl (-M)) ; clear Hl ; intros n Hl ; exists n ; apply Rbar_opp_lt ; rewrite Rbar_opp_involutive ; auto. (* l = m_infty *) intros M n ; apply Rbar_opp_lt, Hl. intros M n ; apply Rbar_opp_lt ; rewrite Rbar_opp_involutive ; apply Hl. Qed. Lemma is_sup_opp_inf_seq (u : nat -> Rbar) (l : Rbar) : is_sup_seq (fun n => Rbar_opp (u n)) (Rbar_opp l) <-> is_inf_seq u l. Proof. case: l => [l | | ] ; split => Hl. (* l = Finite l *) move => eps ; case: (Hl eps) => {Hl} [lb [n lub]] ; split. move => n0 ; apply Rbar_opp_lt ; have : (-(l-eps) = -l+eps) ; first by ring. by move => /= ->. exists n ; apply Rbar_opp_lt ; rewrite /= (Ropp_plus_distr l eps) ; apply lub. move => eps ; case: (Hl eps) => {Hl} [ub [n lub]] ; split. move => n0 ; have : (-(l-eps) = (-l+eps)) ; first by ring. move => /= <- ; by apply (Rbar_opp_lt (u n0) (Finite (l-eps))). exists n ; rewrite /Rminus -(Ropp_plus_distr l eps) ; by apply (Rbar_opp_lt (Finite (l+eps)) (u n)). (* l = p_infty *) move => M n ; apply Rbar_opp_lt, Hl. move => M n ; apply Rbar_opp_lt ; rewrite Rbar_opp_involutive ; apply Hl. (* l = m_infty *) move => M ; case: (Hl (-M)) => {Hl} n Hl ; exists n ; by apply Rbar_opp_lt. move => M ; case: (Hl (-M)) => {Hl} n Hl ; exists n ; apply Rbar_opp_lt ; by rewrite Rbar_opp_involutive. Qed. Lemma is_sup_seq_lub (u : nat -> Rbar) (l : Rbar) : is_sup_seq u l -> Rbar_is_lub (fun x => exists n, x = u n) l. Proof. destruct l as [l | | ] ; intro Hl ; split. (* l = Finite l *) intro x ; destruct x as [x | | ] ; simpl ; intros (n, Hn). apply le_epsilon ; intros e He ; set (eps := mkposreal e He). change (Rbar_le x (l + e)). rewrite Hn ; apply Rbar_lt_le, (Hl eps). now generalize (proj1 (Hl (mkposreal _ Rlt_0_1)) n) ; clear Hl ; simpl ; intros Hl ; rewrite <-Hn in Hl. easy. intros b ; destruct b as [b | | ] ; intros Hb ; apply Rbar_not_lt_le ; auto ; intros He. set (eps := mkposreal _ (Rlt_Rminus _ _ He)) ; case (proj2 (Hl eps)) ; clear Hl ; intros n. apply Rbar_le_not_lt ; assert (l - eps = b) . simpl ; ring. rewrite H ; clear H ; apply Hb ; exists n ; auto. generalize (Rbar_ub_m_infty _ Hb) ; clear Hb ; intros Hb. case (proj2 (Hl (mkposreal _ Rlt_0_1))) ; clear Hl ; simpl ; intros n Hl. assert (H : (exists n0 : nat, u n = u n0)). exists n ; auto. generalize (Hb (u n) H) Hl ; clear Hb ; now case (u n). (* l = p_infty *) apply Rbar_ub_p_infty. intro b ; destruct b as [b | | ] ; simpl ; intro Hb. case (Hl b) ; clear Hl ; intros n Hl. contradict Hl ; apply Rbar_le_not_lt, Hb ; exists n ; auto. easy. generalize (Rbar_ub_m_infty _ Hb) ; clear Hb ; intro Hb. case (Hl 0) ; clear Hl; intros n Hl. assert (H : (exists n0 : nat, u n = u n0)). exists n ; auto. generalize (Hb (u n) H) Hl ; clear Hl ; now case (u n). (* l = m_infty *) intro x ; destruct x as [x | | ] ; intros (n, Hx). generalize (Hl x n) ; clear Hl ; intro Hl ; rewrite <-Hx in Hl ; apply Rlt_irrefl in Hl ; intuition. generalize (Hl 0 n) ; rewrite <-Hx ; intuition. easy. now intros b ; destruct b as [b | | ]. Qed. Lemma Rbar_is_lub_sup_seq (u : nat -> Rbar) (l : Rbar) : Rbar_is_lub (fun x => exists n, x = u n) l -> is_sup_seq u l. Proof. destruct l as [l | | ] ; intros (ub, lub). (* l = Finite l *) intro eps ; split. intro n ; apply Rbar_le_lt_trans with (y := Finite l). apply ub ; exists n ; auto. pattern l at 1 ; rewrite <-(Rplus_0_r l) ; apply Rplus_lt_compat_l, eps. apply LPO_notforall. intro n. destruct (Rbar_lt_dec (l - eps) (u n)) as [H|H]. now left. now right. intro H. assert (H0 : (Rbar_is_upper_bound (fun x : Rbar => exists n : nat, x = u n) (Finite (l - eps)))). intros x (n,Hn) ; rewrite Hn ; clear Hn ; apply Rbar_not_lt_le, H. generalize (lub _ H0) ; clear lub ; apply Rbar_lt_not_le ; pattern l at 2 ; rewrite <-(Rplus_0_r l) ; apply Rplus_lt_compat_l, Ropp_lt_gt_0_contravar, eps. (* l = p_infty *) intro M ; apply LPO_notforall. intro n. destruct (Rbar_lt_dec M (u n)) as [H|H]. now left. now right. intro H. assert (H0 : Rbar_is_upper_bound (fun x : Rbar => exists n : nat, x = u n) (Finite M)). intros x (n,Hn) ; rewrite Hn ; clear Hn ; apply Rbar_not_lt_le, H. generalize (lub _ H0) ; clear lub ; apply Rbar_lt_not_le ; simpl ; auto. (* l = m_infty *) intros M n. apply Rbar_le_lt_trans with (y := m_infty) ; simpl ; auto. apply ub ; exists n ; auto. Qed. Lemma is_inf_seq_glb (u : nat -> Rbar) (l : Rbar) : is_inf_seq u l -> Rbar_is_glb (fun x => exists n, x = u n) l. Proof. move => H ; apply Rbar_lub_glb ; apply (Rbar_is_lub_ext (fun x : Rbar => exists n : nat, x = Rbar_opp (u n))). move => x ; split ; case => n Hn ; exists n. by rewrite Hn Rbar_opp_involutive. by rewrite -Hn Rbar_opp_involutive. apply (is_sup_seq_lub (fun n => Rbar_opp (u n)) (Rbar_opp l)) ; by apply is_sup_opp_inf_seq. Qed. Lemma Rbar_is_glb_inf_seq (u : nat -> Rbar) (l : Rbar) : Rbar_is_glb (fun x => exists n, x = u n) l -> is_inf_seq u l. Proof. move => H ; apply is_sup_opp_inf_seq ; apply Rbar_is_lub_sup_seq ; apply Rbar_glb_lub. rewrite Rbar_opp_involutive ; apply (Rbar_is_glb_ext (fun x : Rbar => exists n : nat, x = u n)) => // x ; split ; case => n Hx ; exists n ; by apply Rbar_opp_eq. Qed. (** Extensionality *) Lemma is_sup_seq_ext (u v : nat -> Rbar) (l : Rbar) : (forall n, u n = v n) -> is_sup_seq u l -> is_sup_seq v l. Proof. case: l => [l | | ] Heq ; rewrite /is_sup_seq => Hu. (* l \in R *) move => eps ; case: (Hu eps) => {Hu} Hu1 Hu2 ; split. move => n ; by rewrite -Heq. case: Hu2 => n Hu2 ; exists n ; by rewrite -Heq. (* l = p_infty *) move => M ; case: (Hu M) => {Hu} n Hu ; exists n ; by rewrite -Heq. (* l = m_infty *) move => M n ; by rewrite -Heq. Qed. Lemma is_inf_seq_ext (u v : nat -> Rbar) (l : Rbar) : (forall n, u n = v n) -> is_inf_seq u l -> is_inf_seq v l. Proof. case: l => [l | | ] Heq ; rewrite /is_inf_seq => Hu. (* l \in R *) move => eps ; case: (Hu eps) => {Hu} Hu1 Hu2 ; split. move => n ; by rewrite -Heq. case: Hu2 => n Hu2 ; exists n ; by rewrite -Heq. (* l = p_infty *) move => M n ; by rewrite -Heq. (* l = m_infty *) move => M ; case: (Hu M) => {Hu} n Hu ; exists n ; by rewrite -Heq. Qed. (** Existence *) Lemma ex_sup_seq (u : nat -> Rbar) : {l : Rbar | is_sup_seq u l}. Proof. case (LPO (fun n => p_infty = u n)) => [/= | [np Hnp] | Hnp]. intro n0 ; destruct (u n0) as [r | | ]. now right. left ; auto. now right. exists p_infty => M. exists np ; by rewrite -Hnp. case (Rbar_ex_lub (fun x => exists n, x = u n)). intros l Hl ; exists l ; apply Rbar_is_lub_sup_seq ; auto. Qed. Lemma ex_inf_seq (u : nat -> Rbar) : {l : Rbar | is_inf_seq u l}. Proof. case : (ex_sup_seq (fun n => Rbar_opp (u n))) => l Hl. exists (Rbar_opp l) ; apply is_sup_opp_inf_seq ; by rewrite Rbar_opp_involutive. Qed. (** Notations *) Definition Sup_seq (u : nat -> Rbar) := proj1_sig (ex_sup_seq u). Definition Inf_seq (u : nat -> Rbar) := proj1_sig (ex_inf_seq u). Lemma is_sup_seq_unique (u : nat -> Rbar) (l : Rbar) : is_sup_seq u l -> Sup_seq u = l. Proof. move => Hl ; rewrite /Sup_seq ; case: (ex_sup_seq _) => l0 Hl0 /= ; case: l Hl => [l | | ] Hl ; case: l0 Hl0 => [l0 | | ] Hl0 //. apply Rbar_finite_eq, Rle_antisym ; apply le_epsilon => e He ; set eps := mkposreal e He ; apply Rlt_le ; case: (Hl (pos_div_2 eps)) => {} Hl [n Hn] ; case: (Hl0 (pos_div_2 eps)) => {} Hl0 [n0 Hn0]. have: (l0 = (l0 - eps/2) + eps/2) ; [by field | move => -> ] ; have : (l + e = (l + eps/2) + eps/2) ; [ simpl ; field | move => -> ] ; apply Rplus_lt_compat_r, (Rbar_lt_trans (Finite (l0 - eps/2)) (u n0) (Finite (l + eps/2)) Hn0 (Hl _)). have: (l = (l - eps/2) + eps/2) ; [by field | move => -> ] ; have : (l0 + e = (l0 + eps/2) + eps/2) ; [ simpl ; field | move => -> ] ; apply Rplus_lt_compat_r, (Rbar_lt_trans (Finite (l - eps/2)) (u n) (Finite (l0 + eps/2)) Hn (Hl0 _)). case: (Hl0 (l + 1)) => n {} Hl0 ; contradict Hl0 ; apply Rbar_le_not_lt, Rbar_lt_le, (Hl (mkposreal _ Rlt_0_1)). case: (Hl (mkposreal _ Rlt_0_1)) => {Hl} _ [n Hl] ; contradict Hl ; apply Rbar_le_not_lt, Rbar_lt_le, Hl0. case: (Hl (l0 + 1)) => n {} Hl ; contradict Hl ; apply Rbar_le_not_lt, Rbar_lt_le, (Hl0 (mkposreal _ Rlt_0_1)). case: (Hl 0) => n {} Hl ; contradict Hl ; apply Rbar_le_not_lt, Rbar_lt_le, Hl0. case: (Hl0 (mkposreal _ Rlt_0_1)) => {Hl0} _ [n Hl0] ; contradict Hl0 ; apply Rbar_le_not_lt, Rbar_lt_le, Hl. case: (Hl0 0) => n {} Hl0 ; contradict Hl0 ; apply Rbar_le_not_lt, Rbar_lt_le, Hl. Qed. Lemma Sup_seq_correct (u : nat -> Rbar) : is_sup_seq u (Sup_seq u). Proof. rewrite /Sup_seq ; case: (ex_sup_seq _) => l Hl //. Qed. Lemma is_inf_seq_unique (u : nat -> Rbar) (l : Rbar) : is_inf_seq u l -> Inf_seq u = l. Proof. move => Hl ; rewrite /Inf_seq ; case: (ex_inf_seq _) => l0 Hl0 /= ; case: l Hl => [l | | ] Hl ; case: l0 Hl0 => [l0 | | ] Hl0 //. apply Rbar_finite_eq, Rle_antisym ; apply le_epsilon => e He ; set eps := mkposreal e He ; apply Rlt_le ; case: (Hl (pos_div_2 eps)) => {} Hl [n Hn] ; case: (Hl0 (pos_div_2 eps)) => {} Hl0 [n0 Hn0]. have: (l0 = (l0 - eps/2) + eps/2) ; [by field | move => -> ] ; have : (l + e = (l + eps/2) + eps/2) ; [ simpl ; field | move => -> ] ; apply Rplus_lt_compat_r, (Rbar_lt_trans (Finite (l0 - eps/2)) (u n) (Finite (l + eps/2)) (Hl0 _) Hn). have: (l = (l - eps/2) + eps/2) ; [by field | move => -> ] ; have : (l0 + e = (l0 + eps/2) + eps/2) ; [ simpl ; field | move => -> ] ; apply Rplus_lt_compat_r, (Rbar_lt_trans (Finite (l - eps/2)) (u n0) (Finite (l0 + eps/2)) (Hl _) Hn0). case: (Hl (mkposreal _ Rlt_0_1)) => {Hl} _ [n Hl] ; contradict Hl ; apply Rbar_le_not_lt, Rbar_lt_le, Hl0. case: (Hl0 (l - 1)) => n {} Hl0 ; contradict Hl0 ; apply Rbar_le_not_lt, Rbar_lt_le, (Hl (mkposreal _ Rlt_0_1)). case: (Hl0 (mkposreal _ Rlt_0_1)) => {Hl0} _ [n Hl0] ; contradict Hl0 ; apply Rbar_le_not_lt, Rbar_lt_le, Hl. case: (Hl0 0) => n {} Hl0 ; contradict Hl0 ; apply Rbar_le_not_lt, Rbar_lt_le, Hl. case: (Hl (l0 - 1)) => n {} Hl ; contradict Hl ; apply Rbar_le_not_lt, Rbar_lt_le, (Hl0 (mkposreal _ Rlt_0_1)). case: (Hl 0) => n {} Hl ; contradict Hl ; apply Rbar_le_not_lt, Rbar_lt_le, Hl0. Qed. Lemma Inf_seq_correct (u : nat -> Rbar) : is_inf_seq u (Inf_seq u). Proof. rewrite /Inf_seq ; case: (ex_inf_seq _) => l Hl //. Qed. Lemma Sup_seq_ext (u v : nat -> Rbar) : (forall n, (u n) = (v n)) -> Sup_seq u = Sup_seq v. Proof. intro Heq ; rewrite {2}/Sup_seq ; case (ex_sup_seq v) ; simpl ; intros l2 Hv. by apply (is_sup_seq_unique u), is_sup_seq_ext with v. Qed. Lemma Inf_seq_ext (u v : nat -> Rbar) : (forall n, (u n) = (v n)) -> Inf_seq u = Inf_seq v. Proof. intro Heq ; rewrite {2}/Inf_seq ; case (ex_inf_seq v) ; simpl ; intros l2 Hv. by apply (is_inf_seq_unique u), is_inf_seq_ext with v. Qed. Lemma Rbar_sup_eq_lub (u : nat -> Rbar) : Sup_seq u = Rbar_lub (fun x => exists n, x = u n). Proof. rewrite /Sup_seq ; case: (ex_sup_seq _) => /= s Hs. rewrite /Rbar_lub ; case: (Rbar_ex_lub _) => /= l Hl. apply (Rbar_is_lub_eq (fun x : Rbar => exists n : nat, x = u n) (fun x : Rbar => exists n : nat, x = u n)) => // ; by apply is_sup_seq_lub. Qed. Lemma Inf_eq_glb (u : nat -> Rbar) : Inf_seq u = Rbar_glb (fun x => exists n, x = u n). Proof. rewrite /Inf_seq ; case: (ex_inf_seq _) => /= s Hs. rewrite /Rbar_glb ; case: (Rbar_ex_glb _) => /= l Hl. apply (Rbar_is_glb_eq (fun x : Rbar => exists n : nat, x = u n) (fun x : Rbar => exists n : nat, x = u n)) => // ; by apply is_inf_seq_glb. Qed. Lemma Sup_opp_inf (u : nat -> Rbar) : Sup_seq u = Rbar_opp (Inf_seq (fun n => Rbar_opp (u n))). Proof. rewrite /Inf_seq ; case: (ex_inf_seq _) => iu Hiu /=. apply is_sup_seq_unique. apply is_inf_opp_sup_seq. by rewrite Rbar_opp_involutive. Qed. Lemma Inf_opp_sup (u : nat -> Rbar) : Inf_seq u = Rbar_opp (Sup_seq (fun n => Rbar_opp (u n))). Proof. rewrite Sup_opp_inf Rbar_opp_involutive. rewrite /Inf_seq. repeat (case: ex_inf_seq ; intros) => /=. apply is_inf_seq_glb in p. apply is_inf_seq_glb in p0. move: p p0 ; apply Rbar_is_glb_eq. move => x1 ; split ; case => n -> ; exists n ; by rewrite Rbar_opp_involutive. Qed. Lemma Sup_seq_scal_l (a : R) (u : nat -> Rbar) : 0 <= a -> Sup_seq (fun n => Rbar_mult a (u n)) = Rbar_mult a (Sup_seq u). Proof. case => Ha. (* 0 < a *) rewrite /Sup_seq. case: ex_sup_seq => al Hau. case: ex_sup_seq => l Hu. simpl proj1_sig. apply Rbar_le_antisym. apply is_sup_seq_lub in Hau. apply is_sup_seq_lub in Hu. apply Hau => _ [n ->]. suff : Rbar_le (u n) l. case: (u n) => [un | | ] ; case: (l) => [l' | | ] /= ; try (by case) ; try (case: Rle_dec (Rlt_le _ _ Ha) => //= Ha' _ ; case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => //= _ _ _ ; by left). intros H ; apply Rmult_le_compat_l => // ; by apply Rlt_le. apply Hu. by exists n. suff : Rbar_le l (Rbar_div_pos al (mkposreal a Ha)). case: (al) => [al' | | ] ; case: (l) => [l' | | ] /= ; try (by case) ; try (case: Rle_dec (Rlt_le _ _ Ha) => //= Ha' _ ; case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => //= _ _ _ ; by left). intros H ; rewrite Rmult_comm ; apply Rle_div_r => //. apply is_sup_seq_lub in Hau. apply is_sup_seq_lub in Hu. apply Hu => _ [n ->]. suff : Rbar_le (Rbar_mult a (u n)) al. case: (u n) => [un | | ] ; case: (al) => [al' | | ] /= ; try (by case) ; try (case: Rle_dec (Rlt_le _ _ Ha) => //= Ha' _ ; case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => //= _ _ ; try (by case) ; by left). intros H ; rewrite Rmult_comm in H ; apply Rle_div_r => //. apply Hau. by exists n. (* a = 0 *) rewrite -Ha. transitivity (Sup_seq (fun _ => 0)). apply Sup_seq_ext. move => n ; case: (u n) => [un | | ] /=. apply f_equal ; ring. case: Rle_dec (Rle_refl 0) => //= H _. case: Rle_lt_or_eq_dec (Rle_not_lt _ _ H) => //= H _. case: Rle_dec (Rle_refl 0) => //= H _. case: Rle_lt_or_eq_dec (Rle_not_lt _ _ H) => //= H _. transitivity 0. apply is_sup_seq_unique. move => eps ; split => /=. move => _ ; ring_simplify ; by apply eps. exists 0%nat ; apply Rminus_lt_0 ; ring_simplify ; by apply eps. case: (Sup_seq u) => [l | | ] /=. apply f_equal ; ring. case: Rle_dec (Rle_refl 0) => //= H _. case: Rle_lt_or_eq_dec (Rle_not_lt _ _ H) => //= H _. case: Rle_dec (Rle_refl 0) => //= H _. case: Rle_lt_or_eq_dec (Rle_not_lt _ _ H) => //= H _. Qed. Lemma Inf_seq_scal_l (a : R) (u : nat -> Rbar) : 0 <= a -> Inf_seq (fun n => Rbar_mult a (u n)) = Rbar_mult a (Inf_seq u). Proof. move => Ha. rewrite Inf_opp_sup. rewrite -(Sup_seq_ext (fun n => Rbar_mult a (Rbar_opp (u n)))). rewrite Sup_seq_scal_l. by rewrite -Rbar_mult_opp_r -(Inf_opp_sup u). by []. move => n ; by rewrite Rbar_mult_opp_r. Qed. (** ** Order *) Lemma is_sup_seq_le (u v : nat -> Rbar) {l1 l2 : Rbar} : (forall n, Rbar_le (u n) (v n)) -> (is_sup_seq u l1) -> (is_sup_seq v l2) -> Rbar_le l1 l2. Proof. destruct l1 as [l1 | | ] ; destruct l2 as [l2 | | ] ; intros Hle Hu Hv ; case (is_sup_seq_lub _ _ Hu) ; clear Hu ; intros _ Hu ; case (is_sup_seq_lub _ _ Hv) ; clear Hv ; intros Hv _ ; apply Hu ; intros x (n,Hn) ; rewrite Hn ; clear x Hn ; apply Rbar_le_trans with (1 := Hle _), Hv ; exists n ; auto. Qed. Lemma is_inf_seq_le (u v : nat -> Rbar) {l1 l2 : Rbar} : (forall n, Rbar_le (u n) (v n)) -> (is_inf_seq u l1) -> (is_inf_seq v l2) -> Rbar_le l1 l2. Proof. case: l1 => [l1 | | ] ; case: l2 => [l2 | | ] Hle Hu Hv ; case: (is_inf_seq_glb _ _ Hu) => {} Hu _ ; case: (is_inf_seq_glb _ _ Hv) => {Hv} _ Hv ; apply Hv => _ [n ->] ; apply Rbar_le_trans with (2 := Hle _), Hu ; by exists n. Qed. Lemma Sup_seq_le (u v : nat -> Rbar) : (forall n, Rbar_le (u n) (v n)) -> Rbar_le (Sup_seq u) (Sup_seq v). Proof. intros Heq ; unfold Sup_seq ; case (ex_sup_seq u) ; intros l1 Hu ; case (ex_sup_seq v) ; simpl ; intros l2 Hv. apply (is_sup_seq_le u v) ; auto. Qed. Lemma Inf_seq_le (u v : nat -> Rbar) : (forall n, Rbar_le (u n) (v n)) -> Rbar_le (Inf_seq u) (Inf_seq v). Proof. move => Heq ; rewrite /Inf_seq ; case: (ex_inf_seq u) => l1 Hu ; case: (ex_inf_seq v) => /= l2 Hv. by apply (is_inf_seq_le u v). Qed. Lemma Inf_le_sup (u : nat -> Rbar) : Rbar_le (Inf_seq u) (Sup_seq u). Proof. rewrite /Inf_seq ; case: (ex_inf_seq _) ; case => [iu | | ] Hiu ; rewrite /Sup_seq ; case: (ex_sup_seq _) ; case => [su | | ] Hsu //=. (* Finite, Finite *) apply le_epsilon => e He ; set eps := mkposreal e He ; case: (Hiu (pos_div_2 eps)) => {} Hiu _ ; case: (Hsu (pos_div_2 eps)) => {} Hsu _ ; apply Rlt_le. have : (iu = iu - e/2 + e/2) ; first by ring. move => -> ; have : (su+e = su + e/2 + e/2) ; first by field. by move => -> ; apply Rplus_lt_compat_r, (Rbar_lt_trans (Finite (iu - e/2)) (u O) (Finite (su + e/2))). (* Finite, m_infty *) set eps := mkposreal _ Rlt_0_1 ; case: (Hiu eps) => {} Hiu _ ; move: (Hiu O) => {Hiu} ; apply Rbar_le_not_lt, Rbar_lt_le, Hsu. (* p_infty, Finite *) set eps := mkposreal _ Rlt_0_1 ; case: (Hsu eps) => {} Hsu _ ; move: (Hsu O) => {Hsu} ; apply Rbar_le_not_lt, Rbar_lt_le, Hiu. (* p_infty, m_infty *) move: (Hiu 0 O) => {Hiu} ; apply Rbar_le_not_lt, Rbar_lt_le, Hsu. Qed. Lemma is_sup_seq_major (u : nat -> Rbar) (l : Rbar) (n : nat) : is_sup_seq u l -> Rbar_le (u n) l. Proof. case: l => [l | | ] //= Hl. move: (fun eps => proj1 (Hl eps) n) => {Hl}. case: (u n) => [un | | ] //= Hun. apply le_epsilon => e He ; apply Rlt_le. apply: Hun (mkposreal e He). by move: (Hun (mkposreal _ Rlt_0_1)). case: (u n) => [un | | ] //. move: (Hl (u n) n) ; case: (u n) => [un | | ] //= {} Hl. by apply Rlt_irrefl in Hl. Qed. Lemma Sup_seq_minor_lt (u : nat -> Rbar) (M : R) : Rbar_lt M (Sup_seq u) <-> exists n, Rbar_lt M (u n). Proof. rewrite /Sup_seq ; case: ex_sup_seq => l Hl ; simpl proj1_sig ; split => H. case: l Hl H => [l | | ] Hl H. apply Rminus_lt_0 in H. case: (proj2 (Hl (mkposreal _ H))) ; simpl pos => {Hl} n Hl. exists n. replace M with (l - (l - M)) by ring. by apply Hl. apply (Hl M). by []. case: H => n Hn. apply Rbar_lt_le_trans with (u n). exact: Hn. by apply is_sup_seq_major. Qed. Lemma Sup_seq_minor_le (u : nat -> Rbar) (M : R) (n : nat) : Rbar_le M (u n) -> Rbar_le M (Sup_seq u). Proof. intros H'. destruct (Rbar_le_lt_or_eq_dec _ _ H') as [H|H]. apply Rbar_lt_le. apply Sup_seq_minor_lt. by exists n. rewrite H. rewrite /Sup_seq ; case: ex_sup_seq => l Hl ; simpl proj1_sig. by apply is_sup_seq_major. Qed. (** * LimSup and LimInf of sequences *) (** ** Definitions *) Definition is_LimSup_seq (u : nat -> R) (l : Rbar) := match l with | Finite l => forall eps : posreal, (forall N : nat, exists n : nat, (N <= n)%nat /\ l - eps < u n) /\ (exists N : nat, forall n : nat, (N <= n)%nat -> u n < l + eps) | p_infty => forall M : R, (forall N : nat, exists n : nat, (N <= n)%nat /\ M < u n) | m_infty => forall M : R, (exists N : nat, forall n : nat, (N <= n)%nat -> u n < M) end. Definition is_LimInf_seq (u : nat -> R) (l : Rbar) := match l with | Finite l => forall eps : posreal, (forall N : nat, exists n : nat, (N <= n)%nat /\ u n < l + eps) /\ (exists N : nat, forall n : nat, (N <= n)%nat -> l - eps < u n) | p_infty => forall M : R, (exists N : nat, forall n : nat, (N <= n)%nat -> M < u n) | m_infty => forall M : R, (forall N : nat, exists n : nat, (N <= n)%nat /\ u n < M) end. (** Equivalent forms *) Lemma is_LimInf_opp_LimSup_seq (u : nat -> R) (l : Rbar) : is_LimInf_seq (fun n => - u n) (Rbar_opp l) <-> is_LimSup_seq u l. Proof. case: l => [l | | ] /= ; split => Hl. (* l \in R *) (* * -> *) move => eps ; case: (Hl eps) => {Hl} H1 H2 ; split. move => N ; case: (H1 N) => {H1} n [Hn H1]. exists n ; split. by []. apply Ropp_lt_cancel. apply Rlt_le_trans with (1 := H1) ; right ; ring. case: H2 => N H2. exists N => n Hn. apply Ropp_lt_cancel. apply Rle_lt_trans with (2 := H2 _ Hn) ; right ; ring. (* * <- *) move => eps ; case: (Hl eps) => {Hl} H1 H2 ; split. move => N ; case: (H1 N) => {H1} n [Hn H1]. exists n ; split. by []. apply Ropp_lt_cancel ; rewrite Ropp_involutive. apply Rle_lt_trans with (2 := H1) ; right ; ring. case: H2 => N H2. exists N => n Hn. apply Ropp_lt_cancel ; rewrite Ropp_involutive. apply Rlt_le_trans with (1 := H2 _ Hn) ; right ; ring. (* l = p_infty *) move => M N. case: (Hl (-M) N) => {Hl} n [Hn Hl]. exists n ; split. by []. by apply Ropp_lt_cancel. move => M N. case: (Hl (-M) N) => {Hl} n [Hn Hl]. exists n ; split. by []. apply Ropp_lt_cancel ; by rewrite Ropp_involutive. (* l = m_infty *) move => M. case: (Hl (-M)) => {Hl} N Hl. exists N => n Hn. apply Ropp_lt_cancel. by apply Hl. move => M. case: (Hl (-M)) => {Hl} N Hl. exists N => n Hn. apply Ropp_lt_cancel ; rewrite Ropp_involutive. by apply Hl. Qed. Lemma is_LimSup_opp_LimInf_seq (u : nat -> R) (l : Rbar) : is_LimSup_seq (fun n => - u n) (Rbar_opp l) <-> is_LimInf_seq u l. Proof. case: l => [l | | ] /= ; split => Hl. (* l \in R *) (* * -> *) move => eps ; case: (Hl eps) => {Hl} H1 H2 ; split. move => N ; case: (H1 N) => {H1} n [Hn H1]. exists n ; split. by []. apply Ropp_lt_cancel. apply Rle_lt_trans with (2 := H1) ; right ; ring. case: H2 => N H2. exists N => n Hn. apply Ropp_lt_cancel. apply Rlt_le_trans with (1 := H2 _ Hn) ; right ; ring. (* * <- *) move => eps ; case: (Hl eps) => {Hl} H1 H2 ; split. move => N ; case: (H1 N) => {H1} n [Hn H1]. exists n ; split. by []. apply Ropp_lt_cancel ; rewrite Ropp_involutive. apply Rlt_le_trans with (1 := H1) ; right ; ring. case: H2 => N H2. exists N => n Hn. apply Ropp_lt_cancel ; rewrite Ropp_involutive. apply Rle_lt_trans with (2 := H2 _ Hn) ; right ; ring. (* l = p_infty *) move => M. case: (Hl (-M)) => {Hl} N Hl. exists N => n Hn. apply Ropp_lt_cancel. by apply Hl. move => M. case: (Hl (-M)) => {Hl} N Hl. exists N => n Hn. apply Ropp_lt_cancel ; rewrite Ropp_involutive. by apply Hl. (* l = m_infty *) move => M N. case: (Hl (-M) N) => {Hl} n [Hn Hl]. exists n ; split. by []. by apply Ropp_lt_cancel. move => M N. case: (Hl (-M) N) => {Hl} n [Hn Hl]. exists n ; split. by []. apply Ropp_lt_cancel ; by rewrite Ropp_involutive. Qed. Lemma is_LimSup_infSup_seq (u : nat -> R) (l : Rbar) : is_LimSup_seq u l <-> is_inf_seq (fun m => Sup_seq (fun n => u (n + m)%nat)) l. Proof. case: l => [l | | ] ; rewrite /is_LimSup_seq /is_inf_seq ; split => Hl. (* l \in R *) (* * -> *) split. move => N. apply Sup_seq_minor_lt. case: (proj1 (Hl eps) N) => {Hl} n Hl. exists (n - N)%nat. rewrite MyNat.sub_add ; intuition. case: (proj2 (Hl (pos_div_2 eps))) => /= {Hl} N Hl. exists N ; rewrite /Sup_seq ; case: ex_sup_seq => un Hun ; simpl proj1_sig. case: un Hun => [un | | ] /= Hun. case: (proj2 (Hun (pos_div_2 eps))) => {Hun} /= n Hun. apply Rlt_minus_l in Hun. apply Rlt_trans with (1 := Hun). apply Rlt_minus_r. apply Rlt_le_trans with (1 := Hl _ (MyNat.le_add_l _ _)) ; right ; field. case: (Hun (l + eps / 2)) => {Hun} n. apply Rle_not_lt, Rlt_le, Hl, MyNat.le_add_l. by []. (* * <- *) split. move => N. move: (proj1 (Hl eps) N) => {} Hl. apply Sup_seq_minor_lt in Hl. case: Hl => /= n Hl. exists (n + N)%nat ; intuition. case: (proj2 (Hl eps)) => {Hl} N Hl. exists N => n Hn. apply (Rbar_not_le_lt (l + eps) (u n)). contradict Hl. apply Rbar_le_not_lt. apply Sup_seq_minor_le with (n - N)%nat. by rewrite MyNat.sub_add. (* l = p_infty *) move => M N. case: (Hl M N) => {Hl} n Hl. apply Sup_seq_minor_lt. exists (n - N)%nat. rewrite MyNat.sub_add ; intuition. move => M N. move: (Hl M N) => {} Hl. apply Sup_seq_minor_lt in Hl. case: Hl => /= n Hl. exists (n + N)%nat ; intuition. (* l = m_infty *) move => M. case: (Hl (M-1)) => {Hl} N Hl. exists N ; rewrite /Sup_seq ; case: ex_sup_seq => un Hun ; simpl proj1_sig. case: un Hun => [un | | ] /= Hun. case: (proj2 (Hun (mkposreal _ Rlt_0_1))) => {Hun} /= n Hun. apply Rlt_minus_l in Hun. apply Rlt_trans with (1 := Hun). apply Rlt_minus_r. apply Hl ; intuition. case: (Hun (M-1)) => {Hun} n. apply Rle_not_lt, Rlt_le, Hl, MyNat.le_add_l. by []. move => M. case: (Hl M) => {Hl} N Hl. exists N => n Hn. apply (Rbar_not_le_lt M (u n)). contradict Hl. apply Rbar_le_not_lt. apply Sup_seq_minor_le with (n - N)%nat. by rewrite MyNat.sub_add. Qed. Lemma is_LimInf_supInf_seq (u : nat -> R) (l : Rbar) : is_LimInf_seq u l <-> is_sup_seq (fun m => Inf_seq (fun n => u (n + m)%nat)) l. Proof. rewrite -is_LimSup_opp_LimInf_seq. rewrite is_LimSup_infSup_seq. rewrite -is_sup_opp_inf_seq. rewrite Rbar_opp_involutive. split ; apply is_sup_seq_ext => n ; by rewrite Inf_opp_sup. Qed. (** Extensionality *) Lemma is_LimSup_seq_ext_loc (u v : nat -> R) (l : Rbar) : eventually (fun n => u n = v n) -> is_LimSup_seq u l -> is_LimSup_seq v l. Proof. case: l => [l | | ] /= [Next Hext] Hu. move => eps. case: (Hu eps) => {Hu} H1 H2 ; split. move => N. case: (H1 (N + Next)%nat) => {H1} n [Hn H1]. exists n ; rewrite -Hext ; intuition. case: H2 => N H2. exists (N + Next)%nat => n Hn. rewrite -Hext ; intuition. move => M N. case: (Hu M (N + Next)%nat) => {Hu} n [Hn Hu]. exists n ; rewrite -Hext ; intuition. move => M. case: (Hu M) => {Hu} N Hu. exists (N + Next)%nat => n Hn. rewrite -Hext ; intuition. Qed. Lemma is_LimSup_seq_ext (u v : nat -> R) (l : Rbar) : (forall n, u n = v n) -> is_LimSup_seq u l -> is_LimSup_seq v l. Proof. move => Hext. apply is_LimSup_seq_ext_loc. exists O => n _ ; by apply Hext. Qed. Lemma is_LimInf_seq_ext_loc (u v : nat -> R) (l : Rbar) : eventually (fun n => u n = v n) -> is_LimInf_seq u l -> is_LimInf_seq v l. Proof. case => N Hext Hu. apply is_LimSup_opp_LimInf_seq. apply is_LimSup_seq_ext_loc with (fun n => - u n). exists N => n Hn ; by rewrite Hext. by apply is_LimSup_opp_LimInf_seq. Qed. Lemma is_LimInf_seq_ext (u v : nat -> R) (l : Rbar) : (forall n, u n = v n) -> is_LimInf_seq u l -> is_LimInf_seq v l. Proof. move => Hext. apply is_LimInf_seq_ext_loc. exists O => n _ ; by apply Hext. Qed. (** Existence *) Lemma ex_LimSup_seq (u : nat -> R) : {l : Rbar | is_LimSup_seq u l}. Proof. case: (ex_inf_seq (fun m : nat => Sup_seq (fun n : nat => u (n + m)%nat))) => l Hl. exists l. by apply is_LimSup_infSup_seq. Qed. Lemma ex_LimInf_seq (u : nat -> R) : {l : Rbar | is_LimInf_seq u l}. Proof. case: (ex_sup_seq (fun m : nat => Inf_seq (fun n : nat => u (n + m)%nat))) => l Hl. exists l. by apply is_LimInf_supInf_seq. Qed. (** Functions *) Definition LimSup_seq (u : nat -> R) := proj1_sig (ex_LimSup_seq u). Definition LimInf_seq (u : nat -> R) := proj1_sig (ex_LimInf_seq u). (** Uniqueness *) Lemma is_LimSup_seq_unique (u : nat -> R) (l : Rbar) : is_LimSup_seq u l -> LimSup_seq u = l. Proof. move => H. rewrite /LimSup_seq. case: ex_LimSup_seq => lu Hu /=. apply is_LimSup_infSup_seq in H. apply is_LimSup_infSup_seq in Hu. rewrite -(is_inf_seq_unique _ _ Hu). by apply is_inf_seq_unique. Qed. Lemma is_LimInf_seq_unique (u : nat -> R) (l : Rbar) : is_LimInf_seq u l -> LimInf_seq u = l. Proof. move => H. rewrite /LimInf_seq. case: ex_LimInf_seq => lu Hu /=. apply is_LimInf_supInf_seq in H. apply is_LimInf_supInf_seq in Hu. rewrite -(is_sup_seq_unique _ _ Hu). by apply is_sup_seq_unique. Qed. Lemma LimSup_InfSup_seq (u : nat -> R) : LimSup_seq u = Inf_seq (fun m => Sup_seq (fun n => u (n + m)%nat)). Proof. apply is_LimSup_seq_unique. apply is_LimSup_infSup_seq. rewrite /Inf_seq. by case: ex_inf_seq. Qed. Lemma LimInf_SupInf_seq (u : nat -> R) : LimInf_seq u = Sup_seq (fun m => Inf_seq (fun n => u (n + m)%nat)). Proof. apply is_LimInf_seq_unique. apply is_LimInf_supInf_seq. rewrite /Sup_seq. by case: ex_sup_seq. Qed. (** ** Operations and order *) Lemma is_LimSup_LimInf_seq_le (u : nat -> R) (ls li : Rbar) : is_LimSup_seq u ls -> is_LimInf_seq u li -> Rbar_le li ls. Proof. case: ls => [ls | | ] ; case: li => [li | | ] //= Hls Hli. apply le_epsilon => e He ; set eps := pos_div_2 (mkposreal e He). replace li with ((li - eps) + eps) by ring. replace (ls + e) with ((ls + eps) + eps) by (simpl ; field). apply Rplus_le_compat_r, Rlt_le. case: (proj2 (Hls eps)) => {Hls} Ns Hls. case: (proj2 (Hli eps)) => {Hli} Ni Hli. apply Rlt_trans with (u (Ns + Ni)%nat). apply Hli ; by intuition. apply Hls ; by intuition. case: (proj2 (Hls (mkposreal _ Rlt_0_1))) => {Hls} /= Ns Hls. case: (Hli (ls + 1)) => {Hli} Ni Hli. absurd (ls + 1 < u (Ns + Ni)%nat). apply Rle_not_lt, Rlt_le, Hls ; by intuition. apply Hli ; by intuition. case: (proj2 (Hli (mkposreal _ Rlt_0_1))) => {Hli} /= Ni Hli. case: (Hls (li - 1)) => {Hls} Ns Hls. absurd (li - 1 < u (Ns + Ni)%nat). apply Rle_not_lt, Rlt_le, Hls ; by intuition. apply Hli ; by intuition. case: (Hli 0) => {Hli} /= Ni Hli. case: (Hls 0) => {Hls} Ns Hls. absurd (0 < u (Ns + Ni)%nat). apply Rle_not_lt, Rlt_le, Hls ; by intuition. apply Hli ; by intuition. Qed. Lemma LimSup_LimInf_seq_le (u : nat -> R) : Rbar_le (LimInf_seq u) (LimSup_seq u). Proof. rewrite /LimInf_seq ; case: ex_LimInf_seq => /= li Hli. rewrite /LimSup_seq ; case: ex_LimSup_seq => /= ls Hls. by apply is_LimSup_LimInf_seq_le with u. Qed. (** Constant *) Lemma is_LimSup_seq_const (a : R) : is_LimSup_seq (fun _ => a) a. Proof. intros eps ; split. intros N ; exists N ; split. by apply Nat.le_refl. apply Rminus_lt_0 ; ring_simplify. by apply eps. exists O => _ _. apply Rminus_lt_0 ; ring_simplify. by apply eps. Qed. Lemma LimSup_seq_const (a : R) : LimSup_seq (fun _ => a) = a. Proof. apply is_LimSup_seq_unique. by apply is_LimSup_seq_const. Qed. Lemma is_LimInf_seq_const (a : R) : is_LimInf_seq (fun _ => a) a. Proof. intros eps ; split. intros N ; exists N ; split. by apply Nat.le_refl. apply Rminus_lt_0 ; ring_simplify. by apply eps. exists O => _ _. apply Rminus_lt_0 ; ring_simplify. by apply eps. Qed. Lemma LimInf_seq_const (a : R) : LimInf_seq (fun _ => a) = a. Proof. apply is_LimInf_seq_unique. by apply is_LimInf_seq_const. Qed. (** Opposite *) Lemma LimSup_seq_opp (u : nat -> R) : LimSup_seq (fun n => - u n) = Rbar_opp (LimInf_seq u). Proof. rewrite LimSup_InfSup_seq LimInf_SupInf_seq. rewrite Inf_opp_sup ; apply f_equal, Sup_seq_ext => m. rewrite Inf_opp_sup ; by apply f_equal, Sup_seq_ext => n. Qed. Lemma LimInf_seq_opp (u : nat -> R) : LimInf_seq (fun n => - u n) = Rbar_opp (LimSup_seq u). Proof. rewrite LimSup_InfSup_seq LimInf_SupInf_seq. rewrite Sup_opp_inf ; apply f_equal, Inf_seq_ext => m. rewrite Sup_opp_inf ; by apply f_equal, Inf_seq_ext => n. Qed. (** Rbar_le *) Lemma LimSup_le (u v : nat -> R) : eventually (fun n => u n <= v n) -> Rbar_le (LimSup_seq u) (LimSup_seq v). Proof. intros (N,H). rewrite /LimSup_seq. case: ex_LimSup_seq ; case => [lu | | ] //= Hlu ; case: ex_LimSup_seq ; case => [lv | | ] //= Hlv. apply Rnot_lt_le => Hl. apply Rminus_lt_0 in Hl. case: (Hlv (pos_div_2 (mkposreal _ Hl))) => {Hlv} /= _ [n Hlv]. case: (proj1 (Hlu (pos_div_2 (mkposreal _ Hl))) (N + n)%nat) => {Hlu} m /= [Hm Hlu]. move: (H _ (Nat.le_trans _ _ _ (Nat.le_add_r _ _) Hm)). apply Rlt_not_le. eapply Rlt_trans, Hlu. eapply Rlt_le_trans. eapply Hlv, Nat.le_trans, Hm. by apply MyNat.le_add_l. apply Req_le ; field. case: (Hlv (lu - 1)) => {Hlv} n Hlv. case: (proj1 (Hlu (mkposreal _ Rlt_0_1)) (N + n)%nat) => {Hlu} m /= [Hm Hlu]. move: (H _ (Nat.le_trans _ _ _ (Nat.le_add_r _ _) Hm)). apply Rlt_not_le. eapply Rlt_trans, Hlu. eapply Hlv, Nat.le_trans, Hm. by apply MyNat.le_add_l. case: (Hlv (mkposreal _ Rlt_0_1)) => {Hlv} /= _ [n Hlv]. case: (Hlu (lv + 1) (N + n)%nat) => {Hlu} /= m [Hm Hlu]. move: (H _ (Nat.le_trans _ _ _ (Nat.le_add_r _ _) Hm)). apply Rlt_not_le. eapply Rlt_trans, Hlu. eapply Hlv, Nat.le_trans, Hm. by apply MyNat.le_add_l. case: (Hlv 0) => {Hlv} n Hlv. case: (Hlu 0 (N + n)%nat) => {Hlu} m [Hm Hlu]. move: (H _ (Nat.le_trans _ _ _ (Nat.le_add_r _ _) Hm)). apply Rlt_not_le. eapply Rlt_trans, Hlu. eapply Hlv, Nat.le_trans, Hm. by apply MyNat.le_add_l. Qed. Lemma LimInf_le (u v : nat -> R) : eventually (fun n => u n <= v n) -> Rbar_le (LimInf_seq u) (LimInf_seq v). Proof. intros. apply Rbar_opp_le. rewrite -!LimSup_seq_opp. apply LimSup_le. move: H ; apply filter_imp => n. by apply Ropp_le_contravar. Qed. (** Scalar multplication *) Lemma is_LimSup_seq_scal_pos (a : R) (u : nat -> R) (l : Rbar) : (0 < a) -> is_LimSup_seq u l -> is_LimSup_seq (fun n => a * u n) (Rbar_mult a l). Proof. case: l => [l | | ] /= Ha Hu. move => eps. suff He : 0 < eps / a. case: (Hu (mkposreal _ He)) => {Hu} /= H1 H2 ; split. move => N ; case: (H1 N) => {H1} n [Hn H1]. exists n ; split. by []. rewrite (Rmult_comm _ (u n)) ; apply Rlt_div_l. by []. apply Rle_lt_trans with (2 := H1) ; right ; field ; by apply Rgt_not_eq. case: H2 => N H2. exists N => n Hn. rewrite (Rmult_comm _ (u n)) ; apply Rlt_div_r. by []. apply Rlt_le_trans with (1 := H2 _ Hn) ; right ; field ; by apply Rgt_not_eq. apply Rdiv_lt_0_compat ; [ by case eps | by [] ]. case: Rle_dec (Rlt_le _ _ Ha) => // H _. case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => {H} // _ _. move => M N. case: (Hu (M / a) N) => {Hu} n [Hn Hu]. exists n ; split. by []. rewrite (Rmult_comm _ (u n)) ; apply Rlt_div_l. by []. by []. case: Rle_dec (Rlt_le _ _ Ha) => // H _. case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => {H} // _ _. move => M. case: (Hu (M / a)) => {Hu} N Hu. exists N => n Hn. rewrite (Rmult_comm _ (u n)) ; apply Rlt_div_r. by []. by apply Hu. Qed. Lemma is_LimInf_seq_scal_pos (a : R) (u : nat -> R) (l : Rbar) : (0 < a) -> is_LimInf_seq u l -> is_LimInf_seq (fun n => a * u n) (Rbar_mult a l). Proof. move => Ha Hu. apply is_LimSup_opp_LimInf_seq in Hu. apply is_LimSup_opp_LimInf_seq. replace (Rbar_opp (Rbar_mult a l)) with (Rbar_mult a (Rbar_opp l)). apply is_LimSup_seq_ext with (fun n => a * - u n). move => n ; ring. by apply is_LimSup_seq_scal_pos. case: (l) => [x | | ] /=. apply f_equal ; ring. case: Rle_dec (Rlt_le _ _ Ha) => // H _. case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => // H _. case: Rle_dec (Rlt_le _ _ Ha) => // H _. case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Ha) => // H _. Qed. (** Index shifting *) Lemma is_LimSup_seq_ind_1 (u : nat -> R) (l : Rbar) : is_LimSup_seq u l <-> is_LimSup_seq (fun n => u (S n)) l. Proof. case: l => [l | | ] ; split => //= Hu. (* l \in R *) move => eps. case: (Hu eps) => {Hu} H1 H2 ; split. move => N. case: (H1 (S N)) => {H1} n [Hn H1]. exists (pred n). case: (n) Hn H1 => /= [ | m] Hm H1. by apply Nat.nle_succ_0 in Hm. split. by apply le_S_n. by apply H1. case: H2 => N H2. exists N => n Hn. apply H2 ; intuition. move => eps. case: (Hu eps) => {Hu} H1 H2 ; split. move => N. case: (H1 N) => {H1} n [Hn H1]. exists (S n) ; intuition. case: H2 => N H2. exists (S N) => n Hn. case: (n) Hn => /= [ | m] Hm. by apply Nat.nle_succ_0 in Hm. apply H2 ; intuition. (* l = p_infty *) move => M N. case: (Hu M (S N)) => {Hu} n [Hn Hu]. exists (pred n). case: (n) Hn Hu => /= [ | m] Hm Hu. by apply Nat.nle_succ_0 in Hm. split. by apply le_S_n. by apply Hu. move => M N. case: (Hu M N) => {Hu} n [Hn Hu]. exists (S n) ; intuition. (* l = m_infty *) move => M. case: (Hu M) => {Hu} N Hu. exists N => n Hn. apply Hu ; intuition. move => M. case: (Hu M) => {Hu} N Hu. exists (S N) => n Hn. case: (n) Hn => /= [ | m] Hm. by apply Nat.nle_succ_0 in Hm. apply Hu ; intuition. Qed. Lemma is_LimInf_seq_ind_1 (u : nat -> R) (l : Rbar) : is_LimInf_seq u l <-> is_LimInf_seq (fun n => u (S n)) l. Proof. rewrite -?is_LimSup_opp_LimInf_seq. by apply is_LimSup_seq_ind_1. Qed. Lemma is_LimSup_seq_ind_k (u : nat -> R) (k : nat) (l : Rbar) : is_LimSup_seq u l <-> is_LimSup_seq (fun n => u (n + k)%nat) l. Proof. elim: k u => [ | k IH] /= u. split ; apply is_LimSup_seq_ext => n ; by rewrite -plus_n_O. rewrite is_LimSup_seq_ind_1. rewrite (IH (fun n => u (S n))). split ; apply is_LimSup_seq_ext => n ; by rewrite plus_n_Sm. Qed. Lemma is_LimInf_seq_ind_k (u : nat -> R) (k : nat) (l : Rbar) : is_LimInf_seq u l <-> is_LimInf_seq (fun n => u (n + k)%nat) l. Proof. rewrite -?is_LimSup_opp_LimInf_seq. by apply (is_LimSup_seq_ind_k (fun n => - u n)). Qed. (** * Limit of sequences *) (** ** Definition *) Definition is_lim_seq (u : nat -> R) (l : Rbar) := filterlim u eventually (Rbar_locally l). Definition is_lim_seq' (u : nat -> R) (l : Rbar) := match l with | Finite l => forall eps : posreal, eventually (fun n => Rabs (u n - l) < eps) | p_infty => forall M : R, eventually (fun n => M < u n) | m_infty => forall M : R, eventually (fun n => u n < M) end. Definition ex_lim_seq (u : nat -> R) := exists l, is_lim_seq u l. Definition ex_finite_lim_seq (u : nat -> R) := exists l : R, is_lim_seq u l. Definition Lim_seq (u : nat -> R) : Rbar := Rbar_div_pos (Rbar_plus (LimSup_seq u) (LimInf_seq u)) {| pos := 2; cond_pos := Rlt_R0_R2 |}. Lemma is_lim_seq_spec : forall u l, is_lim_seq' u l <-> is_lim_seq u l. Proof. destruct l as [l| |] ; split. - intros H P [eps LP]. destruct (H eps) as [N HN]. exists N => n Hn. apply LP. now apply HN. - intros LP eps. specialize (LP (fun y => Rabs (y - l) < eps)). apply LP. now exists eps. - intros H P [M LP]. destruct (H M) as [N HN]. exists N => n Hn. apply LP. now apply HN. - intros LP M. specialize (LP (fun y => M < y)). apply LP. now exists M. - intros H P [M LP]. destruct (H M) as [N HN]. exists N => n Hn. apply LP. now apply HN. - intros LP M. specialize (LP (fun y => y < M)). apply LP. now exists M. Qed. (** Equivalence with standard library Reals *) Lemma is_lim_seq_Reals (u : nat -> R) (l : R) : is_lim_seq u l <-> Un_cv u l. Proof. split => Hl. move => e He. apply (Hl (fun y => R_dist y l < e)). now exists (mkposreal _ He). unfold is_lim_seq. change (Rbar_locally l) with (locally l). apply (filterlim_locally u l). case => e He. case: (Hl e He) => {Hl} /= N Hl. exists N => n Hn. by apply (Hl n Hn). Qed. Lemma is_lim_seq_p_infty_Reals (u : nat -> R) : is_lim_seq u p_infty <-> cv_infty u. Proof. split => Hl. move => M. case: (Hl (fun x => M < x)) => {Hl} [ | N Hl]. by exists M. by exists N. move => P [M HP]. eapply filter_imp. by apply HP. case: (Hl M) => {Hl} N HN. by exists N. Qed. Lemma is_lim_LimSup_seq (u : nat -> R) (l : Rbar) : is_lim_seq u l -> is_LimSup_seq u l. Proof. move /is_lim_seq_spec. case: l => [l | | ] /= Hu. move => eps ; case: (Hu eps) => {Hu} N Hu ; split. move => N0. exists (N + N0)%nat ; split. by apply MyNat.le_add_l. by apply Rabs_lt_between', Hu, Nat.le_add_r. exists N => n Hn. by apply Rabs_lt_between', Hu. move => M N0. case: (Hu M) => {Hu} N Hu. exists (N + N0)%nat ; split. by apply MyNat.le_add_l. by apply Hu, Nat.le_add_r. by []. Qed. Lemma is_lim_LimInf_seq (u : nat -> R) (l : Rbar) : is_lim_seq u l -> is_LimInf_seq u l. Proof. move /is_lim_seq_spec. case: l => [l | | ] /= Hu. move => eps ; case: (Hu eps) => {Hu} N Hu ; split. move => N0. exists (N + N0)%nat ; split. by apply MyNat.le_add_l. by apply Rabs_lt_between', Hu, Nat.le_add_r. exists N => n Hn. by apply Rabs_lt_between', Hu. by []. move => M N0. case: (Hu M) => {Hu} N Hu. exists (N + N0)%nat ; split. by apply MyNat.le_add_l. by apply Hu, Nat.le_add_r. Qed. Lemma is_LimSup_LimInf_lim_seq (u : nat -> R) (l : Rbar) : is_LimSup_seq u l -> is_LimInf_seq u l -> is_lim_seq u l. Proof. case: l => [l | | ] /= Hs Hi ; apply is_lim_seq_spec. move => eps. case: (proj2 (Hs eps)) => {Hs} Ns Hs. case: (proj2 (Hi eps)) => {Hi} Ni Hi. exists (Ns + Ni)%nat => n Hn. apply Rabs_lt_between' ; split. apply Hi ; intuition. apply Hs ; intuition. exact Hi. exact Hs. Qed. Lemma ex_lim_LimSup_LimInf_seq (u : nat -> R) : ex_lim_seq u <-> LimSup_seq u = LimInf_seq u. Proof. split => Hl. case: Hl => l Hu. transitivity l. apply is_LimSup_seq_unique. by apply is_lim_LimSup_seq. apply sym_eq, is_LimInf_seq_unique. by apply is_lim_LimInf_seq. exists (LimSup_seq u). apply is_LimSup_LimInf_lim_seq. rewrite /LimSup_seq ; by case: ex_LimSup_seq. rewrite Hl /LimInf_seq ; by case: ex_LimInf_seq. Qed. (** Extensionality *) Lemma is_lim_seq_ext_loc (u v : nat -> R) (l : Rbar) : eventually (fun n => u n = v n) -> is_lim_seq u l -> is_lim_seq v l. Proof. apply filterlim_ext_loc. Qed. Lemma ex_lim_seq_ext_loc (u v : nat -> R) : eventually (fun n => u n = v n) -> ex_lim_seq u -> ex_lim_seq v. Proof. move => H [l H0]. exists l ; by apply is_lim_seq_ext_loc with u. Qed. Lemma Lim_seq_ext_loc (u v : nat -> R) : eventually (fun n => u n = v n) -> Lim_seq u = Lim_seq v. Proof. intros. rewrite /Lim_seq. apply (f_equal (fun x => Rbar_div_pos x _)). apply f_equal2 ; apply sym_eq. apply is_LimSup_seq_unique. apply is_LimSup_seq_ext_loc with u. by []. rewrite /LimSup_seq ; by case: ex_LimSup_seq. apply is_LimInf_seq_unique. apply is_LimInf_seq_ext_loc with u. by []. rewrite /LimInf_seq ; by case: ex_LimInf_seq. Qed. Lemma is_lim_seq_ext (u v : nat -> R) (l : Rbar) : (forall n, u n = v n) -> is_lim_seq u l -> is_lim_seq v l. Proof. move => Hext. apply is_lim_seq_ext_loc. by exists O. Qed. Lemma ex_lim_seq_ext (u v : nat -> R) : (forall n, u n = v n) -> ex_lim_seq u -> ex_lim_seq v. Proof. move => H [l H0]. exists l ; by apply is_lim_seq_ext with u. Qed. Lemma Lim_seq_ext (u v : nat -> R) : (forall n, u n = v n) -> Lim_seq u = Lim_seq v. Proof. move => Hext. apply Lim_seq_ext_loc. by exists O. Qed. (** Unicity *) Lemma is_lim_seq_unique (u : nat -> R) (l : Rbar) : is_lim_seq u l -> Lim_seq u = l. Proof. move => Hu. rewrite /Lim_seq. replace l with (Rbar_div_pos (Rbar_plus l l) {| pos := 2; cond_pos := Rlt_R0_R2 |}) by (case: (l) => [x | | ] //= ; apply f_equal ; field). apply (f_equal (fun x => Rbar_div_pos x _)). apply f_equal2. apply is_LimSup_seq_unique. by apply is_lim_LimSup_seq. apply is_LimInf_seq_unique. by apply is_lim_LimInf_seq. Qed. Lemma Lim_seq_correct (u : nat -> R) : ex_lim_seq u -> is_lim_seq u (Lim_seq u). Proof. intros (l,H). cut (Lim_seq u = l). intros ; rewrite H0 ; apply H. apply is_lim_seq_unique, H. Qed. Lemma Lim_seq_correct' (u : nat -> R) : ex_finite_lim_seq u -> is_lim_seq u (real (Lim_seq u)). Proof. intros (l,H). cut (real (Lim_seq u) = l). intros ; rewrite H0 ; apply H. replace l with (real l) by auto. apply f_equal, is_lim_seq_unique, H. Qed. Lemma ex_finite_lim_seq_correct (u : nat -> R) : ex_finite_lim_seq u <-> ex_lim_seq u /\ is_finite (Lim_seq u). Proof. split. case => l Hl. split. by exists l. by rewrite (is_lim_seq_unique _ _ Hl). case ; case => l Hl H. exists l. rewrite -(is_lim_seq_unique _ _ Hl). by rewrite H (is_lim_seq_unique _ _ Hl). Qed. Lemma ex_lim_seq_dec (u : nat -> R) : {ex_lim_seq u} + {~ex_lim_seq u}. Proof. case: (Rbar_eq_dec (LimSup_seq u) (LimInf_seq u)) => H. left ; by apply ex_lim_LimSup_LimInf_seq. right ; contradict H ; by apply ex_lim_LimSup_LimInf_seq. Qed. Lemma ex_finite_lim_seq_dec (u : nat -> R) : {ex_finite_lim_seq u} + {~ ex_finite_lim_seq u}. Proof. case: (ex_lim_seq_dec u) => H. apply Lim_seq_correct in H. case: (Lim_seq u) H => [l | | ] H. left ; by exists l. right ; rewrite ex_finite_lim_seq_correct. rewrite (is_lim_seq_unique _ _ H) /is_finite //= ; by case. right ; rewrite ex_finite_lim_seq_correct. rewrite (is_lim_seq_unique _ _ H) /is_finite //= ; by case. right ; rewrite ex_finite_lim_seq_correct. contradict H ; by apply H. Qed. Definition ex_lim_seq_cauchy (u : nat -> R) := forall eps : posreal, exists N : nat, forall n m, (N <= n)%nat -> (N <= m)%nat -> Rabs (u n - u m) < eps. Lemma ex_lim_seq_cauchy_corr (u : nat -> R) : (ex_finite_lim_seq u) <-> ex_lim_seq_cauchy u. Proof. split => Hcv. apply Lim_seq_correct' in Hcv. apply is_lim_seq_spec in Hcv. move => eps. case: (Hcv (pos_div_2 eps)) => /= {Hcv} N H. exists N => n m Hn Hm. replace (u n - u m) with ((u n - (real (Lim_seq u))) - (u m - (real (Lim_seq u)))) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite Rabs_Ropp (double_var eps). apply Rplus_lt_compat ; by apply H. exists (LimSup_seq u). apply is_lim_seq_spec. intros eps. rewrite /LimSup_seq ; case: ex_LimSup_seq => /= l Hl. case: (Hcv (pos_div_2 eps)) => {Hcv} /= Ncv Hcv. case: l Hl => [l | | ] /= Hl. case: (Hl (pos_div_2 eps)) => {Hl} /= H1 [Nl H2]. exists (Ncv + Nl)%nat => n Hn. apply Rabs_lt_between' ; split. case: (H1 Ncv) => {H1} m [Hm H1]. replace (l - eps) with ((l - eps / 2) - eps / 2) by field. apply Rlt_trans with (u m - eps / 2). by apply Rplus_lt_compat_r. apply Rabs_lt_between'. apply Hcv ; intuition. apply Rlt_trans with (l + eps / 2). apply H2 ; intuition. apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. move: (fun n Hn => proj2 (proj1 (Rabs_lt_between' _ _ _) (Hcv n Ncv Hn (Nat.le_refl _)))) => {} Hcv. case: (Hl (u Ncv + eps / 2) Ncv) => {Hl} n [Hn Hl]. contradict Hl ; apply Rle_not_lt, Rlt_le. by apply Hcv. move: (fun n Hn => proj1 (proj1 (Rabs_lt_between' _ _ _) (Hcv n Ncv Hn (Nat.le_refl _)))) => {} Hcv. case: (Hl (u Ncv - eps / 2)) => {Hl} N Hl. move: (Hcv _ (Nat.le_add_r Ncv N)) => H. contradict H ; apply Rle_not_lt, Rlt_le, Hl, MyNat.le_add_l. Qed. (** ** Arithmetic operations and order *) (** Identity *) Lemma is_lim_seq_INR : is_lim_seq INR p_infty. Proof. apply is_lim_seq_spec. move => M. suff Hm : 0 <= Rmax 0 M. exists (S (nfloor (Rmax 0 M) Hm)) => n Hn. apply Rlt_le_trans with (2 := le_INR _ _ Hn). rewrite /nfloor S_INR. case: nfloor_ex => {n Hn} /= n Hn. apply Rle_lt_trans with (1 := Rmax_r 0 M). by apply Hn. apply Rmax_l. Qed. Lemma ex_lim_seq_INR : ex_lim_seq INR. Proof. exists p_infty ; by apply is_lim_seq_INR. Qed. Lemma Lim_seq_INR : Lim_seq INR = p_infty. Proof. intros. apply is_lim_seq_unique. apply is_lim_seq_INR. Qed. (** Constants *) Lemma is_lim_seq_const (a : R) : is_lim_seq (fun n => a) a. Proof. apply filterlim_const. Qed. Lemma ex_lim_seq_const (a : R) : ex_lim_seq (fun n => a). Proof. exists a ; by apply is_lim_seq_const. Qed. Lemma Lim_seq_const (a : R) : Lim_seq (fun n => a) = a. Proof. intros. apply is_lim_seq_unique. apply is_lim_seq_const. Qed. (** Subsequences *) Lemma eventually_subseq_loc : forall phi, eventually (fun n => (phi n < phi (S n))%nat) -> filterlim phi eventually eventually. Proof. intros phi [M Hphi] P [N HP]. exists (N+M)%nat. intros n Hn. apply HP. apply Nat.add_le_mono_l with M. rewrite Nat.add_comm ; apply Nat.le_trans with (1:=Hn). apply Nat.le_trans with (1:=MyNat.le_add_l _ (phi M)). assert (H:(forall x, M+phi M + x <= M+phi (x+M))%nat). induction x as [|x IH]. rewrite Nat.add_0_l Nat.add_0_r. apply Nat.le_refl. rewrite <- plus_n_Sm. apply Nat.le_succ_l. apply Nat.le_lt_trans with (1:=IH). apply Nat.add_lt_mono_l. apply Hphi. apply MyNat.le_add_l. assert (M <= n)%nat. apply Nat.le_trans with (2:=Hn); apply MyNat.le_add_l. specialize (H (n-M)%nat). replace (n-M+M)%nat with n in H. apply Nat.le_trans with (2:=H). rewrite (Nat.add_comm _ (phi M)) -Nat.add_assoc. apply Nat.add_le_mono_l. rewrite Nat.add_comm Nat.sub_add. apply Nat.le_refl. exact H0. now rewrite Nat.sub_add. Qed. Lemma eventually_subseq : forall phi, (forall n, (phi n < phi (S n))%nat) -> filterlim phi eventually eventually. Proof. intros phi Hphi. apply eventually_subseq_loc. by apply filter_forall. Qed. Lemma is_lim_seq_subseq (u : nat -> R) (l : Rbar) (phi : nat -> nat) : filterlim phi eventually eventually -> is_lim_seq u l -> is_lim_seq (fun n => u (phi n)) l. Proof. intros Hphi. now apply filterlim_comp. Qed. Lemma ex_lim_seq_subseq (u : nat -> R) (phi : nat -> nat) : filterlim phi eventually eventually -> ex_lim_seq u -> ex_lim_seq (fun n => u (phi n)). Proof. move => Hphi [l Hu]. exists l. by apply is_lim_seq_subseq. Qed. Lemma Lim_seq_subseq (u : nat -> R) (phi : nat -> nat) : filterlim phi eventually eventually -> ex_lim_seq u -> Lim_seq (fun n => u (phi n)) = Lim_seq u. Proof. move => Hphi Hu. apply is_lim_seq_unique. apply is_lim_seq_subseq. exact Hphi. by apply Lim_seq_correct. Qed. Lemma is_lim_seq_incr_1 (u : nat -> R) (l : Rbar) : is_lim_seq u l <-> is_lim_seq (fun n => u (S n)) l. Proof. split ; intros H P HP ; destruct (H P HP) as [N HN]. - exists N. intros n Hn. apply HN. now apply le_S. - exists (S N). intros n Hn. destruct n as [|n] ; try easy. apply HN. now apply le_S_n. Qed. Lemma ex_lim_seq_incr_1 (u : nat -> R) : ex_lim_seq u <-> ex_lim_seq (fun n => u (S n)). Proof. split ; move => [l H] ; exists l. by apply -> is_lim_seq_incr_1. by apply is_lim_seq_incr_1. Qed. Lemma Lim_seq_incr_1 (u : nat -> R) : Lim_seq (fun n => u (S n)) = Lim_seq u. Proof. rewrite /Lim_seq. replace (LimSup_seq (fun n : nat => u (S n))) with (LimSup_seq u). replace (LimInf_seq (fun n : nat => u (S n))) with (LimInf_seq u). by []. (* LimInf *) rewrite /LimInf_seq ; case: ex_LimInf_seq => l1 H1 ; case: ex_LimInf_seq => l2 H2 /= ; case: l1 H1 => [l1 | | ] /= H1 ; case: l2 H2 => [l2 | | ] /= H2. apply Rbar_finite_eq, Rle_antisym ; apply le_epsilon => e He ; set eps := mkposreal e He ; apply Rlt_le. case: (proj2 (H1 (pos_div_2 eps))) => /= {H1} N H1. case: (proj1 (H2 (pos_div_2 eps)) N) => /= {H2} n [Hn H2]. apply Rlt_trans with (u (S n) + e/2). replace l1 with ((l1-e/2)+e/2) by ring. apply Rplus_lt_compat_r. apply H1. apply Nat.le_trans with (1 := Hn). apply Nat.le_succ_diag_r. replace (l2+e) with ((l2+e/2)+e/2) by field. by apply Rplus_lt_compat_r, H2. case: (proj2 (H2 (pos_div_2 eps))) => /= {H2} N H2. case: (proj1 (H1 (pos_div_2 eps)) (S N)) => /= {H1} . case => [ | n] [Hn H1]. by apply Nat.nle_succ_0 in Hn. apply Rlt_trans with (u (S n) + e/2). replace l2 with ((l2-e/2)+e/2) by ring. apply Rplus_lt_compat_r. apply H2. by apply le_S_n, Hn. replace (l1+e) with ((l1+e/2)+e/2) by field. by apply Rplus_lt_compat_r, H1. have : False => //. case: (H2 (l1+1)) => {H2} N /= H2. case: (proj1 (H1 (mkposreal _ Rlt_0_1)) (S N)) ; case => /= {H1} [ | n] [Hn]. by apply Nat.nle_succ_0 in Hn. apply Rle_not_lt, Rlt_le, H2. by apply le_S_n. have : False => //. case: (proj2 (H1 (mkposreal _ Rlt_0_1))) => {H1} N /= H1. case: ((H2 (l1-1)) N) => /= {H2} n [Hn]. apply Rle_not_lt, Rlt_le, H1. by apply Nat.le_trans with (2 := Nat.le_succ_diag_r _). have : False => //. case: (H1 (l2+1)) => {H1} N /= H1. case: (proj1 (H2 (mkposreal _ Rlt_0_1)) N) => /= {H2} n [Hn]. apply Rle_not_lt, Rlt_le, H1. by apply Nat.le_trans with (2 := Nat.le_succ_diag_r _). by []. have : False => //. case: (H1 0) => {H1} N H1. case: (H2 0 N)=> {H2} n [Hn]. apply Rle_not_lt, Rlt_le, H1. by apply Nat.le_trans with (2 := Nat.le_succ_diag_r _). have : False => //. case: (proj2 (H2 (mkposreal _ Rlt_0_1))) => /= {H2} N H2. case: (H1 (l2-1) (S N)) ; case => [ | n] [Hn]. by apply Nat.nle_succ_0 in Hn. by apply Rle_not_lt, Rlt_le, H2, le_S_n. have : False => //. case: (H2 0) => {H2} N H2. case: (H1 0 (S N)) ; case => [ | n] [Hn]. by apply Nat.nle_succ_0 in Hn. by apply Rle_not_lt, Rlt_le, H2, le_S_n. by []. (* LimSup *) rewrite /LimSup_seq ; case: ex_LimSup_seq => l1 H1 ; case: ex_LimSup_seq => l2 H2 /= ; case: l1 H1 => [l1 | | ] /= H1 ; case: l2 H2 => [l2 | | ] /= H2. apply Rbar_finite_eq, Rle_antisym ; apply le_epsilon => e He ; set eps := mkposreal e He ; apply Rlt_le. case: (proj2 (H2 (pos_div_2 eps))) => /= {H2} N H2. case: ((proj1 (H1 (pos_div_2 eps))) (S N)) ; case => /= {H1} [ | n] [Hn H1]. by apply Nat.nle_succ_0 in Hn. replace l1 with ((l1-e/2)+e/2) by ring. replace (l2+e) with ((l2+e/2)+e/2) by field. apply Rplus_lt_compat_r. apply Rlt_trans with (1 := H1). by apply H2, le_S_n. case: (proj2 (H1 (pos_div_2 eps))) => /= {H1} N H1. case: ((proj1 (H2 (pos_div_2 eps))) N) => /= {H2} n [Hn H2]. replace l2 with ((l2-e/2)+e/2) by ring. replace (l1+e) with ((l1+e/2)+e/2) by field. apply Rplus_lt_compat_r. apply Rlt_trans with (1 := H2). by apply H1, Nat.le_trans with (2 := Nat.le_succ_diag_r _). have : False => //. case: (proj2 (H1 (mkposreal _ Rlt_0_1))) => /= {H1} N H1. case: (H2 (l1+1) N) => n [Hn]. by apply Rle_not_lt, Rlt_le, H1, Nat.le_trans with (2 := Nat.le_succ_diag_r _). have : False => //. case: (H2 (l1-1)) => {H2} N H2. case: (proj1 (H1 (mkposreal _ Rlt_0_1)) (S N)) ; case => [ | n] [Hn] /= . by apply Nat.nle_succ_0 in Hn. by apply Rle_not_lt, Rlt_le, H2, le_S_n. have : False => //. case: (proj2 (H2 (mkposreal _ Rlt_0_1))) => {H2} /= N H2. case: (H1 (l2+1) (S N)) ; case => [ | n] [Hn] /= . by apply Nat.nle_succ_0 in Hn. by apply Rle_not_lt, Rlt_le, H2, le_S_n. by []. have : False => //. case: (H2 0) => {H2} N H2. case: (H1 0 (S N)) ; case => [ | n] [Hn] /= . by apply Nat.nle_succ_0 in Hn. by apply Rle_not_lt, Rlt_le, H2, le_S_n. have : False => //. case: (H1 (l2-1)) => {H1} N H1. case: (proj1 (H2 (mkposreal _ Rlt_0_1)) N) => /= {H2} n [Hn]. by apply Rle_not_lt, Rlt_le, H1, Nat.le_trans with (2 := Nat.le_succ_diag_r _). have : False => //. case: (H1 0) => {H1} N H1. case: (H2 0 N) => {H2} n [Hn]. by apply Rle_not_lt, Rlt_le, H1, Nat.le_trans with (2 := Nat.le_succ_diag_r _). by []. Qed. Lemma is_lim_seq_incr_n (u : nat -> R) (N : nat) (l : Rbar) : is_lim_seq u l <-> is_lim_seq (fun n => u (n + N)%nat) l. Proof. split. elim: N u => [ | N IH] u Hu. move: Hu ; apply is_lim_seq_ext => n ; by rewrite Nat.add_0_r. apply is_lim_seq_incr_1, IH in Hu. move: Hu ; by apply is_lim_seq_ext => n ; by rewrite plus_n_Sm. elim: N u => [ | N IH] u Hu. move: Hu ; apply is_lim_seq_ext => n ; by rewrite Nat.add_0_r. apply is_lim_seq_incr_1, IH. move: Hu ; by apply is_lim_seq_ext => n ; by rewrite plus_n_Sm. Qed. Lemma ex_lim_seq_incr_n (u : nat -> R) (N : nat) : ex_lim_seq u <-> ex_lim_seq (fun n => u (n + N)%nat). Proof. split ; move => [l H] ; exists l. by apply -> is_lim_seq_incr_n. by apply is_lim_seq_incr_n in H. Qed. Lemma Lim_seq_incr_n (u : nat -> R) (N : nat) : Lim_seq (fun n => u (n + N)%nat) = Lim_seq u. Proof. elim: N u => [ | N IH] u. apply Lim_seq_ext => n ; by rewrite Nat.add_0_r. rewrite -(Lim_seq_incr_1 u) -(IH (fun n => u (S n))). apply Lim_seq_ext => n ; by rewrite plus_n_Sm. Qed. (** *** Order *) Lemma filterlim_le : forall {T F} {FF : ProperFilter' F} (f g : T -> R) (lf lg : Rbar), F (fun x => f x <= g x) -> filterlim f F (Rbar_locally lf) -> filterlim g F (Rbar_locally lg) -> Rbar_le lf lg. Proof. intros T F FF f g lf lg H Hf Hg. apply Rbar_not_lt_le. intros Hl. apply filter_not_empty. destruct lf as [lf| |] ; destruct lg as [lg| |] ; try easy. - assert (Hl' : 0 < (lf - lg) / 2). apply Rdiv_lt_0_compat. now apply -> Rminus_lt_0. apply Rlt_R0_R2. assert (Hlf : locally lf (fun y => (lf + lg) / 2 < y)). apply open_gt. replace ((lf + lg) / 2) with (lf - (lf - lg) / 2) by field. apply Rabs_lt_between'. by rewrite /Rminus Rplus_opp_r Rabs_R0. assert (Hlg : locally lg (fun y => y < (lf + lg) / 2)). apply open_lt. replace ((lf + lg) / 2) with (lg + (lf - lg) / 2) by field. apply Rabs_lt_between'. by rewrite /Rminus Rplus_opp_r Rabs_R0. specialize (Hf _ Hlf). specialize (Hg _ Hlg). unfold filtermap in Hf, Hg. generalize (filter_and _ _ (filter_and _ _ Hf Hg) H). apply filter_imp. intros x [[H1 H2] H3]. apply Rle_not_lt with (1 := H3). now apply Rlt_trans with ((lf + lg) / 2). - assert (Hlf : locally lf (fun y => lf - 1 < y)). apply open_gt. apply Rabs_lt_between'. rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rlt_0_1. assert (Hlg : Rbar_locally m_infty (fun y => Rbar_lt y (lf - 1))). now apply open_Rbar_lt'. specialize (Hf _ Hlf). specialize (Hg _ Hlg). unfold filtermap in Hf, Hg. generalize (filter_and _ _ (filter_and _ _ Hf Hg) H). apply filter_imp. intros x [[H1 H2] H3]. apply Rle_not_lt with (1 := H3). now apply Rlt_trans with (lf - 1). - assert (Hlf : Rbar_locally p_infty (fun y => Rbar_lt (lg + 1) y)). now apply open_Rbar_gt'. assert (Hlg : locally lg (fun y => y < lg + 1)). apply open_lt. apply Rabs_lt_between'. rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rlt_0_1. specialize (Hf _ Hlf). specialize (Hg _ Hlg). unfold filtermap in Hf, Hg. generalize (filter_and _ _ (filter_and _ _ Hf Hg) H). apply filter_imp. intros x [[H1 H2] H3]. apply Rle_not_lt with (1 := H3). now apply Rlt_trans with (lg + 1). - assert (Hlf : Rbar_locally p_infty (fun y => Rbar_lt 0 y)). now apply open_Rbar_gt'. assert (Hlg : Rbar_locally m_infty (fun y => Rbar_lt y 0)). now apply open_Rbar_lt'. specialize (Hf _ Hlf). specialize (Hg _ Hlg). unfold filtermap in Hf, Hg. generalize (filter_and _ _ (filter_and _ _ Hf Hg) H). apply filter_imp. intros x [[H1 H2] H3]. apply Rle_not_lt with (1 := H3). now apply Rlt_trans with 0. Qed. Lemma is_lim_seq_le_loc (u v : nat -> R) (l1 l2 : Rbar) : eventually (fun n => u n <= v n) -> is_lim_seq u l1 -> is_lim_seq v l2 -> Rbar_le l1 l2. Proof. apply filterlim_le. Qed. Lemma Lim_seq_le_loc (u v : nat -> R) : eventually (fun n => u n <= v n) -> Rbar_le (Lim_seq u) (Lim_seq v). Proof. intros. move: (LimSup_le _ _ H) (LimInf_le _ _ H). move: (LimSup_LimInf_seq_le u) (LimSup_LimInf_seq_le v). unfold Lim_seq. case: (LimSup_seq u) => [lsu | | ] //= ; case: (LimInf_seq u) => [liu | | ] //= ; case: (LimSup_seq v) => [lsv | | ] //= ; case: (LimInf_seq v) => [liv | | ] //= ; intros. apply Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat, Rlt_0_2. by apply Rplus_le_compat. by apply Req_le. Qed. Lemma is_lim_seq_le (u v : nat -> R) (l1 l2 : Rbar) : (forall n, u n <= v n) -> is_lim_seq u l1 -> is_lim_seq v l2 -> Rbar_le l1 l2. Proof. intros H. apply filterlim_le. now apply filter_forall. Qed. Lemma filterlim_ge_p_infty : forall {T F} {FF : Filter F} (f g : T -> R), F (fun x => f x <= g x) -> filterlim f F (Rbar_locally p_infty) -> filterlim g F (Rbar_locally p_infty). Proof. intros T F FF f g H Hf. intros P [M HM]. assert (H' : Rbar_locally p_infty (fun y => M < y)). now exists M. unfold filtermap. generalize (filter_and (fun x : T => f x <= g x) _ H (Hf (fun y : R => M < y) H')). apply filter_imp. intros x [H1 H2]. apply HM. now apply Rlt_le_trans with (f x). Qed. Lemma filterlim_le_m_infty : forall {T F} {FF : Filter F} (f g : T -> R), F (fun x => g x <= f x) -> filterlim f F (Rbar_locally m_infty) -> filterlim g F (Rbar_locally m_infty). Proof. intros T F FF f g H Hf. intros P [M HM]. pose ineq (y : R) := y < M. assert (H' : Rbar_locally m_infty ineq). now exists M. unfold filtermap. generalize (filter_and _ (fun x : T => ineq (f x)) H (Hf ineq H')). apply filter_imp. intros x [H1 H2]. apply HM. now apply Rle_lt_trans with (f x). Qed. Lemma filterlim_le_le : forall {T F} {FF : Filter F} (f g h : T -> R) (l : Rbar), F (fun x => f x <= g x <= h x) -> filterlim f F (Rbar_locally l) -> filterlim h F (Rbar_locally l) -> filterlim g F (Rbar_locally l). Proof. intros T F FF f g h l H Hf Hh. destruct l as [l| |]. - intros P [eps He]. assert (H' : Rbar_locally l (fun y => Rabs (y - l) < eps)). now exists eps. unfold filterlim, filter_le, filtermap in Hf, Hh |- *. generalize (filter_and _ _ H (filter_and _ _ (Hf _ H') (Hh _ H'))). apply filter_imp. intros x [H1 [H2 H3]]. apply He. apply Rabs_lt_between'. split. apply Rlt_le_trans with (2 := proj1 H1). now apply Rabs_lt_between'. apply Rle_lt_trans with (1 := proj2 H1). now apply Rabs_lt_between'. - apply filterlim_ge_p_infty with (2 := Hf). apply: filter_imp H. now intros x [H _]. - apply filterlim_le_m_infty with (2 := Hh). apply: filter_imp H. now intros x [_ H]. Qed. Lemma is_lim_seq_le_le_loc (u v w : nat -> R) (l : Rbar) : eventually (fun n => u n <= v n <= w n) -> is_lim_seq u l -> is_lim_seq w l -> is_lim_seq v l. Proof. apply filterlim_le_le. Qed. Lemma is_lim_seq_le_le (u v w : nat -> R) (l : Rbar) : (forall n, u n <= v n <= w n) -> is_lim_seq u l -> is_lim_seq w l -> is_lim_seq v l. Proof. intros H. apply filterlim_le_le. now apply filter_forall. Qed. Lemma is_lim_seq_le_p_loc (u v : nat -> R) : eventually (fun n => u n <= v n) -> is_lim_seq u p_infty -> is_lim_seq v p_infty. Proof. apply filterlim_ge_p_infty. Qed. Lemma is_lim_seq_le_m_loc (u v : nat -> R) : eventually (fun n => v n <= u n) -> is_lim_seq u m_infty -> is_lim_seq v m_infty. Proof. apply filterlim_le_m_infty. Qed. Lemma is_lim_seq_decr_compare (u : nat -> R) (l : R) : is_lim_seq u l -> (forall n, (u (S n)) <= (u n)) -> forall n, l <= u n. Proof. move /is_lim_seq_spec => Hu H n. apply Rnot_lt_le => H0. apply Rminus_lt_0 in H0. case: (Hu (mkposreal _ H0)) => {Hu} /= Nu Hu. move: (Hu _ (MyNat.le_add_l Nu n)). apply Rle_not_lt. apply Rle_trans with (2 := Rabs_maj2 _). rewrite Ropp_minus_distr'. apply Rplus_le_compat_l. apply Ropp_le_contravar. elim: (Nu) => [ | m IH]. rewrite Nat.add_0_r ; by apply Rle_refl. rewrite -plus_n_Sm. apply Rle_trans with (2 := IH). by apply H. Qed. Lemma is_lim_seq_incr_compare (u : nat -> R) (l : R) : is_lim_seq u l -> (forall n, (u n) <= (u (S n))) -> forall n, u n <= l. Proof. move /is_lim_seq_spec => Hu H n. apply Rnot_lt_le => H0. apply Rminus_lt_0 in H0. case: (Hu (mkposreal _ H0)) => {Hu} /= Nu Hu. move: (Hu _ (MyNat.le_add_l Nu n)). apply Rle_not_lt. apply Rle_trans with (2 := Rle_abs _). apply Rplus_le_compat_r. elim: (Nu) => [ | m IH]. rewrite Nat.add_0_r ; by apply Rle_refl. rewrite -plus_n_Sm. apply Rle_trans with (1 := IH). by apply H. Qed. Lemma ex_lim_seq_decr (u : nat -> R) : (forall n, (u (S n)) <= (u n)) -> ex_lim_seq u. Proof. move => H. exists (Inf_seq u). apply is_lim_seq_spec. rewrite /Inf_seq ; case: ex_inf_seq ; case => [l | | ] //= Hl. move => eps ; case: (Hl eps) => Hl1 [N Hl2]. exists N => n Hn. apply Rabs_lt_between' ; split. by apply Hl1. apply Rle_lt_trans with (2 := Hl2). elim: n N {Hl2} Hn => [ | n IH] N Hn. apply Nat.le_0_r in Hn. rewrite Hn. apply Rle_refl. apply le_lt_eq_dec in Hn. case: Hn => [Hn | ->]. apply Rle_trans with (1 := H _), IH ; intuition. by apply Rle_refl. move => M ; exists O => n _ ; by apply Hl. move => M. case: (Hl M) => {Hl} N Hl. exists N => n Hn. apply Rle_lt_trans with (2 := Hl). elim: Hn => [ | {} n Hn IH]. by apply Rle_refl. apply Rle_trans with (2 := IH). by apply H. Qed. Lemma ex_lim_seq_incr (u : nat -> R) : (forall n, (u n) <= (u (S n))) -> ex_lim_seq u. Proof. move => H. exists (Sup_seq u). apply is_lim_seq_spec. rewrite /Sup_seq ; case: ex_sup_seq ; case => [l | | ] //= Hl. move => eps ; case: (Hl eps) => Hl1 [N Hl2]. exists N => n Hn. apply Rabs_lt_between' ; split. apply Rlt_le_trans with (1 := Hl2). elim: Hn => [ | {} n Hn IH]. by apply Rle_refl. apply Rle_trans with (1 := IH). by apply H. by apply Hl1. move => M. case: (Hl M) => {Hl} N Hl. exists N => n Hn. apply Rlt_le_trans with (1 := Hl). elim: Hn => [ | {} n Hn IH]. by apply Rle_refl. apply Rle_trans with (1 := IH). by apply H. move => M ; exists O => n Hn ; by apply Hl. Qed. Lemma ex_finite_lim_seq_decr (u : nat -> R) (M : R) : (forall n, (u (S n)) <= (u n)) -> (forall n, M <= u n) -> ex_finite_lim_seq u. Proof. intros. apply ex_finite_lim_seq_correct. have H1 : ex_lim_seq u. exists (real (Inf_seq u)). apply is_lim_seq_spec. rewrite /Inf_seq ; case: ex_inf_seq ; case => [l | | ] //= Hl. move => eps ; case: (Hl eps) => Hl1 [N Hl2]. exists N => n Hn. apply Rabs_lt_between' ; split. by apply Hl1. apply Rle_lt_trans with (2 := Hl2). elim: n N {Hl2} Hn => [ | n IH] N Hn. apply Nat.le_0_r in Hn. rewrite Hn. apply Rle_refl. apply le_lt_eq_dec in Hn. case: Hn => [Hn | ->]. apply Rle_trans with (1 := H _), IH ; intuition. by apply Rle_refl. move: (Hl (u O) O) => H1 ; by apply Rlt_irrefl in H1. case: (Hl M) => {Hl} n Hl. apply Rlt_not_le in Hl. by move: (Hl (H0 n)). split => //. apply Lim_seq_correct in H1. case: (Lim_seq u) H1 => [l | | ] /= Hu. by []. apply is_lim_seq_spec in Hu. case: (Hu (u O)) => {Hu} N Hu. move: (Hu N (Nat.le_refl _)) => {} Hu. contradict Hu ; apply Rle_not_lt. elim: N => [ | N IH]. by apply Rle_refl. by apply Rle_trans with (1 := H _). apply is_lim_seq_spec in Hu. case: (Hu M) => {Hu} N Hu. move: (Hu N (Nat.le_refl _)) => {} Hu. contradict Hu ; by apply Rle_not_lt. Qed. Lemma ex_finite_lim_seq_incr (u : nat -> R) (M : R) : (forall n, (u n) <= (u (S n))) -> (forall n, u n <= M) -> ex_finite_lim_seq u. Proof. intros. case: (ex_finite_lim_seq_decr (fun n => - u n) (- M)). move => n ; by apply Ropp_le_contravar. move => n ; by apply Ropp_le_contravar. move => l ; move => Hu. exists (- l). apply is_lim_seq_spec in Hu. apply is_lim_seq_spec. intros eps. case: (Hu eps) => {Hu} N Hu. exists N => n Hn. replace (u n - - l) with (-(- u n - l)) by ring. rewrite Rabs_Ropp ; by apply Hu. Qed. (** *** Additive operators *) (** Opposite *) Lemma filterlim_Rbar_opp : forall x, filterlim Ropp (Rbar_locally x) (Rbar_locally (Rbar_opp x)). Proof. intros [x| |] P [eps He]. - exists eps. intros y Hy. apply He. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. by rewrite Ropp_involutive Rplus_comm Rabs_minus_sym. - exists (-eps). intros y Hy. apply He. apply Ropp_lt_cancel. by rewrite Ropp_involutive. - exists (-eps). intros y Hy. apply He. apply Ropp_lt_cancel. by rewrite Ropp_involutive. Qed. Lemma is_lim_seq_opp (u : nat -> R) (l : Rbar) : is_lim_seq u l <-> is_lim_seq (fun n => -u n) (Rbar_opp l). Proof. split ; move => Hu. apply is_LimSup_LimInf_lim_seq. apply is_LimSup_opp_LimInf_seq. by apply is_lim_LimInf_seq. apply is_LimInf_opp_LimSup_seq. by apply is_lim_LimSup_seq. apply is_LimSup_LimInf_lim_seq. apply is_LimInf_opp_LimSup_seq. by apply is_lim_LimInf_seq. apply is_LimSup_opp_LimInf_seq. by apply is_lim_LimSup_seq. Qed. Lemma ex_lim_seq_opp (u : nat -> R) : ex_lim_seq u <-> ex_lim_seq (fun n => -u n). Proof. split ; case => l Hl ; exists (Rbar_opp l). by apply -> is_lim_seq_opp. apply is_lim_seq_ext with (fun n => - - u n). move => n ; by apply Ropp_involutive. by apply -> is_lim_seq_opp. Qed. Lemma Lim_seq_opp (u : nat -> R) : Lim_seq (fun n => - u n) = Rbar_opp (Lim_seq u). Proof. rewrite /Lim_seq. rewrite LimSup_seq_opp LimInf_seq_opp. case: (LimInf_seq u) => [li | | ] ; case: (LimSup_seq u) => [ls | | ] //= ; apply f_equal ; field. Qed. (** Addition *) Lemma filterlim_Rbar_plus : forall x y z, is_Rbar_plus x y z -> filterlim (fun z => fst z + snd z) (filter_prod (Rbar_locally x) (Rbar_locally y)) (Rbar_locally z). Proof. intros x y z. wlog: x y z / (Rbar_le 0 z). intros Hw. case: (Rbar_le_lt_dec 0 z) => Hz Hp. by apply Hw. apply (filterlim_ext (fun z => - (- fst z + - snd z))). intros t. ring. rewrite -(Rbar_opp_involutive z). eapply filterlim_comp. 2: apply filterlim_Rbar_opp. assert (Hw' : filterlim (fun z => fst z + snd z) (filter_prod (Rbar_locally (Rbar_opp x)) (Rbar_locally (Rbar_opp y))) (Rbar_locally (Rbar_opp z))). apply Hw. rewrite -Ropp_0 -/(Rbar_opp 0). apply <- Rbar_opp_le. now apply Rbar_lt_le. revert Hp. clear. destruct x as [x| |] ; destruct y as [y| |] ; destruct z as [z| |] => //=. unfold is_Rbar_plus ; simpl => H. injection H => <-. apply f_equal, f_equal ; ring. clear Hw. intros P HP. specialize (Hw' P HP). destruct Hw' as [Q R H1 H2 H3]. exists (fun x => Q (- x)) (fun x => R (- x)). now apply filterlim_Rbar_opp. now apply filterlim_Rbar_opp. intros u v HQ HR. exact (H3 _ _ HQ HR). unfold is_Rbar_plus. case: z => [z| |] Hz Hp ; try by case: Hz. (* x + y \in R *) case: x y Hp Hz => [x| |] ; case => [y| |] //= ; case => <- Hz. intros P [eps He]. exists (fun u => Rabs (u - x) < pos_div_2 eps) (fun v => Rabs (v - y) < pos_div_2 eps). now exists (pos_div_2 eps). now exists (pos_div_2 eps). intros u v Hu Hv. apply He. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. replace (u + v + - (x + y)) with ((u - x) + (v - y)) by ring. rewrite (double_var eps) ; apply Rle_lt_trans with (1 := Rabs_triang _ _), Rplus_lt_compat. now apply Hu. now apply Hv. (* x + y = p_infty *) wlog: x y Hp {Hz} / (is_finite x) => [Hw|Hx]. case: x y Hp {Hz} => [x| |] ; case => [y| |] // _. now apply (Hw x p_infty). assert (Hw': filterlim (fun z => fst z + snd z) (filter_prod (Rbar_locally y) (Rbar_locally p_infty)) (Rbar_locally p_infty)). exact: Hw. intros P HP. specialize (Hw' P HP). destruct Hw' as [Q R H1 H2 H3]. exists R Q ; try assumption. intros u v Hu Hv. rewrite Rplus_comm. now apply (H3 v u). clear Hw. intros P [N HN]. exists (fun x => N/2 < x) (fun x => N/2 < x). now exists (N/2). now exists (N/2). intros x y Hx Hy. simpl. apply HN. rewrite (double_var N). now apply Rplus_lt_compat. case: x y Hp Hx => [x| |] ; case => [y| | ] //= _ _. intros P [N HN]. exists (fun u => Rabs (u - x) < 1) (fun v => N - x + 1 < v). now exists (mkposreal _ Rlt_0_1). now exists (N - x + 1). intros u v Hu Hv. simpl. apply HN. replace N with (x - 1 + (N - x + 1)) by ring. apply Rplus_lt_compat. now apply Rabs_lt_between'. exact Hv. Qed. Lemma is_lim_seq_plus (u v : nat -> R) (l1 l2 l : Rbar) : is_lim_seq u l1 -> is_lim_seq v l2 -> is_Rbar_plus l1 l2 l -> is_lim_seq (fun n => u n + v n) l. Proof. intros Hu Hv Hl. eapply filterlim_comp_2 ; try eassumption. now apply filterlim_Rbar_plus. Qed. Lemma is_lim_seq_plus' (u v : nat -> R) (l1 l2 : R) : is_lim_seq u l1 -> is_lim_seq v l2 -> is_lim_seq (fun n => u n + v n) (l1 + l2). Proof. intros Hu Hv. eapply is_lim_seq_plus. by apply Hu. by apply Hv. by []. Qed. Lemma ex_lim_seq_plus (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> ex_Rbar_plus (Lim_seq u) (Lim_seq v) -> ex_lim_seq (fun n => u n + v n). Proof. intros [lu Hu] [lv Hv] Hl ; exists (Rbar_plus lu lv). apply is_lim_seq_plus with lu lv ; try assumption. rewrite -(is_lim_seq_unique u lu) //. rewrite -(is_lim_seq_unique v lv) //. by apply Rbar_plus_correct. Qed. Lemma Lim_seq_plus (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> ex_Rbar_plus (Lim_seq u) (Lim_seq v) -> Lim_seq (fun n => u n + v n) = Rbar_plus (Lim_seq u) (Lim_seq v). Proof. intros Hu Hv Hl. apply is_lim_seq_unique. eapply is_lim_seq_plus ; try apply Lim_seq_correct ; try assumption. by apply Rbar_plus_correct. Qed. (** Subtraction *) Lemma is_lim_seq_minus (u v : nat -> R) (l1 l2 l : Rbar) : is_lim_seq u l1 -> is_lim_seq v l2 -> is_Rbar_minus l1 l2 l -> is_lim_seq (fun n => u n - v n) l. Proof. intros H1 H2 Hl. eapply is_lim_seq_plus ; try eassumption. apply -> is_lim_seq_opp ; apply H2. Qed. Lemma is_lim_seq_minus' (u v : nat -> R) (l1 l2 : R) : is_lim_seq u l1 -> is_lim_seq v l2 -> is_lim_seq (fun n => u n - v n) (l1 - l2). Proof. intros Hu Hv. eapply is_lim_seq_minus ; try eassumption. by []. Qed. Lemma ex_lim_seq_minus (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> ex_Rbar_minus (Lim_seq u) (Lim_seq v) -> ex_lim_seq (fun n => u n - v n). Proof. intros [lu Hu] [lv Hv] Hl ; exists (Rbar_minus lu lv). eapply is_lim_seq_minus ; try eassumption. rewrite -(is_lim_seq_unique u lu) //. rewrite -(is_lim_seq_unique v lv) //. by apply Rbar_plus_correct. Qed. Lemma Lim_seq_minus (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> ex_Rbar_minus (Lim_seq u) (Lim_seq v) -> Lim_seq (fun n => u n - v n) = Rbar_minus (Lim_seq u) (Lim_seq v). Proof. intros Hu Hv Hl. apply is_lim_seq_unique. eapply is_lim_seq_minus ; try apply Lim_seq_correct ; try assumption. by apply Rbar_plus_correct. Qed. (** *** Multiplicative operators *) (** Inverse *) Lemma filterlim_Rbar_inv : forall l : Rbar, l <> 0 -> filterlim Rinv (Rbar_locally l) (Rbar_locally (Rbar_inv l)). Proof. intros l. wlog: l / (Rbar_lt 0 l). intros Hw. case: (Rbar_lt_le_dec 0 l) => Hl. by apply Hw. case: (Rbar_le_lt_or_eq_dec _ _ Hl) => // {} Hl Hl0. rewrite -(Rbar_opp_involutive (Rbar_inv l)). replace (Rbar_opp (Rbar_inv l)) with (Rbar_inv (Rbar_opp l)) by (case: (l) Hl0 => [x | | ] //= Hl0 ; apply f_equal ; field ; contradict Hl0 ; by apply f_equal). apply (filterlim_ext_loc (fun x => (- / - x))). case: l Hl {Hl0} => [l| |] //= Hl. apply Ropp_0_gt_lt_contravar in Hl. exists (mkposreal _ Hl) => /= x H. field ; apply Rlt_not_eq. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /= in H. apply Rabs_lt_between' in H. apply Rlt_le_trans with (1 := proj2 H), Req_le. apply Rplus_opp_r. exists 0 => x H. field ; by apply Rlt_not_eq. eapply filterlim_comp. 2: apply filterlim_Rbar_opp. eapply filterlim_comp. apply filterlim_Rbar_opp. apply Hw. apply Rbar_opp_lt. rewrite Rbar_opp_involutive /= Ropp_0 ; by apply Hl. contradict Hl0. rewrite -(Rbar_opp_involutive l) Hl0 /= ; apply f_equal ; ring. case: l => [l| |] //= Hl _. (* l \in R *) assert (H1: 0 < l / 2). apply Rdiv_lt_0_compat with (1 := Hl). apply Rlt_R0_R2. intros P [eps HP]. suff He : 0 < Rmin (eps * ((l / 2) * l)) (l / 2). exists (mkposreal _ He) => x /= Hx. apply HP. assert (H2: l / 2 < x). apply Rle_lt_trans with (l - l / 2). apply Req_le ; field. apply Rabs_lt_between'. apply Rlt_le_trans with (1 := Hx). apply Rmin_r. assert (H3: 0 < x). now apply Rlt_trans with (l / 2). rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. replace (/ x + - / l) with (- (x - l) / (x * l)). rewrite Rabs_div. rewrite Rabs_Ropp. apply Rlt_div_l. apply Rabs_pos_lt, Rgt_not_eq. now apply Rmult_lt_0_compat. apply Rlt_le_trans with (eps * ((l / 2) * l)). apply Rlt_le_trans with (1 := Hx). apply Rmin_l. apply Rmult_le_compat_l. apply Rlt_le, eps. rewrite Rabs_mult. rewrite (Rabs_pos_eq l). apply Rmult_le_compat_r. now apply Rlt_le. apply Rle_trans with (2 := Rle_abs _). now apply Rlt_le. now apply Rlt_le. apply Rgt_not_eq. now apply Rmult_lt_0_compat. field ; split ; apply Rgt_not_eq => //. apply Rmin_case. apply Rmult_lt_0_compat. apply cond_pos. now apply Rmult_lt_0_compat. exact H1. (* l = p_infty *) intros P [eps HP]. exists (/eps) => n Hn. apply HP. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. rewrite Ropp_0 Rplus_0_r Rabs_Rinv. rewrite -(Rinv_involutive eps). apply Rinv_lt_contravar. apply Rmult_lt_0_compat. apply Rinv_0_lt_compat, eps. apply Rabs_pos_lt, Rgt_not_eq, Rlt_trans with (/eps). apply Rinv_0_lt_compat, eps. exact Hn. apply Rlt_le_trans with (2 := Rle_abs _). exact Hn. apply Rgt_not_eq, eps. apply Rgt_not_eq, Rlt_trans with (/eps). apply Rinv_0_lt_compat, eps. exact Hn. Qed. Lemma is_lim_seq_inv (u : nat -> R) (l : Rbar) : is_lim_seq u l -> l <> 0 -> is_lim_seq (fun n => / u n) (Rbar_inv l). Proof. intros Hu Hl. apply filterlim_comp with (1 := Hu). now apply filterlim_Rbar_inv. Qed. Lemma ex_lim_seq_inv (u : nat -> R) : ex_lim_seq u -> Lim_seq u <> 0 -> ex_lim_seq (fun n => / u n). Proof. intros. apply Lim_seq_correct in H. exists (Rbar_inv (Lim_seq u)). by apply is_lim_seq_inv. Qed. Lemma Lim_seq_inv (u : nat -> R) : ex_lim_seq u -> (Lim_seq u <> 0) -> Lim_seq (fun n => / u n) = Rbar_inv (Lim_seq u). Proof. move => Hl Hu. apply is_lim_seq_unique. apply is_lim_seq_inv. by apply Lim_seq_correct. by apply Hu. Qed. (** Multiplication *) Lemma filterlim_Rbar_mult : forall x y z, is_Rbar_mult x y z -> filterlim (fun z => fst z * snd z) (filter_prod (Rbar_locally x) (Rbar_locally y)) (Rbar_locally z). Proof. intros x y z. wlog: x y z / (Rbar_le 0 x). intros Hw. case: (Rbar_le_lt_dec 0 x) => Hx Hp. by apply Hw. apply (filterlim_ext (fun z => - (- fst z * snd z))). intros t. ring. rewrite -(Rbar_opp_involutive z). eapply filterlim_comp. 2: apply filterlim_Rbar_opp. assert (Hw' : filterlim (fun z => fst z * snd z) (filter_prod (Rbar_locally (Rbar_opp x)) (Rbar_locally y)) (Rbar_locally (Rbar_opp z))). apply Hw. replace (Finite 0) with (Rbar_opp 0) by apply (f_equal Finite), Ropp_0. apply Rbar_opp_le. by apply Rbar_lt_le. by apply is_Rbar_mult_opp_l. clear Hw. intros P HP. specialize (Hw' P HP). destruct Hw' as [Q R H1 H2 H3]. exists (fun x => Q (- x)) R. now apply filterlim_Rbar_opp. exact H2. intros u v HQ HR. exact (H3 _ _ HQ HR). wlog: x y z / (Rbar_le 0 y). intros Hw. case: (Rbar_le_lt_dec 0 y) => Hy Hx Hp. by apply Hw. apply (filterlim_ext (fun z => - (fst z * -snd z))). intros t. ring. rewrite -(Rbar_opp_involutive z). eapply filterlim_comp. 2: apply filterlim_Rbar_opp. assert (Hw' : filterlim (fun z => fst z * snd z) (filter_prod (Rbar_locally x) (Rbar_locally (Rbar_opp y))) (Rbar_locally (Rbar_opp z))). apply Hw. replace (Finite 0) with (Rbar_opp 0) by apply (f_equal Finite), Ropp_0. apply Rbar_opp_le. by apply Rbar_lt_le. by []. by apply is_Rbar_mult_opp_r. clear Hw. intros P HP. specialize (Hw' P HP). destruct Hw' as [Q R H1 H2 H3]. exists Q (fun x => R (- x)). exact H1. now apply filterlim_Rbar_opp. intros u v HQ HR. exact (H3 _ _ HQ HR). wlog: x y z / (Rbar_le x y). intros Hw. case: (Rbar_le_lt_dec x y) => Hl Hx Hy Hp. by apply Hw. assert (Hw' : filterlim (fun z => fst z * snd z) (filter_prod (Rbar_locally y) (Rbar_locally x)) (Rbar_locally z)). apply Hw ; try assumption. by apply Rbar_lt_le. by apply is_Rbar_mult_sym. intros P HP. specialize (Hw' P HP). destruct Hw' as [Q R H1 H2 H3]. exists R Q ; try assumption. intros u v HR HQ. simpl. rewrite Rmult_comm. exact (H3 _ _ HQ HR). case: x => [x| | ] ; case: y => [y| | ] ; case: z => [z| | ] Hl Hy Hx Hp ; try (by case: Hl) || (by case: Hx) || (by case: Hy). (* x, y \in R *) case: Hp => <-. intros P [eps HP]. assert (He: 0 < eps / (x + y + 1)). apply Rdiv_lt_0_compat. apply cond_pos. apply Rplus_le_lt_0_compat. now apply Rplus_le_le_0_compat. apply Rlt_0_1. set (d := mkposreal _ (Rmin_stable_in_posreal (mkposreal _ Rlt_0_1) (mkposreal _ He))). exists (fun u => Rabs (u - x) < d) (fun v => Rabs (v - y) < d). now exists d. now exists d. simpl. intros u v Hu Hv. apply HP. rewrite /ball /= /AbsRing_ball /abs /minus /plus /opp /=. replace (u * v + - (x * y)) with (x * (v - y) + y * (u - x) + (u - x) * (v - y)) by ring. replace (pos eps) with (x * (eps / (x + y + 1)) + y * (eps / (x + y + 1)) + 1 * (eps / (x + y + 1))). apply Rle_lt_trans with (1 := Rabs_triang _ _). apply Rplus_le_lt_compat. apply Rle_trans with (1 := Rabs_triang _ _). apply Rplus_le_compat. rewrite Rabs_mult Rabs_pos_eq //. apply Rmult_le_compat_l with (1 := Hx). apply Rlt_le. apply Rlt_le_trans with (1 := Hv). apply Rmin_r. rewrite Rabs_mult Rabs_pos_eq //. apply Rmult_le_compat_l with (1 := Hy). apply Rlt_le. apply Rlt_le_trans with (1 := Hu). apply Rmin_r. rewrite Rabs_mult. apply Rmult_le_0_lt_compat ; try apply Rabs_pos. apply Rlt_le_trans with (1 := Hu). apply Rmin_l. apply Rlt_le_trans with (1 := Hv). apply Rmin_r. field. apply Rgt_not_eq. apply Rplus_le_lt_0_compat. now apply Rplus_le_le_0_compat. apply Rlt_0_1. (* x \in R and y = p_infty *) move: Hp ; unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec => // Hx'. case: Rle_lt_or_eq_dec => {Hl Hx Hy Hx'} // Hx. move: Hp ; unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec => // Hx'. case: Rle_lt_or_eq_dec => {Hl Hx Hy Hx'} // Hx _. intros P [N HN]. exists (fun u => Rabs (u - x) < x / 2) (fun v => Rmax 0 (N / (x / 2)) < v). now exists (pos_div_2 (mkposreal _ Hx)). now exists (Rmax 0 (N / (x / 2))). intros u v Hu Hv. simpl. apply HN. apply Rle_lt_trans with ((x - x / 2) * Rmax 0 (N / (x / 2))). apply Rmax_case_strong => H. rewrite Rmult_0_r ; apply Rnot_lt_le ; contradict H ; apply Rlt_not_le. repeat apply Rdiv_lt_0_compat => //. by apply Rlt_R0_R2. apply Req_le ; field. by apply Rgt_not_eq. apply Rmult_le_0_lt_compat. lra. apply Rmax_l. now apply Rabs_lt_between'. exact Hv. move: Hp ; unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec => // Hx'. case: Rle_lt_or_eq_dec => {Hl Hx Hy Hx'} // Hx. (* l1 = l2 = p_infty *) clear. intros P [N HN]. exists (fun u => 1 < u) (fun v => Rabs N < v). now exists 1. now exists (Rabs N). intros u v Hu Hv. simpl. apply HN. apply Rle_lt_trans with (1 := Rle_abs _). rewrite -(Rmult_1_l (Rabs N)). apply Rmult_le_0_lt_compat. by apply Rle_0_1. by apply Rabs_pos. exact Hu. exact Hv. Qed. Lemma is_lim_seq_mult (u v : nat -> R) (l1 l2 l : Rbar) : is_lim_seq u l1 -> is_lim_seq v l2 -> is_Rbar_mult l1 l2 l -> is_lim_seq (fun n => u n * v n) l. Proof. intros Hu Hv Hp. eapply filterlim_comp_2 ; try eassumption. now apply filterlim_Rbar_mult. Qed. Lemma is_lim_seq_mult' (u v : nat -> R) (l1 l2 : R) : is_lim_seq u l1 -> is_lim_seq v l2 -> is_lim_seq (fun n => u n * v n) (l1 * l2). Proof. intros Hu Hv. eapply is_lim_seq_mult ; try eassumption. by []. Qed. Lemma ex_lim_seq_mult (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> ex_Rbar_mult (Lim_seq u) (Lim_seq v) -> ex_lim_seq (fun n => u n * v n). Proof. intros [lu Hu] [lv Hv] H ; exists (Rbar_mult lu lv). eapply is_lim_seq_mult ; try eassumption. rewrite -(is_lim_seq_unique u lu) //. rewrite -(is_lim_seq_unique v lv) //. by apply Rbar_mult_correct. Qed. Lemma Lim_seq_mult (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> ex_Rbar_mult (Lim_seq u) (Lim_seq v) -> Lim_seq (fun n => u n * v n) = Rbar_mult (Lim_seq u) (Lim_seq v). Proof. move => H1 H2 Hl. apply is_lim_seq_unique. eapply is_lim_seq_mult ; try apply Lim_seq_correct ; try eassumption. by apply Rbar_mult_correct. Qed. (** Multiplication by a scalar *) Lemma filterlim_Rbar_mult_l : forall (a : R) (l : Rbar), filterlim (Rmult a) (Rbar_locally l) (Rbar_locally (Rbar_mult a l)). Proof. intros a l. case: (Req_dec a 0) => [->|Ha]. apply (filterlim_ext (fun _ => 0)). intros x. apply sym_eq, Rmult_0_l. rewrite Rbar_mult_0_l. apply filterlim_const. eapply filterlim_comp_2. apply filterlim_const. apply filterlim_id. eapply (filterlim_Rbar_mult a l). apply Rbar_mult_correct ; by case: l. Qed. Lemma filterlim_Rbar_mult_r : forall (a : R) (l : Rbar), filterlim (fun x => Rmult x a) (Rbar_locally l) (Rbar_locally (Rbar_mult l a)). Proof. intros a l. apply (filterlim_ext (fun x => a * x)). apply Rmult_comm. rewrite Rbar_mult_comm. apply filterlim_Rbar_mult_l. Qed. Lemma is_lim_seq_scal_l (u : nat -> R) (a : R) (lu : Rbar) : is_lim_seq u lu -> is_lim_seq (fun n => a * u n) (Rbar_mult a lu). Proof. intros Hu H. apply filterlim_comp with (1 := Hu). by apply filterlim_Rbar_mult_l. Qed. Lemma ex_lim_seq_scal_l (u : nat -> R) (a : R) : ex_lim_seq u -> ex_lim_seq (fun n => a * u n). Proof. move => [l H]. exists (Rbar_mult a l). eapply is_lim_seq_scal_l ; try eassumption. Qed. Lemma Lim_seq_scal_l (u : nat -> R) (a : R) : Lim_seq (fun n => a * u n) = Rbar_mult a (Lim_seq u). Proof. case: (Req_dec a 0) => [ -> | Ha]. rewrite -(Lim_seq_ext (fun _ => 0)) /=. rewrite Lim_seq_const. case: (Lim_seq u) => [x | | ] //=. by rewrite Rmult_0_l. case: Rle_dec (Rle_refl 0) => // H _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => // _ _. case: Rle_dec (Rle_refl 0) => // H _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => // _ _. move => n ; by rewrite Rmult_0_l. wlog: a u Ha / (0 < a) => [Hw | {} Ha]. case: (Rlt_le_dec 0 a) => Ha'. by apply Hw. case: Ha' => // Ha'. rewrite -(Lim_seq_ext (fun n => - a * - u n)). rewrite -Rbar_mult_opp. rewrite -Lim_seq_opp. apply Hw. contradict Ha ; rewrite -(Ropp_involutive a) Ha ; ring. apply Ropp_lt_cancel ; by rewrite Ropp_0 Ropp_involutive. move => n ; ring. rewrite /Lim_seq. rewrite {2}/LimSup_seq ; case: ex_LimSup_seq => ls Hs ; rewrite {2}/LimInf_seq ; case: ex_LimInf_seq => li Hi ; simpl proj1_sig. apply (is_LimSup_seq_scal_pos a) in Hs => //. apply (is_LimInf_seq_scal_pos a) in Hi => //. rewrite (is_LimSup_seq_unique _ _ Hs). rewrite (is_LimInf_seq_unique _ _ Hi). case: ls {Hs} => [ls | | ] ; case: li {Hi} => [li | | ] //= ; case: (Rle_dec 0 a) (Rlt_le _ _ Ha) => // Ha' _ ; case: (Rle_lt_or_eq_dec 0 a Ha') (Rlt_not_eq _ _ Ha) => //= _ _ ; apply f_equal ; field. Qed. Lemma is_lim_seq_scal_r (u : nat -> R) (a : R) (lu : Rbar) : is_lim_seq u lu -> is_lim_seq (fun n => u n * a) (Rbar_mult lu a). Proof. move => Hu Ha. apply is_lim_seq_ext with ((fun n : nat => a * u n)). move => n ; by apply Rmult_comm. rewrite Rbar_mult_comm. apply is_lim_seq_scal_l. by apply Hu. Qed. Lemma ex_lim_seq_scal_r (u : nat -> R) (a : R) : ex_lim_seq u -> ex_lim_seq (fun n => u n * a). Proof. move => Hu. apply ex_lim_seq_ext with ((fun n : nat => a * u n)) ; try by intuition. apply ex_lim_seq_scal_l. by apply Hu. Qed. Lemma Lim_seq_scal_r (u : nat -> R) (a : R) : Lim_seq (fun n => u n * a) = Rbar_mult (Lim_seq u) a. Proof. rewrite Rbar_mult_comm -Lim_seq_scal_l. apply Lim_seq_ext ; by intuition. Qed. (** Division *) Lemma is_lim_seq_div (u v : nat -> R) (l1 l2 l : Rbar) : is_lim_seq u l1 -> is_lim_seq v l2 -> l2 <> 0 -> is_Rbar_div l1 l2 l -> is_lim_seq (fun n => u n / v n) l. Proof. intros. eapply is_lim_seq_mult ; try eassumption. now apply is_lim_seq_inv. Qed. Lemma is_lim_seq_div' (u v : nat -> R) (l1 l2 : R) : is_lim_seq u l1 -> is_lim_seq v l2 -> l2 <> 0 -> is_lim_seq (fun n => u n / v n) (l1 / l2). Proof. intros. eapply is_lim_seq_div ; try eassumption. now contradict H1 ; case: H1 => ->. by []. Qed. Lemma ex_lim_seq_div (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> Lim_seq v <> 0 -> ex_Rbar_div (Lim_seq u) (Lim_seq v) -> ex_lim_seq (fun n => u n / v n). Proof. intros. apply Lim_seq_correct in H. apply Lim_seq_correct in H0. exists (Rbar_div (Lim_seq u) (Lim_seq v)). eapply is_lim_seq_div ; try eassumption. by apply Rbar_mult_correct. Qed. Lemma Lim_seq_div (u v : nat -> R) : ex_lim_seq u -> ex_lim_seq v -> (Lim_seq v <> 0) -> ex_Rbar_div (Lim_seq u) (Lim_seq v) -> Lim_seq (fun n => u n / v n) = Rbar_div (Lim_seq u) (Lim_seq v). Proof. move => H0 H1 H2 H3. apply is_lim_seq_unique. eapply is_lim_seq_div ; try apply Lim_seq_correct ; try eassumption. by apply Rbar_mult_correct. Qed. (** *** Additional limits *) Lemma ex_lim_seq_adj (u v : nat -> R) : (forall n, u n <= u (S n)) -> (forall n, v (S n) <= v n) -> is_lim_seq (fun n => v n - u n) 0 -> ex_finite_lim_seq u /\ ex_finite_lim_seq v /\ Lim_seq u = Lim_seq v. Proof. move => Hu Hv H0. suff H : forall n, u n <= v n. suff Eu : ex_finite_lim_seq u. split ; try auto. suff Ev : ex_finite_lim_seq v. split ; try auto. apply is_lim_seq_unique in H0. rewrite Lim_seq_minus in H0 ; try by intuition. apply ex_finite_lim_seq_correct in Eu. apply ex_finite_lim_seq_correct in Ev. rewrite -(proj2 Eu) -(proj2 Ev) /= in H0 |- *. apply Rbar_finite_eq in H0 ; apply Rbar_finite_eq. by apply sym_eq, Rminus_diag_uniq, H0. by apply ex_finite_lim_seq_correct. by apply ex_finite_lim_seq_correct. apply ex_finite_lim_seq_correct in Eu. apply ex_finite_lim_seq_correct in Ev. by rewrite -(proj2 Eu) -(proj2 Ev). apply ex_finite_lim_seq_decr with (u O) => //. move => n ; apply Rle_trans with (2 := H _). elim: n => [ | n IH]. by apply Rle_refl. by apply Rle_trans with (2 := Hu _). apply ex_finite_lim_seq_incr with (v O) => //. move => n ; apply Rle_trans with (1 := H _). elim: n => [ | n IH]. by apply Rle_refl. by apply Rle_trans with (1 := Hv _). move => n0 ; apply Rnot_lt_le ; move/Rminus_lt_0 => H. apply is_lim_seq_spec in H0. case: (H0 (mkposreal _ H)) => /= {H0} N H0. move: (H0 _ (MyNat.le_add_l N n0)) ; apply Rle_not_lt. rewrite Rminus_0_r ; apply Rle_trans with (2 := Rabs_maj2 _). rewrite Ropp_minus_distr'. apply Rplus_le_compat, Ropp_le_contravar. elim: (N) => [ | m IH]. rewrite Nat.add_0_r ; apply Rle_refl. rewrite -plus_n_Sm ; by apply Rle_trans with (2 := Hu _). elim: (N) => [ | m IH]. rewrite Nat.add_0_r ; apply Rle_refl. rewrite -plus_n_Sm ; by apply Rle_trans with (1 := Hv _). Qed. (** Image by a continuous function *) Lemma is_lim_seq_continuous (f : R -> R) (u : nat -> R) (l : R) : continuity_pt f l -> is_lim_seq u l -> is_lim_seq (fun n => f (u n)) (f l). Proof. move => Cf Hu. apply continuity_pt_filterlim in Cf. apply filterlim_comp with (1 := Hu). exact Cf. Qed. (** Absolute value *) Lemma filterlim_Rabs : forall l : Rbar, filterlim Rabs (Rbar_locally l) (Rbar_locally (Rbar_abs l)). Proof. case => [l| |] /=. apply @filterlim_norm. intros P [N HP]. exists N => x Hx. apply HP. apply Rlt_le_trans with (1 := Hx). apply Rle_abs. intros P [N HP]. exists (-N) => x Hx. apply HP. apply Rlt_le_trans with (2 := Rabs_maj2 _), Ropp_lt_cancel. by rewrite Ropp_involutive. Qed. Lemma is_lim_seq_abs (u : nat -> R) (l : Rbar) : is_lim_seq u l -> is_lim_seq (fun n => Rabs (u n)) (Rbar_abs l). Proof. intros Hu. apply filterlim_comp with (1 := Hu). apply filterlim_Rabs. Qed. Lemma ex_lim_seq_abs (u : nat -> R) : ex_lim_seq u -> ex_lim_seq (fun n => Rabs (u n)). Proof. move => [l Hu]. exists (Rbar_abs l) ; by apply is_lim_seq_abs. Qed. Lemma Lim_seq_abs (u : nat -> R) : ex_lim_seq u -> Lim_seq (fun n => Rabs (u n)) = Rbar_abs (Lim_seq u). Proof. intros. apply is_lim_seq_unique. apply is_lim_seq_abs. by apply Lim_seq_correct. Qed. Lemma is_lim_seq_abs_0 (u : nat -> R) : is_lim_seq u 0 <-> is_lim_seq (fun n => Rabs (u n)) 0. Proof. split => Hu. rewrite -Rabs_R0. by apply (is_lim_seq_abs _ 0). apply is_lim_seq_spec in Hu. apply is_lim_seq_spec. move => eps. case: (Hu eps) => {Hu} N Hu. exists N => n Hn. move: (Hu n Hn) ; by rewrite ?Rminus_0_r Rabs_Rabsolu. Qed. (** Geometric sequences *) Lemma is_lim_seq_geom (q : R) : Rabs q < 1 -> is_lim_seq (fun n => q ^ n) 0. Proof. intros Hq. apply is_lim_seq_spec. move => [e He] /=. case: (pow_lt_1_zero q Hq e He) => N H. exists N => n Hn. rewrite Rminus_0_r ; by apply H. Qed. Lemma ex_lim_seq_geom (q : R) : Rabs q < 1 -> ex_lim_seq (fun n => q ^ n). Proof. move => Hq ; exists 0 ; by apply is_lim_seq_geom. Qed. Lemma Lim_seq_geom (q : R) : Rabs q < 1 -> Lim_seq (fun n => q ^ n) = 0. Proof. intros. apply is_lim_seq_unique. by apply is_lim_seq_geom. Qed. Lemma is_lim_seq_geom_p (q : R) : 1 < q -> is_lim_seq (fun n => q ^ n) p_infty. Proof. intros Hq. apply is_lim_seq_spec. move => M /=. case: (fun Hq => Pow_x_infinity q Hq (M+1)) => [ | N H]. by apply Rlt_le_trans with (1 := Hq), Rle_abs. exists N => n Hn. apply Rlt_le_trans with (M+1). rewrite -{1}(Rplus_0_r M) ; by apply Rplus_lt_compat_l, Rlt_0_1. rewrite -(Rabs_pos_eq (q^n)). by apply Rge_le, H. by apply pow_le, Rlt_le, Rlt_trans with (1 := Rlt_0_1). Qed. Lemma ex_lim_seq_geom_p (q : R) : 1 < q -> ex_lim_seq (fun n => q ^ n). Proof. move => Hq ; exists p_infty ; by apply is_lim_seq_geom_p. Qed. Lemma Lim_seq_geom_p (q : R) : 1 < q -> Lim_seq (fun n => q ^ n) = p_infty. Proof. intros. apply is_lim_seq_unique. by apply is_lim_seq_geom_p. Qed. Lemma ex_lim_seq_geom_m (q : R) : q <= -1 -> ~ ex_lim_seq (fun n => q ^ n). Proof. intros Hq [l H]. apply is_lim_seq_spec in H. destruct l as [l| |]. case: Hq => Hq. (* ~ is_lim_seq (q^n) l *) case: (H (mkposreal _ Rlt_0_1)) => /= {H} N H. move: (fun n Hn => Rabs_lt_between_Rmax _ _ _ (proj1 (Rabs_lt_between' _ _ _) (H n Hn))). set M := Rmax (l + 1) (- (l - 1)) => H0. case: (fun Hq => Pow_x_infinity q Hq M) => [ | N0 H1]. rewrite Rabs_left. apply Ropp_lt_cancel ; by rewrite Ropp_involutive. apply Rlt_trans with (1 := Hq) ; apply Ropp_lt_cancel ; rewrite Ropp_involutive Ropp_0 ; by apply Rlt_0_1. move: (H0 _ (Nat.le_add_r N N0)). by apply Rle_not_lt, Rge_le, H1, MyNat.le_add_l. (* ~ is_lim_seq ((-1)^n) l *) case: (H (mkposreal _ Rlt_0_1)) => /= {H} N H. rewrite Hq in H => {q Hq}. move: (H _ (le_n_2n _)) ; rewrite pow_1_even ; case/Rabs_lt_between' => _ H1. have H2 : (N <= S (2 * N))%nat. by apply Nat.le_trans with (1 := le_n_2n _), Nat.le_succ_diag_r. move: (H _ H2) ; rewrite pow_1_odd ; case/Rabs_lt_between' => {H} H2 _. move: H1 ; apply Rle_not_lt, Rlt_le. pattern 1 at 2 ; replace (1) with ((-1)+2) by ring. replace (l+1) with ((l-1)+2) by ring. by apply Rplus_lt_compat_r. (* ~ Rbar_is_lim_seq (q^n) p_infty *) case: (H 0) => {H} N H. have H0 : (N <= S (2 * N))%nat. by apply Nat.le_trans with (1 := le_n_2n _), Nat.le_succ_diag_r. move: (H _ H0) ; apply Rle_not_lt ; rewrite /pow -/pow. apply Rmult_le_0_r. apply Rle_trans with (1 := Hq), Ropp_le_cancel ; rewrite Ropp_involutive Ropp_0 ; by apply Rle_0_1. apply Ropp_le_contravar in Hq ; rewrite Ropp_involutive in Hq. rewrite pow_sqr -Rmult_opp_opp ; apply pow_le, Rmult_le_pos ; apply Rle_trans with (2 := Hq), Rle_0_1. (* ~ Rbar_is_lim_seq (q^n) m_infty *) case: (H 0) => {H} N H. move: (H _ (le_n_2n _)). apply Rle_not_lt. apply Ropp_le_contravar in Hq ; rewrite Ropp_involutive in Hq. rewrite pow_sqr -Rmult_opp_opp ; apply pow_le, Rmult_le_pos ; apply Rle_trans with (2 := Hq), Rle_0_1. Qed. (** Rbar_loc_seq converges *) Lemma is_lim_seq_Rbar_loc_seq (x : Rbar) : is_lim_seq (Rbar_loc_seq x) x. Proof. intros P HP. apply filterlim_Rbar_loc_seq. now apply Rbar_locally'_le. Qed. coquelicot-coquelicot-3.4.1/theories/Lub.v000066400000000000000000000602201455143432500205740ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect. Require Import Rbar Rcomplements Markov. (** This file gives properties of (least) upper and (greatest) lower bounds, especially in [Rbar]. - There are links between our bounds on [Rbar] and those of the standard library on [R]: for example Lemma [Rbar_ub_R_ub] between our [Rbar_is_upper_bound] and the standard library [is_upper_bound]. - From [Markov]'s principle, we deduce the construction of a lub (and of a glb) in [Rbar] from any non-empty set of reals: see Lemma [ex_lub_Rbar_ne]. *) Open Scope R_scope. (** * Bounds for sets in [R] *) (** ** Upper and Lower bounds *) Definition is_ub_Rbar (E : R -> Prop) (l : Rbar) := forall (x : R), E x -> Rbar_le x l. Definition is_lb_Rbar (E : R -> Prop) (l : Rbar) := forall (x : R), E x -> Rbar_le l x. Lemma is_ub_Rbar_opp (E : R -> Prop) (l : Rbar) : is_lb_Rbar E l <-> is_ub_Rbar (fun x => E (- x)) (Rbar_opp l). Proof. split ; intros Hl x Hx ; apply Rbar_opp_le. now rewrite Rbar_opp_involutive ; apply Hl. now apply Hl ; rewrite Ropp_involutive. Qed. Lemma is_lb_Rbar_opp (E : R -> Prop) (l : Rbar) : is_ub_Rbar E l <-> is_lb_Rbar (fun x => E (- x)) (Rbar_opp l). Proof. split ; intros Hl x Hx ; apply Rbar_opp_le. now rewrite Rbar_opp_involutive ; apply Hl. now apply Hl ; rewrite Ropp_involutive. Qed. (** Decidability *) Lemma is_ub_Rbar_dec (E : R -> Prop) : {l : R | is_ub_Rbar E l} + {(forall l : R, ~is_ub_Rbar E l)}. Proof. set (F (n : nat) (x : R) := x = 0 \/ (E x /\ x <= INR n)). assert (F_b : forall n, bound (F n)). intros ; exists (INR n) => x ; case => [-> | Hx]. by apply pos_INR. by apply Hx. assert (F_ex : forall n, (exists x : R, F n x)). intros ; exists 0 ; by left. set (u (n : nat) := proj1_sig (completeness (F n) (F_b n) (F_ex n))). destruct (LPO_ub_dec u) as [ [M HM] | HM]. + left ; exists M => x Hx. destruct (nfloor_ex (Rmax 0 x)) as [n Hn]. by apply Rmax_l. eapply Rle_trans, (HM (S n)). rewrite /u ; case: completeness => l Hl /=. apply Hl ; right ; split => //. rewrite S_INR ; eapply Rle_trans, Rlt_le, Hn. by apply Rmax_r. + right => l Hl. case: (HM (Rmax 0 l)) => n {HM}. apply Rle_not_lt. rewrite /u ; case: completeness => M HM /=. apply HM => x ; case => [ -> | Hx]. by apply Rmax_l. eapply Rle_trans, Rmax_r. apply Hl, Hx. Qed. Lemma is_lb_Rbar_dec (E : R -> Prop) : {l : R | is_lb_Rbar E l} + {(forall l : R, ~is_lb_Rbar E l)}. Proof. destruct (is_ub_Rbar_dec (fun x => E (- x))) as [ [l Hl] | Hl ]. left ; exists (Rbar_opp l). by apply is_ub_Rbar_opp ; rewrite (Rbar_opp_involutive l). right => l. specialize (Hl (Rbar_opp l)). contradict Hl. by apply (is_ub_Rbar_opp E l). Qed. (** Order *) Lemma is_ub_Rbar_subset (E1 E2 : R -> Prop) (l : Rbar) : (forall x : R, E2 x -> E1 x) -> is_ub_Rbar E1 l -> is_ub_Rbar E2 l. Proof. move => H ub1 x Hx. apply: ub1 ; by apply: H. Qed. Lemma is_lb_Rbar_subset (E1 E2 : R -> Prop) (l : Rbar) : (forall x : R, E2 x -> E1 x) -> is_lb_Rbar E1 l -> is_lb_Rbar E2 l. Proof. move => H ub1 x Hx. apply: ub1 ; by apply: H. Qed. (** ** Least upper bound and Greatest Lower Bound *) Definition is_lub_Rbar (E : R -> Prop) (l : Rbar) := is_ub_Rbar E l /\ (forall b, is_ub_Rbar E b -> Rbar_le l b). Definition is_glb_Rbar (E : R -> Prop) (l : Rbar) := is_lb_Rbar E l /\ (forall b, is_lb_Rbar E b -> Rbar_le b l). Lemma is_lub_Rbar_opp (E : R -> Prop) (l : Rbar) : is_glb_Rbar E l <-> is_lub_Rbar (fun x => E (- x)) (Rbar_opp l). Proof. split => [[lb glb] | [ub lub] ] ; split. by apply is_ub_Rbar_opp. intros b Hb. apply Rbar_opp_le ; rewrite Rbar_opp_involutive. apply glb, is_ub_Rbar_opp ; by rewrite Rbar_opp_involutive. by apply is_ub_Rbar_opp. intros b Hb. apply Rbar_opp_le. by apply lub, is_ub_Rbar_opp. Qed. Lemma is_glb_Rbar_opp (E : R -> Prop) (l : Rbar) : is_lub_Rbar E l <-> is_glb_Rbar (fun x => E (- x)) (Rbar_opp l). Proof. split => [[lb glb] | [ub lub] ] ; split. by apply is_lb_Rbar_opp. intros b Hb. apply Rbar_opp_le ; rewrite Rbar_opp_involutive. apply glb, is_lb_Rbar_opp ; by rewrite Rbar_opp_involutive. by apply is_lb_Rbar_opp. intros b Hb. apply Rbar_opp_le. by apply lub, is_lb_Rbar_opp. Qed. (** Existence *) Lemma ex_lub_Rbar (E : R -> Prop) : {l : Rbar | is_lub_Rbar E l}. Proof. destruct (is_ub_Rbar_dec E) as [[M HM] | HM] ; first last. (* sup = p_infty *) exists p_infty ; split. by []. case => [l | | ] // Hl. by specialize (HM l). specialize (HM 0). contradict HM => x Hx. by specialize (Hl x Hx). rename E into F. assert (F_b : bound F). exists M => x Hx. by apply HM. clear -F_b. set (E (m : nat) (x : R) := x = - INR m \/ F x). assert (E_b : forall m, bound (E m)). intros m. case: F_b => l Hl. exists (Rmax l (- INR m)) => x ; case => [ -> | Hx]. by apply Rmax_r. eapply Rle_trans, Rmax_l. by apply Hl. assert (E_ex : forall m, exists x : R, E m x). intros m ; exists (- INR m) ; by left. set (u m := proj1_sig (completeness (E m) (E_b m) (E_ex m))). destruct (LPO (fun n => u n <> - INR n)) as [ [n Hn] | Hn]. intros n. case: (Req_EM_T (u n) (- INR n)) => H. by right. by left. exists (u n). move: Hn ; rewrite /u ; case: completeness => l Hl /= H. split. intros x Hx. apply Hl ; by right. assert (- INR n < l). case: Hl => Hl _. case: (Hl (-INR n)) => //=. by left. intros H0 ; contradict H. by rewrite -H0. case => [b | | ] //= Hb. + apply Hl => x Hx. case: Hx => Hx ; first last. by apply Hb. rewrite Hx. apply Rnot_lt_le ; contradict H0. apply Rle_not_lt. apply Hl => y Hy. case: Hy => Hy. rewrite Hy ; apply Rle_refl. eapply Rle_trans, Rlt_le, H0. by apply Hb. + contradict H. apply Rle_antisym ; apply Hl. intros x Hx. case: Hx => [-> | Hx] //. by apply Rle_refl. by apply Hb in Hx. by left. assert (forall n, u n = - INR n). intros n. specialize (Hn n). case: (Req_dec (u n) (- INR n)) => // H. clear Hn. exists m_infty ; split => // x Hx. destruct (nfloor_ex (Rmax 0 (- x))) as [n Hn]. by apply Rmax_l. specialize (H (S n)). contradict H. apply Rgt_not_eq. rewrite /u S_INR ; case: completeness => l Hl /=. eapply Rlt_le_trans with x. apply Ropp_lt_cancel ; rewrite Ropp_involutive. eapply Rle_lt_trans, Hn. by apply Rmax_r. apply Hl. by right. Qed. Lemma ex_glb_Rbar (E : R -> Prop) : {l : Rbar | is_glb_Rbar E l}. Proof. case: (ex_lub_Rbar (fun x => E (- x))) => l Hl. exists (Rbar_opp l). apply is_lub_Rbar_opp ; by rewrite Rbar_opp_involutive. Qed. (** Functions *) Definition Lub_Rbar (E : R -> Prop) := proj1_sig (ex_lub_Rbar E). Definition Glb_Rbar (E : R -> Prop) := proj1_sig (ex_glb_Rbar E). Lemma is_lub_Rbar_unique (E : R -> Prop) (l : Rbar) : is_lub_Rbar E l -> Lub_Rbar E = l. Proof. move => Hl ; rewrite /Lub_Rbar ; case: ex_lub_Rbar => l' /= Hl'. apply Rbar_le_antisym. by apply Hl', Hl. by apply Hl, Hl'. Qed. Lemma is_glb_Rbar_unique (E : R -> Prop) (l : Rbar) : is_glb_Rbar E l -> Glb_Rbar E = l. Proof. move => Hl ; rewrite /Glb_Rbar ; case: ex_glb_Rbar => l' /= Hl'. apply Rbar_le_antisym. by apply Hl, Hl'. by apply Hl', Hl. Qed. Lemma Lub_Rbar_correct (E : R -> Prop) : is_lub_Rbar E (Lub_Rbar E). Proof. rewrite /Lub_Rbar ; by case: ex_lub_Rbar => l /= Hl. Qed. Lemma Glb_Rbar_correct (E : R -> Prop) : is_glb_Rbar E (Glb_Rbar E). Proof. rewrite /Glb_Rbar ; by case: ex_glb_Rbar => l /= Hl. Qed. (** Order *) Lemma is_lub_Rbar_subset (E1 E2 : R -> Prop) (l1 l2 : Rbar) : (forall x : R, E2 x -> E1 x) -> is_lub_Rbar E1 l1 -> is_lub_Rbar E2 l2 -> Rbar_le l2 l1. Proof. move => H [ub1 _] [_ lub2]. apply: lub2 ; by apply (is_ub_Rbar_subset E1), ub1. Qed. Lemma is_glb_Rbar_subset (E1 E2 : R -> Prop) (l1 l2 : Rbar) : (forall x : R, E2 x -> E1 x) -> is_glb_Rbar E1 l1 -> is_glb_Rbar E2 l2 -> Rbar_le l1 l2. Proof. move => H [ub1 _] [_ lub2]. apply: lub2 ; by apply (is_lb_Rbar_subset E1), ub1. Qed. Lemma is_lub_Rbar_eqset (E1 E2 : R -> Prop) (l : Rbar) : (forall x : R, E2 x <-> E1 x) -> is_lub_Rbar E1 l -> is_lub_Rbar E2 l. Proof. move => H [ub1 lub1] ; split. apply (is_ub_Rbar_subset E1) ; [apply H | apply ub1]. move => b Hb ; apply: lub1 ; apply (is_ub_Rbar_subset E2) ; [apply H | apply Hb]. Qed. Lemma is_glb_Rbar_eqset (E1 E2 : R -> Prop) (l : Rbar) : (forall x : R, E2 x <-> E1 x) -> is_glb_Rbar E1 l -> is_glb_Rbar E2 l. Proof. move => H [ub1 lub1] ; split. apply (is_lb_Rbar_subset E1) ; [apply H | apply ub1]. move => b Hb ; apply: lub1 ; apply (is_lb_Rbar_subset E2) ; [apply H | apply Hb]. Qed. Lemma Lub_Rbar_eqset (E1 E2 : R -> Prop) : (forall x, E1 x <-> E2 x) -> Lub_Rbar E1 = Lub_Rbar E2. Proof. move => H ; rewrite {2}/Lub_Rbar ; case: ex_lub_Rbar => l /= Hl. apply is_lub_Rbar_unique. move: Hl ; by apply is_lub_Rbar_eqset. Qed. Lemma Glb_Rbar_eqset (E1 E2 : R -> Prop) : (forall x, E1 x <-> E2 x) -> Glb_Rbar E1 = Glb_Rbar E2. Proof. move => H ; rewrite {2}/Glb_Rbar ; case: (ex_glb_Rbar E2) => l2 H2 /=. apply is_glb_Rbar_unique. move: H2 ; by apply is_glb_Rbar_eqset. Qed. (** * Bounds for sets in [Rbar] *) (** ** Upper and Lower bounds *) Definition Rbar_is_upper_bound (E : Rbar -> Prop) (l : Rbar) := forall x, E x -> Rbar_le x l. Definition Rbar_is_lower_bound (E : Rbar -> Prop) (l : Rbar) := forall x, E x -> Rbar_le l x. Lemma Rbar_ub_lb (E : Rbar -> Prop) (l : Rbar) : Rbar_is_upper_bound (fun x => E (Rbar_opp x)) (Rbar_opp l) <-> Rbar_is_lower_bound E l. Proof. split => Hl x Hx. apply Rbar_opp_le. apply Hl. by rewrite Rbar_opp_involutive. apply Rbar_opp_le. rewrite Rbar_opp_involutive. by apply Hl. Qed. Lemma Rbar_lb_ub (E : Rbar -> Prop) (l : Rbar) : Rbar_is_lower_bound (fun x => E (Rbar_opp x)) (Rbar_opp l) <-> Rbar_is_upper_bound E l. Proof. split => Hl x Hx. apply Rbar_opp_le. apply Hl. by rewrite Rbar_opp_involutive. apply Rbar_opp_le. rewrite Rbar_opp_involutive. by apply Hl. Qed. Lemma is_ub_Rbar_correct (E : R -> Prop) (l : Rbar) : is_ub_Rbar E l <-> Rbar_is_upper_bound (fun x => is_finite x /\ E x) l. Proof. split => [H x [<- Hx] | H x Hx] ; apply H => // ; by exists x. Qed. Lemma is_lb_Rbar_correct (E : R -> Prop) (l : Rbar) : is_lb_Rbar E l <-> Rbar_is_lower_bound (fun x => is_finite x /\ E x) l. Proof. split => [H x [<- Hx] | H x Hx] ; apply H => // ; by exists x. Qed. (** Basic properties *) Lemma Rbar_ub_p_infty (E : Rbar -> Prop) : Rbar_is_upper_bound E p_infty. Proof. now intros [x| |] Hx. Qed. Lemma Rbar_lb_m_infty (E : Rbar -> Prop) : Rbar_is_lower_bound E m_infty. Proof. easy. Qed. Lemma Rbar_ub_Finite (E : Rbar -> Prop) (l : R) : Rbar_is_upper_bound E l -> is_upper_bound (fun (x : R) => E x) l. Proof. intros H x Ex. now apply (H (Finite x)). Qed. Lemma Rbar_lb_Finite (E : Rbar -> Prop) (l : R) : Rbar_is_lower_bound E (Finite l) -> is_upper_bound (fun x => E (Finite (- x))) (- l). Proof. intros H x Ex. apply Ropp_le_cancel ; rewrite Ropp_involutive ; now apply (H (Finite (-x))). Qed. Lemma Rbar_ub_m_infty (E : Rbar -> Prop) : Rbar_is_upper_bound E m_infty -> forall x, E x -> x = m_infty. Proof. intros H [x| |] Hx ; now specialize (H _ Hx). Qed. Lemma Rbar_lb_p_infty (E : Rbar -> Prop) : Rbar_is_lower_bound E p_infty -> (forall x, E x -> x = p_infty). Proof. intros H x ; case x ; auto ; clear x ; [intros x| ] ; intros Hx. case (H _ Hx) ; simpl ; intuition. case (H _ Hx) ; simpl ; intuition. Qed. Lemma Rbar_lb_le_ub (E : Rbar -> Prop) (l1 l2 : Rbar) : (exists x, E x) -> Rbar_is_lower_bound E l1 -> Rbar_is_upper_bound E l2 -> Rbar_le l1 l2. Proof. intros (x, Hex) Hl Hu ; apply Rbar_le_trans with (y := x) ; [apply Hl | apply Hu] ; auto. Qed. Lemma Rbar_lb_eq_ub (E : Rbar -> Prop) (l : Rbar) : Rbar_is_lower_bound E l -> Rbar_is_upper_bound E l -> forall x, E x -> x = l. Proof. intros Hl Hu x Hx. apply Rbar_le_antisym ; [apply Hu | apply Hl] ; auto. Qed. (** Decidability *) Lemma Rbar_ub_dec (E : Rbar -> Prop) (Hp : ~ E p_infty) : {M : R | Rbar_is_upper_bound E M} + {(forall (M : R), ~Rbar_is_upper_bound E M)}. Proof. destruct (is_ub_Rbar_dec E) as [ [M HM] | HM ]. left ; exists M ; case => [x | | ] //= Hx. by apply HM. right => M. specialize (HM M). contradict HM => x Hx. by apply HM. Qed. Lemma Rbar_lb_dec (E : Rbar -> Prop) (Hm : ~ E m_infty) : {M : R | Rbar_is_lower_bound E (Finite M)} + {(forall M, ~Rbar_is_lower_bound E (Finite M))}. Proof. destruct (Rbar_ub_dec (fun x => E (Rbar_opp x)) Hm) as [(M, H)|H]. left ; exists (-M). apply Rbar_ub_lb ; simpl ; rewrite (Ropp_involutive M) ; auto. right ; intro M ; generalize (H (-M)) ; clear H ; intro H ; contradict H ; apply (Rbar_ub_lb E (Finite M)) ; auto. Qed. (** Order *) Lemma Rbar_is_ub_subset (E1 E2 : Rbar -> Prop) (l : Rbar) : (forall x, E1 x -> E2 x) -> (Rbar_is_upper_bound E2 l) -> (Rbar_is_upper_bound E1 l). Proof. intros Hs Hl x Ex ; apply Hl, Hs ; auto. Qed. Lemma Rbar_is_lb_subset (E1 E2 : Rbar -> Prop) (l : Rbar) : (forall x, E1 x -> E2 x) -> (Rbar_is_lower_bound E2 l) -> (Rbar_is_lower_bound E1 l). Proof. intros Hs Hl x Ex ; apply Hl, Hs ; auto. Qed. (** ** Least upper bound and Greatest Lower Bound *) Definition Rbar_is_lub (E : Rbar -> Prop) (l : Rbar) := Rbar_is_upper_bound E l /\ (forall b : Rbar, Rbar_is_upper_bound E b -> Rbar_le l b). Definition Rbar_is_glb (E : Rbar -> Prop) (l : Rbar) := Rbar_is_lower_bound E l /\ (forall b : Rbar, Rbar_is_lower_bound E b -> Rbar_le b l). Lemma Rbar_lub_glb (E : Rbar -> Prop) (l : Rbar) : Rbar_is_lub (fun x => E (Rbar_opp x)) (Rbar_opp l) <-> Rbar_is_glb E l. Proof. split ; [intros (ub, lub) | intros (lb, glb)] ; split. apply Rbar_ub_lb ; auto. intros b Hb ; generalize (lub _ (proj2 (Rbar_ub_lb _ _) Hb)) ; apply Rbar_opp_le. apply Rbar_lb_ub ; intros x ; simpl ; repeat rewrite Rbar_opp_involutive ; apply lb. intros b Hb. apply Rbar_opp_le ; rewrite Rbar_opp_involutive ; apply glb, Rbar_ub_lb ; rewrite Rbar_opp_involutive ; auto. Qed. Lemma Rbar_glb_lub (E : Rbar -> Prop) (l : Rbar) : Rbar_is_glb (fun x => E (Rbar_opp x)) (Rbar_opp l) <-> Rbar_is_lub E l. Proof. split ; [ intros (lb, glb) | intros (ub, lub)] ; split. apply Rbar_lb_ub ; auto. intros b Hb ; generalize (glb _ (proj2 (Rbar_lb_ub _ _) Hb)) ; apply Rbar_opp_le. apply Rbar_ub_lb ; intro x ; simpl ; repeat rewrite Rbar_opp_involutive ; apply ub. intros b Hb. apply Rbar_opp_le ; rewrite Rbar_opp_involutive ; apply lub, Rbar_lb_ub ; rewrite Rbar_opp_involutive ; auto. Qed. Lemma is_lub_Rbar_correct (E : R -> Prop) (l : Rbar) : is_lub_Rbar E l <-> Rbar_is_lub (fun x => is_finite x /\ E x) l. Proof. split => [[Hub Hlub]|[Hub Hlub]]. split ; [ | move => b Hb ; apply Hlub ] ; by apply is_ub_Rbar_correct. split ; [ | move => b Hb ; apply Hlub ] ; by apply is_ub_Rbar_correct. Qed. Lemma is_glb_Rbar_correct (E : R -> Prop) (l : Rbar) : is_glb_Rbar E l <-> Rbar_is_glb (fun x => is_finite x /\ E x) l. Proof. split => [[Hub Hlub]|[Hub Hlub]]. split ; [ | move => b Hb ; apply Hlub ] ; by apply is_lb_Rbar_correct. split ; [ | move => b Hb ; apply Hlub ] ; by apply is_lb_Rbar_correct. Qed. Lemma Rbar_ex_lub (E : Rbar -> Prop) : {l : Rbar | Rbar_is_lub E l}. Proof. destruct (EM_dec (E p_infty)) as [Hp|Hp]. exists p_infty ; split. by case. intros b Hb. apply Rbar_not_lt_le. contradict Hp => H. apply: Rbar_le_not_lt Hp. by apply Hb. destruct (ex_lub_Rbar E) as [l Hl]. exists l ; split. case => [x | | ] // Hx. by apply Hl. intros b Hb. apply Hl => x Hx. by apply Hb. Qed. Lemma Rbar_ex_glb (E : Rbar -> Prop) : {l : Rbar | Rbar_is_glb E l}. Proof. destruct (Rbar_ex_lub (fun x => E (Rbar_opp x))) as [l Hl]. exists (Rbar_opp l). now apply Rbar_lub_glb ; rewrite Rbar_opp_involutive. Qed. (** Functions *) Definition Rbar_lub (E : Rbar -> Prop) := proj1_sig (Rbar_ex_lub E). Definition Rbar_glb (E : Rbar -> Prop) := proj1_sig (Rbar_ex_glb E). Lemma Rbar_opp_glb_lub (E : Rbar -> Prop) : Rbar_glb (fun x => E (Rbar_opp x)) = Rbar_opp (Rbar_lub E). Proof. unfold Rbar_glb ; case (Rbar_ex_glb _) ; simpl ; intros g [Hg Hg'] ; unfold Rbar_lub ; case (Rbar_ex_lub _) ; simpl ; intros l [Hl Hl'] ; apply Rbar_le_antisym. apply Rbar_opp_le ; rewrite Rbar_opp_involutive ; apply Hl', Rbar_lb_ub ; rewrite Rbar_opp_involutive ; auto. apply Hg', Rbar_lb_ub ; auto. Qed. Lemma Rbar_opp_lub_glb (E : Rbar -> Prop) : Rbar_lub (fun x => E (Rbar_opp x)) = Rbar_opp (Rbar_glb E). Proof. unfold Rbar_glb ; case (Rbar_ex_glb _) ; simpl ; intros g (Hg, Hg') ; unfold Rbar_lub ; case (Rbar_ex_lub _) ; simpl ; intros l [Hl Hl'] ; apply Rbar_le_antisym. apply Hl', Rbar_lb_ub ; rewrite Rbar_opp_involutive ; apply (Rbar_is_lb_subset _ E) ; auto ; intros x ; rewrite Rbar_opp_involutive ; auto. apply Rbar_opp_le ; rewrite Rbar_opp_involutive ; apply Hg', Rbar_ub_lb ; rewrite Rbar_opp_involutive ; auto. Qed. Lemma Rbar_is_lub_unique (E : Rbar -> Prop) (l : Rbar) : Rbar_is_lub E l -> Rbar_lub E = l. Proof. move => H. rewrite /Rbar_lub. case: Rbar_ex_lub => l0 H0 /=. apply Rbar_le_antisym. apply H0, H. apply H, H0. Qed. Lemma Rbar_is_glb_unique (E : Rbar -> Prop) (l : Rbar) : Rbar_is_glb E l -> Rbar_glb E = l. Proof. move => H. rewrite /Rbar_glb. case: Rbar_ex_glb => l0 H0 /=. apply Rbar_le_antisym. apply H, H0. apply H0, H. Qed. (** Order *) Lemma Rbar_glb_le_lub (E : Rbar -> Prop) : (exists x, E x) -> Rbar_le (Rbar_glb E) (Rbar_lub E). Proof. case => x Hex. apply Rbar_le_trans with x. unfold Rbar_glb ; case (Rbar_ex_glb _) ; simpl ; intros g (Hg, _) ; apply Hg ; auto. unfold Rbar_lub ; case (Rbar_ex_lub _) ; simpl ; intros l (Hl, _) ; apply Hl ; auto. Qed. Lemma Rbar_is_lub_subset (E1 E2 : Rbar -> Prop) (l1 l2 : Rbar) : (forall x, E1 x -> E2 x) -> (Rbar_is_lub E1 l1) -> (Rbar_is_lub E2 l2) -> Rbar_le l1 l2. Proof. intros Hs (_,H1) (H2, _). apply H1 ; intros x Hx ; apply H2, Hs, Hx. Qed. Lemma Rbar_is_glb_subset (E1 E2 : Rbar -> Prop) (l1 l2 : Rbar) : (forall x, E2 x -> E1 x) -> (Rbar_is_glb E1 l1) -> (Rbar_is_glb E2 l2) -> Rbar_le l1 l2. Proof. intros Hs (H1, _) (_, H2). apply H2 ; intros x Hx ; apply H1, Hs, Hx. Qed. Lemma Rbar_is_lub_eq (E1 E2 : Rbar -> Prop) (l1 l2 : Rbar) : (forall x, E1 x <-> E2 x) -> (Rbar_is_lub E1 l1) -> (Rbar_is_lub E2 l2) -> l1 = l2. Proof. intros Hs H1 H2 ; apply Rbar_le_antisym ; [apply (Rbar_is_lub_subset E1 E2) | apply (Rbar_is_lub_subset E2 E1) ] ; auto ; intros x H ; apply Hs ; auto. Qed. Lemma Rbar_is_glb_eq (E1 E2 : Rbar -> Prop) (l1 l2 : Rbar) : (forall x, E1 x <-> E2 x) -> (Rbar_is_glb E1 l1) -> (Rbar_is_glb E2 l2) -> l1 = l2. Proof. intros Hs H1 H2 ; apply Rbar_le_antisym ; [apply (Rbar_is_glb_subset E1 E2) | apply (Rbar_is_glb_subset E2 E1) ] ; auto ; intros x H ; apply Hs ; auto. Qed. Lemma Rbar_is_lub_ext (E1 E2 : Rbar -> Prop) (l : Rbar) : (forall x, E1 x <-> E2 x) -> (Rbar_is_lub E1 l) -> (Rbar_is_lub E2 l). Proof. intros Heq (H1,H2) ; split. apply (Rbar_is_ub_subset _ E1) ; auto ; intros x Hx ; apply Heq ; auto. intros b Hb ; apply H2 ; apply (Rbar_is_ub_subset _ E2) ; auto ; intros x Hx ; apply Heq ; auto. Qed. Lemma Rbar_is_glb_ext (E1 E2 : Rbar -> Prop) (l : Rbar) : (forall x, E1 x <-> E2 x) -> (Rbar_is_glb E1 l) -> (Rbar_is_glb E2 l). Proof. intros Heq (H1, H2) ; split. apply (Rbar_is_lb_subset _ E1) ; auto ; intros x Hx ; apply Heq ; auto. intros b Hb ; apply H2 ; apply (Rbar_is_lb_subset _ E2) ; auto ; intros x Hx ; apply Heq ; auto. Qed. Lemma Rbar_lub_subset (E1 E2 : Rbar -> Prop) : (forall x, E1 x -> E2 x) -> Rbar_le (Rbar_lub E1) (Rbar_lub E2). Proof. intros Hs ; unfold Rbar_lub ; case (Rbar_ex_lub E1) ; intros l1 Hl1 ; case (Rbar_ex_lub E2) ; simpl ; intros l2 Hl2 ; apply (Rbar_is_lub_subset E1 E2) ; auto. Qed. Lemma Rbar_glb_subset (E1 E2 : Rbar -> Prop) : (forall x, E2 x -> E1 x) -> Rbar_le (Rbar_glb E1) (Rbar_glb E2). Proof. intro Hs ; unfold Rbar_glb ; case (Rbar_ex_glb E1) ; intros l1 Hl1 ; case (Rbar_ex_glb E2) ; simpl ; intros l2 Hl2 ; apply (Rbar_is_glb_subset E1 E2) ; auto. Qed. Lemma Rbar_lub_rw (E1 E2 : Rbar -> Prop) : (forall x, E1 x <-> E2 x) -> Rbar_lub E1 = Rbar_lub E2. Proof. intro Hs ; apply Rbar_le_antisym ; apply Rbar_lub_subset ; intros x H ; apply Hs ; auto. Qed. Lemma Rbar_glb_rw (E1 E2 : Rbar -> Prop) : (forall x, E1 x <-> E2 x) -> Rbar_glb E1 = Rbar_glb E2. Proof. intros Hs ; apply Rbar_le_antisym ; apply Rbar_glb_subset ; intros x H ; apply Hs ; auto. Qed. (** * Emptiness is decidable *) Definition Empty (E : R -> Prop) := Lub_Rbar (fun x => x = 0 \/ E x) = Glb_Rbar (fun x => x = 0 \/ E x) /\ Lub_Rbar (fun x => x = 1 \/ E x) = Glb_Rbar (fun x => x = 1 \/ E x). Lemma Empty_correct_1 (E : R -> Prop) : Empty E -> forall x, ~ E x. Proof. case => E0 E1 x Ex. rewrite /Lub_Rbar /Glb_Rbar in E0 ; case : (ex_lub_Rbar (fun x : R => x = 0 \/ E x)) E0 => /= s0 Hs0 ; case : (ex_glb_Rbar (fun x : R => x = 0 \/ E x)) => i0 Hi0 /= E0. have : (x = 0) ; last move => {s0 Hs0 i0 Hi0 E0}. apply Rle_antisym. apply (Rbar_le_trans x s0 0). apply Hs0 ; by right. rewrite E0 ; apply Hi0 ; by left. apply (Rbar_le_trans 0 s0 x). apply Hs0 ; by left. rewrite E0 ; apply Hi0 ; by right. rewrite /Lub_Rbar /Glb_Rbar in E1 ; case : (ex_lub_Rbar (fun x : R => x = 1 \/ E x)) E1 => /= s1 Hs1 ; case : (ex_glb_Rbar (fun x : R => x = 1 \/ E x)) => i1 Hi1 /= E1. have : (x = 1) ; last move => {s1 Hs1 i1 Hi1 E1}. apply Rle_antisym. apply (Rbar_le_trans x s1 1). apply Hs1 ; by right. rewrite E1 ; apply Hi1 ; by left. apply (Rbar_le_trans 1 s1 x). apply Hs1 ; by left. rewrite E1 ; apply Hi1 ; by right. move => -> ; apply R1_neq_R0. Qed. Lemma Empty_correct_2 (E : R -> Prop) : (forall x, ~ E x) -> Empty E. Proof. move => H ; split ; rewrite /Glb_Rbar /Lub_Rbar ; [ case : (ex_lub_Rbar (fun x : R => x = 0 \/ E x)) => s0 Hs0 ; case : (ex_glb_Rbar (fun x : R => x = 0 \/ E x)) => i0 Hi0 /= | case : (ex_lub_Rbar (fun x : R => x = 1 \/ E x)) => s1 Hs1 ; case : (ex_glb_Rbar (fun x : R => x = 1 \/ E x)) => i1 Hi1 /=]. have : (i0 = Finite 0) ; last move => -> ; apply: Rbar_le_antisym. apply Hi0 ; by left. apply Hi0 => y ; case => H0. rewrite H0 ; by right. contradict H0 ; apply H. apply Hs0 => y ; case => H0. rewrite H0 ; by right. contradict H0 ; apply H. apply Hs0 ; by left. have : (i1 = Finite 1) ; last move => -> ; apply: Rbar_le_antisym. apply Hi1 ; by left. apply Hi1 => y ; case => H1. rewrite H1 ; by right. contradict H1 ; apply H. apply Hs1 => y ; case => H1. rewrite H1 ; by right. contradict H1 ; apply H. apply Hs1 ; by left. Qed. Lemma Empty_dec (E : R -> Prop) : {~Empty E}+{Empty E}. Proof. case: (Rbar_eq_dec (Lub_Rbar (fun x => x = 0 \/ E x)) (Glb_Rbar (fun x => x = 0 \/ E x))) => H0 ; [ | left]. case: (Rbar_eq_dec (Lub_Rbar (fun x => x = 1 \/ E x)) (Glb_Rbar (fun x => x = 1 \/ E x))) => H1 ; [by right | left]. contradict H1 ; apply H1. contradict H0 ; apply H0. Qed. Lemma not_Empty_dec (E : R -> Prop) : (Decidable.decidable (exists x, E x)) -> {(exists x, E x)} + {(forall x, ~ E x)}. Proof. move => He ; case: (Empty_dec E) => Hx ; [left|right]. case: He => // He. contradict Hx ; apply: Empty_correct_2 => x ; contradict He ; by exists x. by apply: Empty_correct_1. Qed. Lemma uniqueness_dec P : (exists ! x : R, P x) -> {x : R | P x}. Proof. move => H. exists (Lub_Rbar P). case: H => x Hx. replace (real (Lub_Rbar P)) with (real (Finite x)). by apply Hx. apply f_equal, sym_eq, is_lub_Rbar_unique. split. move => y Hy. right ; by apply sym_eq, Hx. move => b Hb. by apply Hb, Hx. Qed. coquelicot-coquelicot-3.4.1/theories/Markov.v000066400000000000000000000144421455143432500213160ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import RIneq Lia. Require Import Rcomplements. (** This file proves the Limited Principle of Omniscience: given a decidable property P on [nat], either P never holds or we can construct a witness for which P holds. Several variants are given. *) Open Scope R_scope. (** * Limited Principle of Omniscience *) Theorem LPO_min : forall P : nat -> Prop, (forall n, P n \/ ~ P n) -> {n : nat | P n /\ forall i, (i < n)%nat -> ~ P i} + {forall n, ~ P n}. Proof. assert (Hi: forall n, 0 < INR n + 1). intros N. rewrite <- S_INR. apply lt_0_INR. apply Nat.lt_0_succ. intros P HP. set (E y := exists n, (P n /\ y = / (INR n + 1)) \/ (~ P n /\ y = 0)). assert (HE: forall n, P n -> E (/ (INR n + 1))). intros n Pn. exists n. left. now split. assert (BE: is_upper_bound E 1). intros x [y [[_ ->]|[_ ->]]]. rewrite <- Rinv_1 at 2. apply Rinv_le_contravar. exact Rlt_0_1. rewrite <- S_INR. apply (le_INR 1), le_n_S, Nat.le_0_l. exact Rle_0_1. destruct (completeness E) as [l [ub lub]]. now exists 1. destruct (HP O) as [H0|H0]. exists 1. exists O. left. apply (conj H0). rewrite Rplus_0_l. apply sym_eq, Rinv_1. exists 0. exists O. right. now split. destruct (Rle_lt_dec l 0) as [Hl|Hl]. right. intros n Pn. apply Rle_not_lt with (1 := Hl). apply Rlt_le_trans with (/ (INR n + 1)). now apply Rinv_0_lt_compat. apply ub. now apply HE. left. set (N := Z.abs_nat (up (/l) - 2)). exists N. assert (HN: INR N + 1 = IZR (up (/ l)) - 1). unfold N. rewrite INR_IZR_INZ. rewrite inj_Zabs_nat. replace (IZR (up (/ l)) - 1) with (IZR (up (/ l) - 2) + 1). apply (f_equal (fun v => IZR v + 1)). apply Z.abs_eq. apply Zle_minus_le_0. apply (Zlt_le_succ 1). apply lt_IZR. apply Rle_lt_trans with (/l). apply Rmult_le_reg_r with (1 := Hl). rewrite Rmult_1_l, Rinv_l by now apply Rgt_not_eq. apply lub. exact BE. apply archimed. rewrite minus_IZR. simpl. ring. assert (H: forall i, (i < N)%nat -> ~ P i). intros i HiN Pi. unfold is_upper_bound in ub. refine (Rle_not_lt _ _ (ub (/ (INR i + 1)) _) _). now apply HE. rewrite <- (Rinv_involutive l) by now apply Rgt_not_eq. apply Rinv_1_lt_contravar. rewrite <- S_INR. apply (le_INR 1). apply le_n_S. apply Nat.le_0_l. apply Rlt_le_trans with (INR N + 1). apply Rplus_lt_compat_r. now apply lt_INR. rewrite HN. apply Rplus_le_reg_r with (-/l + 1). ring_simplify. apply archimed. destruct (HP N) as [PN|PN]. now split. exfalso. refine (Rle_not_lt _ _ (lub (/ (INR (S N) + 1)) _) _). intros x [y [[Py ->]|[_ ->]]]. destruct (eq_nat_dec y N) as [HyN|HyN]. elim PN. now rewrite <- HyN. apply Rinv_le_contravar. apply Hi. apply Rplus_le_compat_r. apply Rnot_lt_le. intros Hy. refine (H _ _ Py). apply INR_lt in Hy. clear -Hy HyN. lia. now apply Rlt_le, Rinv_0_lt_compat. rewrite S_INR, HN. ring_simplify (IZR (up (/ l)) - 1 + 1). rewrite <- (Rinv_involutive l) at 2 by now apply Rgt_not_eq. apply Rinv_1_lt_contravar. rewrite <- Rinv_1. apply Rinv_le_contravar. exact Hl. now apply lub. apply archimed. Qed. Theorem LPO : forall P : nat -> Prop, (forall n, P n \/ ~ P n) -> {n : nat | P n} + {forall n, ~ P n}. Proof. intros P HP. destruct (LPO_min P HP) as [[n [Pn _]]|Pn]. left. now exists n. now right. Qed. Lemma LPO_bool : forall f : nat -> bool, {n | f n = true} + {forall n, f n = false}. Proof. intros f. destruct (LPO (fun n => f n = true)) as [H|H]. simpl. intros n. case (f n). now left. now right. now left. right. intros n. now apply Bool.not_true_is_false. Qed. (** ** Corollaries *) Lemma LPO_notforall : forall P : nat -> Prop, (forall n, P n \/ ~P n) -> (~ forall n : nat, ~ P n) -> exists n : nat, P n. Proof. intros. destruct (LPO P H). destruct s as (n,H1) ; exists n ; apply H1. contradict H0 ; apply n. Qed. Lemma LPO_notnotexists : forall P : nat -> Prop, (forall n, P n \/ ~P n) -> ~~ (exists n : nat, P n) -> exists n : nat, P n. Proof. intros. apply LPO_notforall. apply H. contradict H0. intros (n,H1). contradict H1 ; apply H0. Qed. Lemma LPO_ub_dec : forall (u : nat -> R), {M : R | forall n, u n <= M} + {forall M : R, exists n, M < u n}. Proof. intros u. destruct (LPO (fun M => forall n, u n <= (INR M))) as [ [M MHM] | HM ]. intros M. destruct (LPO (fun n => INR M < u n)) as [[n Hn] | Hn]. intros n. destruct (Rlt_dec (INR M) (u n)) as [H|H]. now left. now right. right ; contradict Hn. now apply Rle_not_lt. left ; intro n. now apply Rnot_lt_le. left ; now exists (INR M). right ; intros M. destruct (nfloor_ex (Rbasic_fun.Rmax 0 M)) as [m Hm]. now apply Rbasic_fun.Rmax_l. specialize (HM (S m)). apply LPO_notforall. intros n. destruct (Rlt_dec M (u n)) as [H|H]. now left. now right. contradict HM ; intros n. rewrite S_INR. eapply Rle_trans, Rlt_le, Hm. eapply Rle_trans, Rbasic_fun.Rmax_r. now apply Rnot_lt_le. Qed. (** * Excluded-middle and decidability *) Lemma EM_dec : forall P : Prop, {not (not P)} + {not P}. Proof. intros P. set (E := fun x => x = 0 \/ (x = 1 /\ P)). destruct (completeness E) as [x H]. - exists 1. intros x [->|[-> _]]. apply Rle_0_1. apply Rle_refl. - exists 0. now left. destruct (Rle_lt_dec 1 x) as [H'|H']. - left. intros HP. elim Rle_not_lt with (1 := H'). apply Rle_lt_trans with (2 := Rlt_0_1). apply H. intros y [->|[_ Hy]]. apply Rle_refl. now elim HP. - right. intros HP. apply Rlt_not_le with (1 := H'). apply H. right. now split. Qed. Lemma EM_dec' : forall P : Prop, P \/ not P -> {P} + {not P}. Proof. intros P HP. destruct (EM_dec P) as [H|H]. - left. now destruct HP. - now right. Qed. coquelicot-coquelicot-3.4.1/theories/PSeries.v000066400000000000000000002366421455143432500214410ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Rbar Lim_seq Lub Hierarchy Continuity Derive Seq_fct Series. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). (** This file describes power series: #Σ ak xk#. It contains definition, equivalence with the standard library, differentiability, integrability, and many results about the convergence circle. *) Section Definitions. (** * Definition *) Context {K : AbsRing} {V : NormedModule K}. Definition is_pseries (a : nat -> V) (x:K) (l : V) := is_series (fun k => scal (pow_n x k) (a k)) l. Definition ex_pseries (a : nat -> V) (x : K) := ex_series (fun k => scal (pow_n x k) (a k)). End Definitions. Definition PSeries (a : nat -> R) (x : R) : R := Series (fun k => a k * x ^ k). Lemma ex_pseries_dec {V : NormedModule R_AbsRing} (a : nat -> R) (x : R) : {ex_pseries a x} + {~ ex_pseries a x}. Proof. apply ex_series_dec. Qed. Lemma is_pseries_R (a : nat -> R) (x l : R) : is_pseries a x l <-> is_series (fun n : nat => a n * x ^ n) l. Proof. split ; apply is_series_ext ; intros n ; rewrite pow_n_pow /= ; apply Rmult_comm. Qed. Lemma ex_pseries_R (a : nat -> R) (x : R) : ex_pseries a x <-> ex_series (fun n : nat => a n * x ^ n). Proof. split ; apply ex_series_ext ; intros n ; rewrite pow_n_pow /= ; apply Rmult_comm. Qed. Lemma PSeries_eq (a : nat -> R) (x : R) : PSeries a x = Series (fun k => scal (pow_n x k) (a k)). Proof. apply Series_ext. intros n. apply Rmult_comm. Qed. Lemma PSeries_1 (a : nat -> R) : PSeries a 1 = Series a. Proof. apply Series_ext => n. by rewrite pow1 Rmult_1_r. Qed. Lemma ex_pseries_1 (a : nat -> R) : ex_pseries a 1 <-> ex_series a. Proof. assert (forall n : nat, scal (pow_n 1 n) (a n) = a n). now intros n ; rewrite pow_n_pow pow1 scal_one. split ; apply ex_series_ext => n ; by rewrite H. Qed. Lemma is_pseries_unique (a : nat -> R) (x l : R) : is_pseries a x l -> PSeries a x = l. Proof. move => Ha; rewrite PSeries_eq. by apply is_series_unique. Qed. Lemma PSeries_correct (a : nat -> R) (x : R) : ex_pseries a x -> is_pseries a x (PSeries a x). Proof. move => Ha; rewrite PSeries_eq. apply Series_correct. by apply Ha. Qed. (** Equivalence with standard library Reals *) Lemma is_pseries_Reals (a : nat -> R) (x l : R) : is_pseries a x l <-> Pser a x l. Proof. split => H. move => e He ; set eps := mkposreal e He. apply (is_lim_seq_spec _ l) in H. case: (H eps) => {H} N H. exists N => n Hn. rewrite <- sum_n_Reals. rewrite (sum_n_ext _ (fun n0 : nat => scal (pow_n x n0) (a n0))). by apply H. intros k; rewrite pow_n_pow /=; apply Rmult_comm. apply (is_lim_seq_spec _ l). move => eps. case: (H eps (cond_pos eps)) => {H} N H. exists N => n Hn. rewrite (sum_n_ext _ (fun n0 : nat => a n0 * x ^ n0)). rewrite sum_n_Reals. by apply H. intros; now rewrite Rmult_comm pow_n_pow. Qed. (** Extensionality *) Section Extensionality. Context {K : AbsRing} {V : NormedModule K}. Lemma is_pseries_ext (a b : nat -> V) (x : K) (l:V) : (forall n, a n = b n) -> (is_pseries a x l) -> is_pseries b x l. Proof. move => Heq Ha. apply is_series_ext with (2 := Ha). move => n. by rewrite Heq. Qed. Lemma ex_pseries_ext (a b : nat -> V) (x : K) : (forall n, a n = b n) -> ex_pseries a x -> ex_pseries b x. Proof. move => Heq [l Ha]. exists l ; by apply is_pseries_ext with a. Qed. End Extensionality. Lemma PSeries_ext (a b : nat -> R) (x : R) : (forall n, a n = b n) -> PSeries a x = PSeries b x. Proof. move => Heq. apply Series_ext. move => n ; by rewrite Heq. Qed. (** * Convergence circle *) (** A power series is always defined at 0 *) Section ConvergenceCircle. Context {K : AbsRing} {V : NormedModule K}. Lemma is_pseries_0 (a : nat -> V) : is_pseries a zero (a O). Proof. apply filterlim_ext with (fun _ => a O). elim => [ | n IH] /=. now rewrite sum_O scal_one. rewrite sum_Sn -IH /=. rewrite mult_zero_l. now rewrite scal_zero_l plus_zero_r. apply filterlim_const. Qed. Lemma ex_pseries_0 (a : nat -> V) : ex_pseries a zero. Proof. exists (a O) ; by apply is_pseries_0. Qed. End ConvergenceCircle. Lemma PSeries_0 (a : nat -> R) : PSeries a 0 = a O. Proof. rewrite PSeries_eq. apply is_series_unique. apply @is_pseries_0. Qed. (** Convergence disk *) Definition CV_disk (a : nat -> R) (r : R) := ex_series (fun n => Rabs (a n * r^n)). Lemma CV_disk_le (a : nat -> R) (r1 r2 : R) : Rabs r1 <= Rabs r2 -> CV_disk a r2 -> CV_disk a r1. Proof. move => H. apply @ex_series_le => n. rewrite /norm /= /abs /= Rabs_Rabsolu. rewrite ?Rabs_mult ; apply Rmult_le_compat_l. by apply Rabs_pos. rewrite -?RPow_abs ; apply pow_incr ; split. by apply Rabs_pos. by apply H. Qed. Lemma CV_disk_correct (a : nat -> R) (x : R) : CV_disk a x -> ex_pseries a x. Proof. intros H; apply ex_series_Rabs. apply ex_series_ext with (2:=H). intros n; apply f_equal. now rewrite Rmult_comm pow_n_pow. Qed. Lemma CV_disk_0 (a : nat -> R) : CV_disk a 0. Proof. exists (Rabs (a O)). apply (is_lim_seq_ext (fun _ => Rabs (a O)) _ (Rabs (a O))). elim => /= [ | n IH]. by rewrite sum_O Rmult_1_r. by rewrite sum_Sn /= Rmult_0_l Rmult_0_r Rabs_R0 /plus /= Rplus_0_r. by apply is_lim_seq_const. Qed. Definition CV_radius (a : nat -> R) : Rbar := Lub_Rbar (CV_disk a). Lemma CV_radius_ge_0 (a : nat -> R) : Rbar_le (Finite 0) (CV_radius a). Proof. rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar => /= l Hl. apply Hl, CV_disk_0. Qed. Lemma CV_radius_bounded (a : nat -> R) : is_lub_Rbar (fun r => exists M, forall n, Rabs (a n * r ^ n) <= M) (CV_radius a). Proof. rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar => cv /= [ub lub]. split. move => r /= [M Hr]. have : forall y, Rabs y < Rabs r -> (CV_disk a) y. move => y Hy ; rewrite /CV_disk /=. set l := (Rabs (y / r)). assert (ex_series (fun n => M * l ^ n)). apply ex_series_ext with (fun n : nat => scal M (l ^ n)). by elim. apply: ex_series_scal_l. apply ex_series_geom. rewrite /l Rabs_Rabsolu Rabs_div. apply Rlt_div_l. apply Rle_lt_trans with (2 := Hy), Rabs_pos. by rewrite Rmult_1_l. have H : (Rabs r <> 0). apply Rgt_not_eq, Rle_lt_trans with (2 := Hy), Rabs_pos. contradict H. by rewrite H Rabs_R0. apply @ex_series_le with (2:=H) => n. rewrite /norm /= /abs /= Rabs_Rabsolu. replace (Rabs (a n * y ^ n)) with (Rabs (a n * r ^ n) * l^n). apply Rmult_le_compat_r. apply pow_le ; by apply Rabs_pos. by apply Hr. rewrite ?Rabs_mult Rmult_assoc ; apply Rmult_eq_compat_l. rewrite /l RPow_abs -Rabs_mult. apply f_equal. elim: n => /= [ | n IH]. ring. rewrite -IH ; field. have Hr0 : Rabs r <> 0. apply Rgt_not_eq, Rle_lt_trans with (2 := Hy), Rabs_pos. contradict Hr0 ; by rewrite Hr0 Rabs_R0. move => H. have : forall y, Rabs y < Rabs r -> Rbar_le (Finite (y)) cv. move => y Hy. apply ub. by apply (H y Hy). have Hc0 : Rbar_le (Finite 0) cv. apply ub, CV_disk_0. case: (cv) Hc0 => [c | | ] // Hc0 Hcv. case: (Rle_lt_dec r 0) => Hr0. by apply Rle_trans with (1 := Hr0). have H0 : forall e, 0 < e <= r -> r - e <= c. intros. apply Hcv. apply Rlt_le_trans with (2 := Rle_abs _). rewrite Rabs_pos_eq ; lra. apply Rnot_lt_le => H1. have H2: (c < ((c+r)/2) < r). lra. have H3 : 0 < ((r-c)/2) <= r. unfold Rbar_le in Hc0 ; lra. move: (H0 _ H3). lra. (* lub *) move => b Hb. apply lub => x Hx. apply Hb. apply ex_series_lim_0 in Hx. apply is_lim_seq_spec in Hx. case: (Hx (mkposreal _ Rlt_0_1)) => /= {Hx} N Hx. set M := fix f N := match N with | O => Rabs (a O * x ^ O) | S n => Rmax (f n) (Rabs (a (n) * x ^ (n))) end. exists (Rmax (M N) 1) => n. case: (le_lt_dec N n) => Hn. apply Rle_trans with (2 := Rmax_r _ _). move: (Hx n Hn). rewrite Rminus_0_r Rabs_Rabsolu. by apply Rlt_le. apply Rle_trans with (2 := Rmax_l _ _). elim: N n Hn {Hx} => [ | N IH] /= n Hn. by apply Nat.nlt_0_r in Hn. apply ->Nat.lt_succ_r in Hn. destruct (proj1 (Nat.le_lteq _ _) Hn) as [Hn' | ->]. - now apply Rle_trans with (2 := Rmax_l _ _), IH. - now apply Rle_trans with (2 := Rmax_r _ _), Rle_refl. Qed. (** Convergence theorems *) Lemma CV_disk_inside (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> ex_series (fun n => Rabs (a n * x ^ n)). Proof. move => Ha. assert (H : ~ ~ ex_series (fun n => Rabs (a n * x ^ n))). contradict Ha. apply Rbar_le_not_lt. rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar => l /= [ub lub]. apply: lub => r Hr. apply Rnot_lt_le ; contradict Ha. move: Hr. apply CV_disk_le. by apply Rlt_le, Rlt_le_trans with (2 := Rle_abs _). by case: (ex_series_dec (fun n => Rabs (a n * x ^ n))). Qed. Lemma CV_radius_inside (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> ex_pseries a x. Proof. move => Ha. by apply CV_disk_correct, CV_disk_inside. Qed. Lemma CV_disk_outside (a : nat -> R) (x : R) : Rbar_lt (CV_radius a) (Finite (Rabs x)) -> ~ is_lim_seq (fun n => a n * x ^ n) 0. Proof. case: (CV_radius_bounded a) => ub lub. move => Hx. have H : ~ (fun r : R => exists M : R, forall n : nat, Rabs (a n * r ^ n) <= M) x. contradict Hx ; apply Rbar_le_not_lt. apply ub. case: Hx => M Hx. exists M => n. by rewrite Rabs_mult RPow_abs Rabs_Rabsolu -Rabs_mult. contradict H. apply is_lim_seq_spec in H. case: (H (mkposreal _ Rlt_0_1)) => /= {Hx} N Hx. set M := fix f N := match N with | O => Rabs (a O * x ^ O) | S n => Rmax (f n) (Rabs (a (n) * x ^ (n))) end. exists (Rmax (M N) 1) => n. case: (le_lt_dec N n) => Hn. apply Rle_trans with (2 := Rmax_r _ _). move: (Hx n Hn). rewrite Rminus_0_r. by apply Rlt_le. apply Rle_trans with (2 := Rmax_l _ _). elim: N n Hn {Hx} => [ | N IH] /= n Hn. by apply Nat.nlt_0_r in Hn. apply ->Nat.lt_succ_r in Hn. destruct (proj1 (Nat.le_lteq _ _) Hn) as [Hn' | ->]. - now apply Rle_trans with (2 := Rmax_l _ _), IH. - now apply Rle_trans with (2 := Rmax_r _ _), Rle_refl. Qed. Lemma CV_radius_ext (a b : nat -> R) : (forall n, a n = b n) -> CV_radius a = CV_radius b. Proof. move => Heq. rewrite /CV_radius /Lub_Rbar. case: ex_lub_Rbar => la [ub_a lub_a] ; case: ex_lub_Rbar => lb [ub_b lub_b] /=. apply Rbar_le_antisym. apply lub_a => x Hx. apply ub_b ; move: Hx. apply ex_series_ext => n ; by rewrite Heq. apply lub_b => x Hx. apply ub_a ; move: Hx. apply ex_series_ext => n ; by rewrite Heq. Qed. (** ** Convergence criteria *) (** D'Alembert criterion for power series *) Lemma CV_disk_DAlembert_aux (a : nat -> R) (x k : R) : x <> 0 -> (forall n, a n <> 0) -> (is_lim_seq (fun n => Rabs (a (S n) / a n)) k <-> is_lim_seq (fun n => Rabs ((a (S n) * x^(S n)) / (a n * x ^ n))) (Rabs x * k)). Proof. move => Hx Ha ; split => H. evar (l : Rbar). replace (Finite (Rabs x * k)) with l. apply is_lim_seq_ext with (fun n => Rabs x * Rabs (a (S n) / a n)). move => n ; rewrite ?Rabs_div => //=. rewrite ?Rabs_mult. field. split ; apply Rabs_no_R0 => //. by apply pow_nonzero. apply Rmult_integral_contrapositive_currified => //. by apply pow_nonzero. apply is_lim_seq_scal_l. apply H. by simpl. evar (l : Rbar). replace (Finite k) with l. apply is_lim_seq_ext with (fun n : nat => /Rabs x * Rabs (a (S n) * x ^ S n / (a n * x ^ n))). move => n ; rewrite /= ?Rabs_div ?Rabs_mult. field. repeat split ; apply Rabs_no_R0 => //. by apply pow_nonzero. by apply Ha. apply Rmult_integral_contrapositive_currified => //. by apply pow_nonzero. apply is_lim_seq_scal_l. apply H. apply Rbar_finite_eq ; field. apply Rabs_no_R0 => //. Qed. Lemma CV_disk_DAlembert (a : nat -> R) (x:R) l : (forall n:nat, a n <> 0) -> is_lim_seq (fun n:nat => Rabs (a (S n) / a n)) (Finite l) -> (l = 0 \/ (l <> 0 /\ Rabs x < / l)) -> CV_disk a x. Proof. move => Ha Hl H. case: (Req_dec x 0) => Hx. rewrite Hx. exists (Rabs (a O)). apply (is_lim_seq_ext (fun _ => Rabs (a O)) _ (Rabs (a 0%nat))). elim => /= [ | n IH]. by rewrite sum_O Rmult_1_r. by rewrite sum_Sn /= Rmult_0_l Rmult_0_r Rabs_R0 /plus /= Rplus_0_r. apply is_lim_seq_const. apply ex_series_DAlembert with (Rabs x * l). case: H => H. rewrite H Rmult_0_r ; by apply Rlt_0_1. replace 1 with (/ l * l) by (field ; apply H). apply Rmult_lt_compat_r. apply Rnot_le_lt ; case => H0. case: H => H. apply Rle_not_lt. apply Rlt_le, Rlt_le_trans with 0. by apply Rinv_lt_0_compat. by apply Rabs_pos. by case: H. by apply H. move => n ; apply Rmult_integral_contrapositive_currified. by apply Ha. by apply pow_nonzero. by apply CV_disk_DAlembert_aux. Qed. Lemma CV_radius_finite_DAlembert (a : nat -> R) (l : R) : (forall n:nat, a n <> 0) -> 0 < l -> is_lim_seq (fun n:nat => Rabs (a (S n) / a n)) l -> CV_radius a = Finite (/l). Proof. move => Ha Hl Hda. apply Rbar_le_antisym. rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar => /= cv [ub lub]. apply lub => x Hax. case: (Rle_lt_dec x 0) => Hx. apply Rlt_le, Rle_lt_trans with 0. by apply Hx. by apply Rinv_0_lt_compat. rewrite -(Rabs_pos_eq x (Rlt_le _ _ Hx)). rewrite -(Rmult_1_l (/l)). replace (Rabs x) with ((Rabs x * l) /l) by (field ; apply Rgt_not_eq, Hl). apply Rmult_le_compat_r. by apply Rlt_le, Rinv_0_lt_compat. apply Rnot_lt_le. contradict Hax. have : CV_disk a x -> is_lim_seq (fun n => a n * x ^ n) 0. move => H. apply ex_series_lim_0. by apply ex_series_Rabs. move => H H0. move: (H H0) => {H H0}. apply not_ex_series_DAlembert with (Rabs x * l) => //. move => n. apply Rmult_integral_contrapositive_currified => //. by apply pow_nonzero, Rgt_not_eq. apply CV_disk_DAlembert_aux. by apply Rgt_not_eq. by apply Ha. by apply Hda. apply Rbar_not_lt_le. move : (CV_disk_outside a). rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar ; case => [cv | | ] /= [ub lub] Hnot_ex H ; try by auto. suff H0 : cv < ((cv+/l)/2) < /l. absurd (ex_series (fun n => Rabs (a n * ((cv+/l)/2)^n))). suff H1 : cv < Rabs ((cv + / l) / 2). move: (Hnot_ex ((cv + / l) / 2) H1) => {} Hnot_ex. contradict Hnot_ex ; by apply ex_series_lim_0, ex_series_Rabs. apply Rlt_le_trans with (2 := Rle_abs _), H0. apply (CV_disk_DAlembert) with l. by apply Ha. by apply Hda. right ; split. by apply Rgt_not_eq. rewrite Rabs_pos_eq. by apply H0. apply Rlt_le, Rle_lt_trans with (2 := proj1 H0). apply ub. exists (Rabs (a O)). apply (is_lim_seq_ext (fun _ => Rabs (a O)) _ (Rabs (a 0%nat))). elim => [ | n IH] /=. by rewrite sum_O Rmult_1_r. by rewrite sum_Sn /= Rmult_0_l Rmult_0_r Rabs_R0 /plus /= Rplus_0_r. by apply is_lim_seq_const. lra. case: (ub 0) => //. exists (Rabs (a O)). apply (is_lim_seq_ext (fun _ => Rabs (a O)) _ (Rabs (a 0%nat))). elim => [ | n IH] /=. by rewrite sum_O Rmult_1_r. by rewrite sum_Sn /= Rmult_0_l Rmult_0_r Rabs_R0 /plus /= Rplus_0_r. by apply is_lim_seq_const. Qed. Lemma CV_radius_infinite_DAlembert (a : nat -> R) : (forall n:nat, a n <> 0) -> is_lim_seq (fun n:nat => Rabs (a (S n) / a n)) 0 -> CV_radius a = p_infty. Proof. move => Ha Hda. rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar ; case => [cv | | ] //= [ub lub] ; have : False => //. have H : CV_disk a (cv + 1). have H : 0 < cv + 1. apply Rlt_le_trans with (0+1). rewrite Rplus_0_l ; by apply Rlt_0_1. apply Rplus_le_compat_r. apply ub. exists (Rabs (a O)). apply (is_lim_seq_ext (fun _ => Rabs (a O)) _ (Rabs (a 0%nat))). elim => [ | k IH] /=. by rewrite sum_O Rmult_1_r. by rewrite sum_Sn /= Rmult_0_l Rmult_0_r Rabs_R0 /plus /= Rplus_0_r. by apply is_lim_seq_const. apply ex_series_DAlembert with 0. by apply Rlt_0_1. move => n ; apply Rmult_integral_contrapositive_currified. by[]. by apply Rgt_not_eq, pow_lt. rewrite -(Rmult_0_r (Rabs (cv + 1))). apply (CV_disk_DAlembert_aux a (cv + 1)). by apply Rgt_not_eq. by []. by []. move: (ub (cv+1) H). by apply Rbar_lt_not_le, Rlt_n_Sn. case: (ub 0) => //. exists (Rabs (a O)). apply (is_lim_seq_ext (fun _ => Rabs (a O)) _ (Rabs (a 0%nat))). elim => [ | k IH] /=. by rewrite sum_O Rmult_1_r. by rewrite sum_Sn /= Rmult_0_l Rmult_0_r Rabs_R0 /plus /= Rplus_0_r. by apply is_lim_seq_const. Qed. (** Equivalence with standard library Reals *) Lemma CV_radius_Reals_0 (a : nat -> R) (r : posreal) : Rbar_lt (Finite r) (CV_radius a) -> CVN_r (fun n x => a n * x ^ n) r. Proof. move => Hr. rewrite /CVN_r /Boule. have H := CV_radius_bounded a. exists (fun n => Rabs (a n * r ^ n)). exists (Series (fun n => Rabs (a n * r ^ n))) ; split. rewrite -(Rabs_pos_eq r (Rlt_le _ _ (cond_pos r))) in Hr. apply CV_disk_inside in Hr. apply Lim_seq_correct' in Hr ; rewrite -/(Series (fun n : nat => Rabs (a n * r ^ n))) in Hr. move => e He. apply is_lim_seq_spec in Hr. case: (Hr (mkposreal e He)) => /= {Hr} N Hr. exists N => n Hn. replace (sum_f_R0 (fun k : nat => Rabs (Rabs (a k * r ^ k))) n) with (sum_f_R0 (fun k : nat => (Rabs (a k * r ^ k))) n). rewrite <- sum_n_Reals; by apply Hr. elim: n {Hn} => /= [ | n IH] ; rewrite Rabs_Rabsolu. by []. by rewrite IH. move => n x Hx. rewrite ?Rabs_mult -?RPow_abs. apply Rmult_le_compat_l. by apply Rabs_pos. apply pow_incr ; split. by apply Rabs_pos. rewrite (Rabs_pos_eq r). rewrite Rminus_0_r in Hx. by apply Rlt_le. by apply Rlt_le, r. Qed. Lemma CV_radius_Reals_1 (a : nat -> R) (r : posreal) : CVN_r (fun n x => a n * x ^ n) r -> Rbar_le (Finite r) (CV_radius a). Proof. case => An [l [H H0]]. have H1 : is_lub_Rbar (CV_disk a) (CV_radius a). rewrite /CV_radius /Lub_Rbar ; by case: ex_lub_Rbar. have H2 : forall (y : R), 0 < y < r -> (CV_disk a y). move => y Hy. apply @ex_series_le with An. move => n ; rewrite /norm /= /abs /= Rabs_Rabsolu. apply H0 ; rewrite /Boule Rabs_pos_eq Rminus_0_r. by apply Hy. by apply Rlt_le, Hy. exists l. apply (is_lim_seq_spec _ l). intros eps. case: (H eps (cond_pos eps)) => N {} H. exists N => n Hn. set v := sum_n _ _. replace v with (sum_n (fun k : nat => Rabs (An k)) n). rewrite sum_n_Reals; by apply H. rewrite /v {v}. elim: n {Hn} => /= [ | n IH]. rewrite !sum_O ; apply Rabs_pos_eq. apply Rle_trans with (Rabs (a O * 0 ^ O)). by apply Rabs_pos. apply H0 ; rewrite /Boule Rminus_0_r Rabs_R0 ; by apply r. rewrite !sum_Sn IH Rabs_pos_eq. by []. apply Rle_trans with (Rabs (a (S n) * 0 ^ (S n))). by apply Rabs_pos. apply H0 ; rewrite /Boule Rminus_0_r Rabs_R0 ; by apply r. have H3 : forall y, 0 < y < r -> Rbar_le (Finite (y)) (CV_radius a). move => y Hy. by apply H1, H2. have H4 := CV_radius_ge_0 a. case: (CV_radius a) H3 H4 => /= [cv | | ] // H3 H4. apply Rnot_lt_le => /= H5. have H6 : 0 < (cv+r)/2 < r. lra. move: (H3 _ H6). lra. Qed. Lemma CV_radius_Reals_2 (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> exists r : posreal, CVU (fun n x => sum_f_R0 (fun k => a k * x ^ k) n) (PSeries a) x r. Proof. move => Hx. have H : exists r : posreal, Rabs x < r /\ Rbar_lt (Finite r) (CV_radius a). case: (CV_radius a) Hx => /= [cv | | ] Hx. have H : 0 < (Rabs x + cv)/2. generalize (Rabs_pos x) ; lra. exists (mkposreal _ H) => /=. lra. have H : 0 < Rabs x + 1. apply Rle_lt_0_plus_1, Rabs_pos. exists (mkposreal _ H) => /=. split. by apply Rlt_plus_1. by []. by []. case: H => r H. apply CVN_CVU_r with r. by apply CV_radius_Reals_0, H. by apply H. Qed. (** * Operations *) (** Addition of two power series *) Section PS_plus. Context {K : AbsRing} {V : NormedModule K}. Definition PS_plus (a b : nat -> V) (n : nat) : V := plus (a n) (b n). Lemma is_pseries_plus (a b : nat -> V) (x :K) (la lb : V) : is_pseries a x la -> is_pseries b x lb -> is_pseries (PS_plus a b) x (plus la lb). Proof. move => Ha Hb. apply filterlim_ext with (f:= (fun n => plus (sum_n (fun k => scal (pow_n x k) (a k)) n) (sum_n (fun k => scal (pow_n x k) (b k)) n))). elim => [ | n IH]. simpl ; rewrite /PS_plus !sum_O. now repeat rewrite scal_one. simpl ; rewrite !sum_Sn -IH /PS_plus. generalize (sum_n (fun k : nat => scal (pow_n x k) (a k)) n) => a' ; generalize (sum_n (fun k : nat => scal (pow_n x k) (b k)) n) => b'. repeat rewrite -plus_assoc; apply f_equal. rewrite plus_comm -plus_assoc; apply f_equal. rewrite scal_distr_l; apply plus_comm. now apply filterlim_comp_2 with (3 := filterlim_plus _ _). Qed. Lemma ex_pseries_plus (a b : nat -> V) (x : K) : ex_pseries a x -> ex_pseries b x -> ex_pseries (PS_plus a b) x. Proof. move => [la Ha] [lb Hb]. exists (plus la lb). by apply is_pseries_plus. Qed. End PS_plus. Lemma PSeries_plus (a b : nat -> R) (x : R) : ex_pseries a x -> ex_pseries b x -> PSeries (PS_plus a b) x = PSeries a x + PSeries b x. Proof. intros Ha Hb. apply is_pseries_unique. apply: is_pseries_plus ; rewrite PSeries_eq ; apply Series_correct. by apply Ha. by apply Hb. Qed. Lemma CV_disk_plus (a b : nat -> R) (x : R) : (CV_disk a x) -> (CV_disk b x) -> (CV_disk (PS_plus a b) x). Proof. move => Ha Hb. move: (ex_series_plus _ _ Ha Hb). apply @ex_series_le => n ; rewrite /norm /= /abs /= Rabs_Rabsolu. rewrite Rmult_plus_distr_r. by apply Rabs_triang. Qed. Lemma CV_radius_plus (a b : nat -> R) : Rbar_le (Rbar_min (CV_radius a) (CV_radius b)) (CV_radius (PS_plus a b)). Proof. wlog: a b / (Rbar_le (CV_radius a) (CV_radius b)) => [ Hw | Hle ]. case: (Rbar_le_lt_dec (CV_radius a) (CV_radius b)) => Hle. by apply Hw. rewrite Rbar_min_comm. rewrite (CV_radius_ext (PS_plus a b) (PS_plus b a)). by apply Hw, Rbar_lt_le. now intros n ; apply Rplus_comm. replace (Rbar_min (CV_radius a) (CV_radius b)) with (CV_radius a). apply is_lub_Rbar_subset with (CV_disk (PS_plus a b)) (fun x => (CV_disk a x) /\ (CV_disk b x)). move => x [Ha Hb] ; by apply CV_disk_plus. rewrite /CV_radius /Lub_Rbar ; by case: ex_lub_Rbar. have Ha : is_lub_Rbar (fun x : R => CV_disk a x) (CV_radius a). rewrite /CV_radius /Lub_Rbar ; by case: ex_lub_Rbar. have Hb : is_lub_Rbar (fun x : R => CV_disk b x) (CV_radius b). rewrite /CV_radius /Lub_Rbar ; by case: ex_lub_Rbar. split. intros y [Hay Hby]. by apply Ha. case: (Rbar_le_lt_or_eq_dec _ _ (CV_radius_ge_0 a)) => Ha0. intros c Hc. assert (Rbar_le 0 c). apply Hc. split ; by apply CV_disk_0. case: c Hc H => [c | | ] //= Hc H. 2: by case: (CV_radius a). apply Rbar_not_lt_le => Hac. move: (Rbar_lt_le_trans _ _ _ Hac Hle) => Hbc. eapply Rbar_le_not_lt. apply (Hc ((c + Rbar_min (c + 1) (CV_radius a)) / 2)). assert (Rbar_lt (Rabs ((c + Rbar_min (c + 1) (CV_radius a)) / 2)) (CV_radius a)). case: (CV_radius a) Hac => //= l Hl. rewrite Rabs_pos_eq. apply Rlt_div_l. by apply Rlt_0_2. replace (l * 2) with (l+l) by ring. apply Rplus_lt_le_compat => //. by apply Rmin_r. apply Rdiv_le_0_compat. apply Rplus_le_le_0_compat => //. apply Rmin_case. apply Rplus_le_le_0_compat => //. by apply Rle_0_1. now eapply Rle_trans, Rlt_le, Hl. by apply Rlt_0_2. split ; apply CV_disk_inside. by []. now eapply Rbar_lt_le_trans, Hle. case: (CV_radius a) Hac => [l | | ] //= Hl. apply Rmin_case. apply Rlt_div_r. by apply Rlt_0_2. apply Rminus_lt_0 ; simpl ; ring_simplify. by apply Rlt_0_1. apply Rlt_div_r. by apply Rlt_0_2. apply Rminus_lt_0 ; simpl ; ring_simplify. by rewrite Rplus_comm -Rminus_lt_0. apply Rlt_div_r. by apply Rlt_0_2. apply Rminus_lt_0 ; simpl ; ring_simplify. by apply Rlt_0_1. rewrite -Ha0 in Ha Hle |- *. intros c Hc. apply Hc ; split ; by apply CV_disk_0. apply Rbar_min_case_strong => //. by apply Rbar_le_antisym. Qed. (** Scalar multiplication *) Section PS_scal. Context {K : AbsRing} {V : NormedModule K}. Definition PS_scal (c : K) (a : nat -> V) (n : nat) : V := scal c (a n). Lemma is_pseries_scal (c : K) (a : nat -> V) (x : K) (l : V) : mult x c = mult c x -> is_pseries a x l -> is_pseries (PS_scal c a) x (scal c l). Proof. move => Hx Ha. apply (filterlim_ext (fun n => scal c (sum_n (fun k => scal (pow_n x k) (a k)) n))). elim => [ | n IH]. simpl ; rewrite /PS_scal. rewrite !sum_O. now repeat rewrite scal_one. simpl ; rewrite !sum_Sn -IH /PS_scal. rewrite scal_distr_l; apply f_equal. rewrite 2! scal_assoc. apply f_equal2. rewrite -/(pow_n x (S n)). clear -Hx. elim: (S n) => {n} /= [ | n IH]. by rewrite mult_one_l mult_one_r. by rewrite -mult_assoc -IH 2!mult_assoc Hx. by []. now apply filterlim_comp with (2 := filterlim_scal_r _ _). Qed. Lemma ex_pseries_scal (c : K) (a : nat -> V) (x : K) : mult x c = mult c x -> ex_pseries a x -> ex_pseries (PS_scal c a) x. Proof. move => Hx [l Ha]. exists (scal c l). by apply is_pseries_scal. Qed. End PS_scal. Lemma PSeries_scal (c : R) (a : nat -> R) (x : R) : PSeries (PS_scal c a) x = c * PSeries a x. Proof. rewrite -Series_scal_l. apply Series_ext. move => n /=. apply Rmult_assoc. Qed. Lemma CV_disk_scal (c : R) (a : nat -> R) (x : R) : (CV_disk a x) -> (CV_disk (PS_scal c a) x). Proof. move => Ha. apply ex_series_ext with (fun n => Rabs c * Rabs (a n * x ^ n)). move => n ; rewrite -Rabs_mult ; apply f_equal ; by rewrite /PS_scal /= Rmult_assoc. apply @ex_series_scal. by apply Ha. Qed. Lemma CV_radius_scal (c : R) (a : nat -> R) : c <> 0 -> (CV_radius (PS_scal c a)) = (CV_radius a). Proof. rewrite /CV_radius /Lub_Rbar ; case: ex_lub_Rbar => la [ub_a lub_a] ; case: ex_lub_Rbar => lc [ub_c lub_c] /= Hc. apply Rbar_le_antisym. apply lub_a => x Hx. apply ub_c. assert (CV_disk (PS_scal (/c) (PS_scal c a)) x). by apply CV_disk_scal. move: H ; apply ex_series_ext => n. apply f_equal. rewrite /PS_scal /scal /= /mult /= ; by field. apply lub_c => x Hx. apply ub_a. by apply CV_disk_scal. Qed. Definition PS_scal_r (c : R) (a : nat -> R) (n : nat) : R := a n * c. Lemma PSeries_scal_r (c : R) (a : nat -> R) (x : R) : PSeries (PS_scal_r c a) x = PSeries a x * c. Proof. rewrite -Series_scal_r. apply Series_ext. move => n /=. rewrite /PS_scal_r ; ring. Qed. Lemma CV_disk_scal_r (c : R) (a : nat -> R) (x : R) : (CV_disk a x) -> (CV_disk (PS_scal_r c a) x). Proof. move => Ha. apply ex_series_ext with (fun n => Rabs c * Rabs (a n * x ^ n)). move => n ; rewrite -Rabs_mult ; apply f_equal ; rewrite /PS_scal_r /= ; ring. by apply @ex_series_scal ; apply Ha. Qed. Lemma CV_radius_scal_r (c : R) (a : nat -> R) : c <> 0 -> (CV_radius (PS_scal_r c a)) = (CV_radius a). Proof. intros Hc. rewrite -(CV_radius_scal c a). apply CV_radius_ext => n. apply Rmult_comm. by []. Qed. (** Multiplication and division by a variable *) Section PS_incr. Context {K : AbsRing} {V : NormedModule K}. Definition PS_incr_1 (a : nat -> V) (n : nat) : V := match n with | 0 => zero | S n => a n end. Lemma is_pseries_incr_1 (a : nat -> V) (x:K) (l : V) : is_pseries a x l -> is_pseries (PS_incr_1 a) x (scal x l). Proof. move => Ha. apply filterlim_ext_loc with (fun n : nat => scal x (sum_n (fun k => scal (pow_n x k) (a k)) (pred n))). exists 1%nat; intros n; case n. intros Hn; contradict Hn ; apply Nat.nlt_0_r. clear n; intros n _ ;induction n. now rewrite /= !sum_Sn !sum_O /= mult_one_r 2!scal_one plus_zero_l. apply trans_eq with (plus (sum_n (fun k : nat => scal (pow_n x k) (PS_incr_1 a k)) (S n)) (scal (pow_n x (S (S n))) (PS_incr_1 a (S (S n))))). 2: rewrite /= !sum_Sn ; reflexivity. rewrite -IHn; simpl. rewrite !sum_Sn scal_distr_l; apply f_equal. now rewrite scal_assoc. apply filterlim_comp with (f:= fun n => pred n) (G:=eventually) (g:=fun n => scal x (sum_n (fun k : nat => scal (pow_n x k) (a k)) n)). apply eventually_subseq_loc. exists 1%nat. intros n Hn. rewrite -pred_Sn. now apply Nat.lt_pred_l, Nat.neq_0_lt_0. now apply filterlim_comp with (2 := filterlim_scal_r _ _). Qed. Lemma ex_pseries_incr_1 (a : nat -> V) (x : K) : ex_pseries a x -> ex_pseries (PS_incr_1 a) x. Proof. move => [l Ha] ; exists (scal x l) ; by apply is_pseries_incr_1. Qed. Fixpoint PS_incr_n (a : nat -> V) (n k : nat) : V := match n with | O => a k | S n => PS_incr_1 (PS_incr_n a n) k end. Lemma PS_incr_n_simplify (a : nat -> V) (n k : nat) : PS_incr_n a n k = match (le_lt_dec n k) with | left _ => a (k-n)%nat | right _ => zero end. Proof. case: le_lt_dec => H. elim: n k H => [ | n IH] k H. rewrite /PS_incr_n ; by case: k H. case: k H => [ | k] H. by apply Nat.nle_succ_0 in H. rewrite /PS_incr_n -/PS_incr_n /PS_incr_1. rewrite IH. apply f_equal. by elim: n k H {IH} => /= [ | n IH] k H. by apply le_S_n. elim: n k H => [ | n IH] k H. by apply Nat.nlt_0_r in H. rewrite /PS_incr_n -/PS_incr_n /PS_incr_1. case: k H => [ | k] H. by []. by apply IH, Nat.succ_lt_mono. Qed. Lemma is_pseries_incr_n (a : nat -> V) (n : nat) (x : K) (l : V) : is_pseries a x l -> is_pseries (PS_incr_n a n) x (scal (pow_n x n) l). Proof. move => Ha. elim: n => /= [ | n IH]. by rewrite scal_one. rewrite -scal_assoc. by apply is_pseries_incr_1. Qed. Lemma ex_pseries_incr_n (a : nat -> V) (n : nat) (x : K) : ex_pseries a x -> ex_pseries (PS_incr_n a n) x. Proof. move => [l Ha]. exists (scal (pow_n x n) l) ; by apply is_pseries_incr_n. Qed. Definition PS_decr_1 (a : nat -> V) (n : nat) : V := a (S n). Lemma is_pseries_decr_1 (a : nat -> V) (x y : K) (l : V) : mult y x = one -> is_pseries a x l -> is_pseries (PS_decr_1 a) x (scal y (plus l (opp (a O)))). Proof. move => Hx Ha. apply filterlim_ext with (fun n : nat => scal y (sum_n (fun k => scal (pow_n x (S k)) (a (S k))) n)). intros n; induction n; unfold PS_decr_1; simpl. rewrite !sum_O mult_one_r scal_one scal_assoc. rewrite Hx; try assumption. apply @scal_one. rewrite !sum_Sn -IHn. rewrite scal_distr_l; apply f_equal. rewrite scal_assoc (mult_assoc y). rewrite Hx. now rewrite mult_one_l. apply filterlim_comp with (2 := filterlim_scal_r _ _). apply filterlim_ext with (fun n : nat => plus (sum_n (fun k => scal (pow_n x k) (a k)) (S n)) (opp (a 0%nat))). intros n; induction n; simpl. rewrite sum_Sn !sum_O /= mult_one_r scal_one. rewrite plus_comm plus_assoc. now rewrite plus_opp_l plus_zero_l. rewrite !sum_Sn -IHn. apply sym_eq; rewrite plus_comm plus_assoc. apply f_equal2;[idtac|reflexivity]. now rewrite !sum_Sn plus_comm. apply filterlim_comp_2 with (3 := filterlim_plus _ _). apply filterlim_comp with (f:= fun x => S x) (2:=Ha). apply eventually_subseq; intros n; lia. apply filterlim_const. Qed. Lemma ex_pseries_decr_1 (a : nat -> V) (x : K) : (x = zero \/ exists y, mult y x = one) -> ex_pseries a x -> ex_pseries (PS_decr_1 a) x. Proof. case => [H | [y Hx]] [l Ha]. rewrite H ; by apply ex_pseries_0. exists (scal y (plus l (opp (a 0%nat)))). now apply is_pseries_decr_1. Qed. Definition PS_decr_n (a : nat -> V) (n k : nat) : V := a (n + k)%nat. Lemma is_pseries_decr_n (a : nat -> V) (n : nat) (x y:K) (l : V) : mult y x = one -> (0 < n)%nat -> is_pseries a x l -> is_pseries (PS_decr_n a n) x (scal (pow_n y n) (plus l (opp (sum_n (fun k => scal (pow_n x k) (a k)) (n-1)%nat)))). Proof. move => Hx Hn Ha. case: n Hn => [ | n] Hn. by apply Nat.lt_irrefl in Hn. clear Hn ; simpl ; rewrite Nat.sub_0_r /PS_decr_n /=. elim: n => /= [ | n IH]. rewrite sum_O scal_one mult_one_r. now apply is_pseries_decr_1. set (ln := (scal (mult y (pow_n y n)) (plus l (opp (sum_n (fun k : nat => scal (pow_n x k) (a k)) n))))) in IH. rewrite !sum_Sn /=. replace (scal (mult y (mult y (pow_n y n))) (plus l (opp (plus (sum_n (fun k : nat => scal (pow_n x k) (a k)) n) (scal (mult x (pow_n x n)) (a (S n))))))) with (scal y (plus ln (opp (a (S (n + 0)))))). assert (Y:is_pseries (fun k : nat => a (S (n + k))) x ln). apply IH. move: (is_pseries_decr_1 (fun k : nat => a (S (n + k))) x y ln Hx Y). rewrite /PS_decr_1 /=. apply is_pseries_ext => k. apply f_equal ; ring. rewrite -scal_assoc. apply f_equal; unfold ln. repeat rewrite (scal_distr_l _ l). rewrite -plus_assoc; apply f_equal. rewrite (opp_plus (sum_n _ _) ) scal_distr_l; apply f_equal. rewrite Nat.add_0_r -scal_opp_l scal_assoc. apply trans_eq with (scal (opp (one : K)) (a (S n))). now rewrite scal_opp_l scal_one. apply f_equal2; try reflexivity. rewrite <- opp_mult_r; apply f_equal. clear -Hx. rewrite -?/(pow_n _ (S _)). elim: (S n) => {n} /= [ | n IH]. by rewrite mult_one_l. rewrite -(pow_n_comm_1 x) mult_assoc. rewrite -(mult_assoc y (pow_n y n) (pow_n x n)). by rewrite -IH mult_one_r. Qed. Lemma ex_pseries_decr_n (a : nat -> V) (n : nat) (x : K) : (x = zero \/ exists y, mult y x = one) -> ex_pseries a x -> ex_pseries (PS_decr_n a n) x. Proof. intros Hx H. induction n. unfold PS_decr_n; now simpl. apply ex_pseries_ext with ((PS_decr_1 (PS_decr_n a n))). intros m; unfold PS_decr_1, PS_decr_n. apply f_equal; ring. apply ex_pseries_decr_1. apply Hx. now apply IHn. Qed. End PS_incr. Lemma PSeries_incr_1 a x : PSeries (PS_incr_1 a) x = x * PSeries a x. Proof. rewrite -Series_scal_l. unfold PSeries, Series. rewrite -(Lim_seq_incr_1 (sum_n (fun k : nat => PS_incr_1 a k * x ^ k))) /=. apply f_equal, Lim_seq_ext. case. rewrite sum_Sn !sum_O /= /plus /zero /=. ring. elim => /= [ | n IH]. rewrite !sum_Sn !sum_O /= /plus /zero /=. ring. rewrite sum_Sn IH !sum_Sn /= /plus /=. ring. Qed. Lemma PSeries_incr_n (a : nat -> R) (n : nat) (x : R) : PSeries (PS_incr_n a n) x = x^n * PSeries a x. Proof. elim: n => /= [ | n IH]. by rewrite Rmult_1_l. rewrite Rmult_assoc. by rewrite PSeries_incr_1 IH. Qed. Lemma PSeries_decr_1 (a : nat -> R) (x : R) : ex_pseries a x -> PSeries a x = a O + x * PSeries (PS_decr_1 a) x. Proof. intros Ha. case: (Req_dec x 0) => Hx. rewrite Hx PSeries_0 ; ring. move: (is_pseries_decr_1 a x (/x) (PSeries a x) (Rinv_l _ Hx) (PSeries_correct _ _ Ha)) => Hb. rewrite (is_pseries_unique _ _ _ Hb). rewrite /plus /opp /scal /= /mult /=. now field. Qed. Lemma PSeries_decr_1_aux (a : nat -> R) (x : R) : a O = 0 -> (PSeries a x) = x * PSeries (PS_decr_1 a) x. Proof. intros Ha0. rewrite -PSeries_incr_1. rewrite /PS_incr_1 /PS_decr_1 /=. apply Series_ext. case => //=. by rewrite Ha0. Qed. Lemma PSeries_decr_n (a : nat -> R) (n : nat) (x : R) : ex_pseries a x -> PSeries a x = sum_f_R0 (fun k => a k * x^k) n + x^(S n) * PSeries (PS_decr_n a (S n)) x. Proof. intros Ha. case: (Req_dec x 0) => Hx. rewrite Hx PSeries_0 ; simpl ; ring_simplify. elim: n => /= [ | n IH]. ring. rewrite -IH ; ring. assert (V:(pow_n x (S n) <> 0)). rewrite pow_n_pow; now apply pow_nonzero. move: (is_pseries_decr_n a (S n) x (/x) (PSeries a x) (Rinv_l x Hx) (Nat.lt_0_succ _) (PSeries_correct _ _ Ha)) => Hb. rewrite (is_pseries_unique _ _ _ Hb). rewrite (sum_n_ext _ (fun k : nat => a k * x ^ k)). rewrite sum_n_Reals. replace (S n -1)%nat with n. rewrite /scal /plus /opp /= /mult /=. rewrite pow_n_pow -Rinv_pow ; try assumption. field. split; try assumption. now apply pow_nonzero. now rewrite Nat.sub_succ Nat.sub_0_r. intros m; rewrite pow_n_pow. apply Rmult_comm. Qed. Lemma PSeries_decr_n_aux (a : nat -> R) (n : nat) (x : R) : (forall k : nat, (k < n)%nat -> a k = 0) -> PSeries a x = x^n * PSeries (PS_decr_n a n) x. Proof. elim: n => /= [ | n IH] Ha. rewrite Rmult_1_l. apply PSeries_ext => n ; by intuition. rewrite IH. rewrite PSeries_decr_1_aux. rewrite (Rmult_comm _ (x^n)) Rmult_assoc. repeat apply Rmult_eq_compat_l. apply PSeries_ext => k ; rewrite /PS_decr_1 /PS_decr_n ; by intuition. apply Ha ; by intuition. move => k Hk. apply Ha ; by intuition. Qed. Lemma CV_radius_incr_1 (a : nat -> R) : CV_radius (PS_incr_1 a) = CV_radius a. Proof. assert (Ha := CV_radius_bounded a). assert (Ha' := CV_radius_bounded (PS_incr_1 a)). apply Rbar_le_antisym. apply Ha' => x [M Hx] ; apply Ha. move: (fun n => Hx (S n)) => {} Hx ; simpl in Hx. case: (Req_dec x 0) => Hx0. rewrite Hx0 ; exists (Rabs (a O)) ; case => /= [ | n]. rewrite Rmult_1_r ; by right. rewrite Rmult_0_l Rmult_0_r Rabs_R0. by apply Rabs_pos. exists (M / Rabs x) => n. apply Rle_div_r. by apply Rabs_pos_lt. by rewrite -Rabs_mult Rmult_assoc (Rmult_comm _ x). apply Ha => x [M Hx] ; apply Ha'. exists (M * Rabs x) ; case => [ | n] /=. rewrite Rmult_0_l Rabs_R0. apply Rmult_le_pos. eapply Rle_trans, (Hx O). by apply Rabs_pos. by apply Rabs_pos. rewrite (Rmult_comm x) -Rmult_assoc Rabs_mult. apply Rmult_le_compat_r. by apply Rabs_pos. by []. Qed. Lemma CV_radius_decr_1 (a : nat -> R) : CV_radius (PS_decr_1 a) = CV_radius a. Proof. assert (Ha := CV_radius_bounded a). assert (Ha' := CV_radius_bounded (PS_decr_1 a)). apply Rbar_le_antisym. apply Ha' => x [M Hx] ; apply Ha. eexists ; case => [ | n] ; simpl. eapply Rle_trans, Rmax_l. rewrite Rmult_1_r ; apply Rle_refl. eapply Rle_trans, Rmax_r. rewrite (Rmult_comm x) -Rmult_assoc Rabs_mult. apply Rmult_le_compat_r. by apply Rabs_pos. by apply Hx. apply Ha => x [M Hx] ; apply Ha'. move: (fun n => Hx (S n)) => {} Hx ; simpl in Hx. case: (Req_dec x 0) => Hx0. rewrite Hx0 ; exists (Rabs (a 1%nat)) ; case => /= [ | n]. rewrite Rmult_1_r ; by right. rewrite Rmult_0_l Rmult_0_r Rabs_R0. by apply Rabs_pos. exists (M / Rabs x) => n. apply Rle_div_r. by apply Rabs_pos_lt. rewrite -Rabs_mult Rmult_assoc (Rmult_comm _ x). by apply Hx. Qed. Definition PS_mult (a b : nat -> R) n := sum_f_R0 (fun k => a k * b (n - k)%nat) n. Lemma is_pseries_mult (a b : nat -> R) (x la lb : R) : is_pseries a x la -> is_pseries b x lb -> Rbar_lt (Rabs x) (CV_radius a) -> Rbar_lt (Rabs x) (CV_radius b) -> is_pseries (PS_mult a b) x (la * lb). Proof. move => Hla Hlb Ha Hb. apply is_series_ext with (fun n => sum_f_R0 (fun k => (fun l => a l * x ^ l) k * (fun l => b l * x ^ l) (n - k)%nat) n). move => n. rewrite /PS_mult /scal /= /mult /= scal_sum. apply sum_eq => i Hi. rewrite -{4}(MyNat.sub_add _ _ Hi). rewrite pow_n_pow pow_add. ring. apply (is_series_mult (fun l => a l * x ^ l) (fun l => b l * x ^ l)). now apply (is_pseries_R a x la). now apply (is_pseries_R b x lb). by apply CV_disk_inside. by apply CV_disk_inside. Qed. Lemma ex_pseries_mult (a b : nat -> R) (x : R) : Rbar_lt (Rabs x) (CV_radius a) -> Rbar_lt (Rabs x) (CV_radius b) -> ex_pseries (PS_mult a b) x. Proof. move => Ha Hb. exists ((PSeries a x) * (PSeries b x)). apply is_pseries_mult => // ; by apply PSeries_correct, CV_radius_inside. Qed. Lemma PSeries_mult (a b : nat -> R) (x : R) : Rbar_lt (Rabs x) (CV_radius a) -> Rbar_lt (Rabs x) (CV_radius b) -> PSeries (PS_mult a b) x = PSeries a x * PSeries b x. Proof. move => Ha Hb. apply is_pseries_unique. apply is_pseries_mult => // ; by apply PSeries_correct, CV_radius_inside. Qed. (** Sums on even and odd *) Lemma is_pseries_odd_even (a : nat -> R) (x l1 l2 : R) : is_pseries (fun n => a (2*n)%nat) (x^2) l1 -> is_pseries (fun n => a (2*n+1)%nat) (x^2) l2 -> is_pseries a x (l1 + x * l2). Proof. rewrite 3!is_pseries_R. move => H1 H2. apply filterlim_ext with (fun n => (sum_n (fun k : nat => a (2 * k)%nat * (x ^ 2) ^ k) (Nat.div2 n)) + x * match n with | O => 0 | S n => (sum_n (fun k : nat => a (2 * k + 1)%nat * (x ^ 2) ^ k) (Nat.div2 n)) end). case => [ | n]. rewrite /= !sum_O /= ; ring. case: (Nat.Even_or_Odd n) => Hn. (* even n *) rewrite 3!sum_n_Reals. rewrite -(MyNat.Even_div2 _ Hn) {3}(MyNat.Even_double _ Hn) Nat.double_twice. elim: (Nat.div2 n) => {n Hn} [ | n] ; rewrite ?double_S /sum_f_R0 -/sum_f_R0. rewrite /double /= ; ring. rewrite -pow_mult. replace (2 * S n)%nat with (S (S (Nat.double n))) by (now rewrite -MyNat.double_S Nat.double_twice). replace (S (S (Nat.double n)) + 1)%nat with (S (S (S (Nat.double n)))) by (now rewrite Nat.add_1_r). rewrite !Nat.double_twice; simpl; move => <-; ring. (* odd n *) rewrite 3!sum_n_Reals. rewrite -(MyNat.Odd_div2 _ Hn) {3}(MyNat.Odd_double _ Hn) !Nat.double_twice. elim: (Nat.div2 n) => {n Hn} [ | n] ; rewrite ?double_S /sum_f_R0 -/sum_f_R0. rewrite /double /= ; ring. rewrite -?pow_mult. replace (2 * S n)%nat with (S (S (Nat.double n))) by (rewrite -MyNat.double_S Nat.double_twice ; ring). replace (2 * S (S n))%nat with (S (S (S (S (Nat.double n))))) by (rewrite -MyNat.double_S Nat.double_twice ; ring). replace (S (S (Nat.double n)) + 1)%nat with (S (S (S (Nat.double n)))) by ring. rewrite !Nat.double_twice; simpl; move => <-; ring. apply (is_lim_seq_plus' _ _ l1 (x*l2)). (* a(2k)x^(2k) *) apply filterlim_comp with (2:=H1). intros P [N HN]. exists (2*N+1)%nat. intros n Hn; apply HN. apply le_double. apply Nat.add_le_mono_l with 1%nat. rewrite Nat.add_comm. apply Nat.le_trans with (1:=Hn). apply Nat.le_trans with (1+Nat.double (Nat.div2 n))%nat. case (Nat.Even_or_Odd n); intros J. rewrite <- MyNat.Even_double; try exact J. now apply le_S. rewrite <- MyNat.Odd_double; easy. simpl; now rewrite Nat.add_0_r. (* a(2k+1)x^(2k+1) *) apply (is_lim_seq_scal_l _ x l2) => //. apply filterlim_ext_loc with (fun n => sum_n (fun k : nat => a (2 * k + 1)%nat * (x ^ 2) ^ k) (Nat.div2 (pred n))). exists 1%nat; intros y; case y. easy. intros n _; reflexivity. apply filterlim_comp with (2:=H2). intros P [N HN]. exists (2*N+2)%nat. intros n Hn; apply HN. apply le_double. apply Nat.add_le_mono_l with 2%nat. rewrite Nat.add_comm. apply Nat.le_trans with (1:=Hn). apply Nat.le_trans with (1+(1+Nat.double (Nat.div2 (pred n))))%nat. case (Nat.Even_or_Odd (pred n)); intros J. rewrite <- MyNat.Even_double; try exact J. case n. simpl; now apply le_S, le_S. intros m; simpl; now apply le_S. rewrite <- MyNat.Odd_double; try exact J. case n; simpl; try easy. now apply le_S. simpl; now rewrite Nat.add_0_r. Qed. Lemma ex_pseries_odd_even (a : nat -> R) (x : R) : ex_pseries (fun n => a (2*n)%nat) (x^2) -> ex_pseries (fun n => a (2*n+1)%nat) (x^2) -> ex_pseries a x. Proof. move => [l1 H1] [l2 H2]. exists (l1 + x * l2). by apply is_pseries_odd_even. Qed. Lemma PSeries_odd_even (a : nat -> R) (x : R) : ex_pseries (fun n => a (2*n)%nat) (x^2) -> ex_pseries (fun n => a (2*n+1)%nat) (x^2) -> PSeries a x = PSeries (fun n => a (2*n)%nat) (x^2) + x * PSeries (fun n => a (2*n+1)%nat) (x^2). Proof. move => H1 H2 ; apply is_pseries_unique. apply (is_pseries_odd_even a x); by apply PSeries_correct. Qed. Lemma PSeries_const_0 : forall x, PSeries (fun _ => 0) x = 0. Proof. move => x. replace 0 with (real 0) by auto. apply (f_equal real). rewrite -{2}(Lim_seq_const 0) /=. apply Lim_seq_ext. elim => /= [ | n IH]. rewrite sum_O ; ring. rewrite sum_Sn /= /plus /= IH ; ring. Qed. Lemma CV_radius_const_0 : CV_radius (fun _ => 0) = p_infty. Proof. suff : forall x, Rbar_le (Rabs x) (CV_radius (fun _ : nat => 0)). case H : (CV_radius (fun _ : nat => 0)) => [cv | | ] //= H0. case: (Rle_lt_dec 0 cv) => Hcv. move: (H0 (cv + 1)) => {} H0. contradict H0 ; apply Rlt_not_le => /=. apply Rlt_le_trans with (2 := Rle_abs _). apply Rminus_lt_0 ; ring_simplify ; by apply Rlt_0_1. contradict Hcv ; apply (Rbar_le_not_lt cv 0). rewrite -Rabs_R0. by apply H0. move: (H0 0) => {} H0. contradict H0 ; by apply Rbar_lt_not_le. move => x ; apply Rbar_not_lt_le => Hx. apply CV_disk_outside in Hx. apply: Hx. apply is_lim_seq_ext with (fun _ => 0). move => n ; ring. by apply is_lim_seq_const. Qed. Section PS_opp. Context {K : AbsRing} {V : NormedModule K}. Definition PS_opp (a : nat -> V) (n : nat) : V := opp (a n). Lemma is_pseries_opp (a : nat -> V) (x :K) (l : V) : is_pseries a x l -> is_pseries (PS_opp a) x (opp l). Proof. intros H. replace (opp l) with (scal (opp (one : K)) l). 2: now rewrite scal_opp_l scal_one. apply is_pseries_ext with (PS_scal (opp one) a). intros n; unfold PS_scal, PS_opp. now rewrite scal_opp_l scal_one. apply is_pseries_scal. rewrite -opp_mult_l -opp_mult_r. by rewrite mult_one_l mult_one_r. by apply H. Qed. Lemma ex_pseries_opp (a : nat -> V) (x : K) : ex_pseries a x -> ex_pseries (PS_opp a) x. Proof. intros [l Hl]. exists (opp l). now apply is_pseries_opp. Qed. End PS_opp. Lemma PSeries_opp (a : nat -> R) (x : R) : PSeries (PS_opp a) x = - PSeries a x. Proof. replace (- PSeries a x) with ((-1) * PSeries a x) by ring. rewrite -PSeries_scal. apply PSeries_ext => n. by rewrite /PS_scal /PS_opp scal_opp_one. Qed. Lemma CV_radius_opp (a : nat -> R) : (CV_radius (PS_opp a)) = (CV_radius a). Proof. rewrite -(CV_radius_scal (-1)). apply CV_radius_ext => n. by rewrite /PS_scal /PS_opp scal_opp_l scal_opp_r opp_opp scal_one. rewrite -Ropp_0 ; apply Rlt_not_eq, Ropp_lt_contravar, Rlt_0_1. Qed. Section PS_minus. Context {K : AbsRing} {V : NormedModule K}. Definition PS_minus (a b : nat -> V) (n : nat) : V := plus (a n) (opp (b n)). Lemma is_pseries_minus (a b : nat -> V) (x:K) (la lb : V) : is_pseries a x la -> is_pseries b x lb -> is_pseries (PS_minus a b) x (plus la (opp lb)). Proof. move => Ha Hb. apply is_pseries_plus. exact: Ha. by apply is_pseries_opp. Qed. Lemma ex_pseries_minus (a b : nat -> V) (x : K) : ex_pseries a x -> ex_pseries b x -> ex_pseries (PS_minus a b) x. Proof. move => Ha Hb. apply ex_pseries_plus. exact: Ha. by apply ex_pseries_opp. Qed. End PS_minus. Lemma PSeries_minus (a b : nat -> R) (x : R) : ex_pseries a x -> ex_pseries b x -> PSeries (PS_minus a b) x = PSeries a x - PSeries b x. Proof. move => Ha Hb. rewrite PSeries_plus. by rewrite PSeries_opp. exact: Ha. by apply ex_pseries_opp. Qed. (** ** Abel's theorem for power series *) Lemma Abel (a : nat -> R) : Rbar_lt 0 (CV_radius a) -> Rbar_lt (CV_radius a) p_infty -> ex_pseries a (CV_radius a) -> filterlim (PSeries a) (at_left (CV_radius a)) (locally (PSeries a (CV_radius a))). Proof. case Hcv : (CV_radius a) => [cv | | ] //= Hcv0 _ Ha1. wlog: cv a Hcv Hcv0 Ha1 / (cv = 1) => Hw. apply filterlim_ext with (fun x => PSeries (fun n => a n * cv ^ n) (x / cv)). intros x. apply Series_ext => n. rewrite Rmult_assoc -Rpow_mult_distr. apply f_equal, f_equal2 => //. field ; by apply Rgt_not_eq. apply filterlim_comp with (at_left 1). intros P [d Hd]. unfold filtermap. eapply filter_imp. intros x Hx ; apply Hd. apply @norm_compat1. rewrite /minus /plus /opp /=. replace (x / cv + _) with ((x - cv) / cv) by (field ; exact: Rgt_not_eq). rewrite /norm /= /abs /= Rabs_div ; try by apply Rgt_not_eq. rewrite (Rabs_pos_eq cv) ; try by apply Rlt_le. apply Rlt_div_l => //. eapply (proj1 Hx). apply Rlt_div_l => //. rewrite Rmult_1_l. by apply (proj2 Hx). assert (Hd' : 0 < d * cv). apply Rmult_lt_0_compat. by apply d. by []. exists (mkposreal _ Hd') => /= y Hy Hy0 ; by split. replace (PSeries a cv) with (PSeries (fun n : nat => a n * cv ^ n) 1). apply (Hw 1 (fun n : nat => a n * cv ^ n)) ; clear Hw. apply Rbar_le_antisym. move: Hcv ; rewrite /CV_radius /Lub.Lub_Rbar /CV_disk. case: Lub.ex_lub_Rbar => l /= Hl Hl1 ; case: Lub.ex_lub_Rbar => l' /= Hl'. rewrite Hl1 in Hl => {l Hl1}. apply Hl'. intros x Hx. apply (Rmult_le_reg_l cv) => //. rewrite Rmult_1_r. apply Hl. move: Hx ; apply ex_series_ext => n. by rewrite Rpow_mult_distr Rmult_assoc. rewrite -Rabs_R1. apply Rbar_not_lt_le => Hcv'. apply CV_disk_outside in Hcv'. apply: Hcv'. apply ex_series_lim_0 ; move: Ha1 ; apply ex_series_ext => n. rewrite pow_n_pow pow1 Rmult_1_r. apply Rmult_comm. by apply Rlt_0_1. move: Ha1 ; apply ex_series_ext => n. rewrite !pow_n_pow pow1 scal_one. apply Rmult_comm. by []. apply Series_ext => n. by rewrite pow1 Rmult_1_r. rewrite Hw in Hcv Ha1 |- * => {cv Hw Hcv0}. wlog: a Hcv Ha1 / (PSeries a 1 = 0) => Hw. set b := fun n => match n with | O => a O - PSeries a 1 | S n => a (S n) end. assert (CV_radius b = Finite 1). rewrite -Hcv. rewrite -(CV_radius_decr_1 a) -(CV_radius_decr_1 b). apply CV_radius_ext => n. reflexivity. assert (ex_pseries b 1). apply ex_series_incr_1. apply ex_series_incr_1 in Ha1. move: Ha1 ; apply ex_series_ext => n. reflexivity. assert (PSeries b 1 = 0). rewrite PSeries_decr_1 //. rewrite /b PSeries_decr_1 /PS_decr_1 //. ring. specialize (Hw b H H0 H1). apply filterlim_ext_loc with (fun x => PSeries b x + PSeries a 1). exists (mkposreal _ Rlt_0_1) => x Hx0 Hx. apply (Rabs_lt_between' x 1 1) in Hx0. rewrite Rminus_eq_0 in Hx0. rewrite PSeries_decr_1. rewrite /b (PSeries_decr_1 a x) /PS_decr_1. ring. apply CV_radius_inside. rewrite Hcv Rabs_pos_eq. by []. by apply Rlt_le, Hx0. apply CV_radius_inside. rewrite H Rabs_pos_eq. by []. by apply Rlt_le, Hx0. rewrite -{2}(Rplus_0_l (PSeries a 1)). eapply filterlim_comp_2. by apply Hw. by apply filterlim_const. rewrite H1. apply @filterlim_plus. apply PSeries_correct in Ha1. rewrite Hw in Ha1 |- * => {Hw}. set Sa := sum_n a. assert (forall n x, sum_n (fun k => scal (pow_n x k) (a k)) n = (1 - x) * sum_n (fun k => scal (pow_n x k) (Sa k)) n + scal (pow_n x (S n)) (Sa n)). elim => /= [ | n IH] x. rewrite /Sa !sum_O scal_one mult_one_r /=. rewrite /scal /= /mult /= ; ring. rewrite !sum_Sn IH ; clear IH. rewrite /Sa /= !sum_Sn -/(Sa n). rewrite /plus /scal /= /mult /=. ring. assert (forall x, Rabs x < 1 -> is_pseries Sa x (PSeries a x / (1 - x))). intros x Hx. destruct (CV_radius_inside a x) as [l Hl]. rewrite Hcv. by apply Hx. rewrite (is_pseries_unique _ _ _ Hl). rewrite /is_pseries /is_series. replace (@locally R_NormedModule (l / (1 - x))) with (Rbar_locally (Rbar_mult (l - ((Rbar_mult x 0) * 0)) (/ (1 - x)))). apply (is_lim_seq_ext (fun n => (sum_n (fun k : nat => scal (pow_n (K := R_AbsRing) x k) (a k)) n - scal (pow_n (K := R_AbsRing) x (S n)) (Sa n)) / (1 - x)) (sum_n (fun k : nat => scal (pow_n (K := R_AbsRing) x k) (Sa k)))). intros n ; rewrite H. field. apply Rgt_not_eq ; apply -> Rminus_lt_0. by apply Rabs_lt_between, Hx. apply is_lim_seq_scal_r. apply is_lim_seq_minus'. apply Hl. apply is_lim_seq_mult'. apply is_lim_seq_mult'. apply is_lim_seq_const. eapply is_lim_seq_ext. intros n ; by apply sym_eq, pow_n_pow. apply is_lim_seq_geom. by apply Hx. move: Ha1 ; apply (is_lim_seq_ext _ _ 0). intros n ; apply sum_n_ext => k. by rewrite pow_n_pow pow1 scal_one. by replace (Rbar_mult (l - Rbar_mult x 0 * 0) (/ (1 - x))) with (Finite (l / (1 - x))) by (simpl ; apply f_equal ; unfold Rdiv ; ring). apply filterlim_ext_loc with (fun x => (1-x) * PSeries Sa x). exists (mkposreal _ Rlt_0_1) ; simpl ; intros x Hx Hx1. apply (Rabs_lt_between' x 1 1) in Hx. rewrite Rminus_eq_0 in Hx. assert (Rabs x < 1). rewrite Rabs_pos_eq. by apply Hx1. by apply Rlt_le, Hx. specialize (H0 x H1). rewrite (is_pseries_unique _ _ _ H0). field. by apply Rgt_not_eq ; apply -> Rminus_lt_0. apply filterlim_locally => eps. destruct (Ha1 (ball 0 (pos_div_2 eps))) as [N HN]. apply locally_ball. eapply filter_imp. intros x Hx. rewrite (PSeries_decr_n _ N). rewrite (double_var eps) Rmult_plus_distr_l. eapply Rle_lt_trans. rewrite /minus opp_zero plus_zero_r. apply @abs_triangle. rewrite /abs /= 3!Rabs_mult. apply Rplus_lt_le_compat. eapply Rle_lt_trans. apply Rmult_le_compat_l. by apply Rabs_pos. eapply Rle_trans. apply Rsum_abs. apply sum_growing. intros n. rewrite Rabs_mult. apply Rmult_le_compat_l. by apply Rabs_pos. rewrite -RPow_abs. apply pow_incr ; split. apply Rabs_pos. apply Rlt_le. instantiate (1 := 1). eapply (proj1 Hx). destruct Hx as [Hx1 Hx]. eapply Rle_lt_trans. apply Rmult_le_compat_l. by apply Rabs_pos. apply (Rmax_r 1). apply Rlt_div_r. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. eapply (proj1 Hx). destruct Hx as [Hx1 [Hx2 Hx]]. eapply Rle_trans. apply Rmult_le_compat_l. by apply Rabs_pos. apply Rmult_le_compat ; try by apply Rabs_pos. rewrite -/(pow _ (S N)) -RPow_abs. apply pow_incr ; split. apply Rabs_pos. apply Rlt_le, Hx1. eapply Rle_trans. apply Series_Rabs. eapply @ex_series_le. intros n ; rewrite /norm /= /abs /= Rabs_Rabsolu. rewrite Rabs_mult. rewrite -RPow_abs. apply Rmult_le_compat_r. rewrite RPow_abs ; by apply Rabs_pos. rewrite /PS_decr_n. eapply Rle_trans, Rlt_le, HN. apply Req_le, f_equal. rewrite /minus opp_zero plus_zero_r. apply sum_n_ext => k. by rewrite pow_n_pow pow1 scal_one. apply Nat.le_trans with (1 := Nat.le_succ_diag_r _). apply Nat.le_add_r. apply @ex_series_scal. apply ex_series_geom. by rewrite Rabs_Rabsolu. apply Series_le. intros n ; split. apply Rabs_pos. rewrite Rabs_mult. rewrite -RPow_abs. apply Rmult_le_compat_r. rewrite RPow_abs ; by apply Rabs_pos. rewrite /PS_decr_n. eapply Rle_trans, Rlt_le, HN. apply Req_le, f_equal. rewrite /minus opp_zero plus_zero_r. apply sum_n_ext => k. by rewrite pow_n_pow pow1 scal_one. apply Nat.le_trans with (1 := Nat.le_succ_diag_r _). apply Nat.le_add_r. apply @ex_series_scal. apply ex_series_geom. by rewrite Rabs_Rabsolu. rewrite Series_scal_l Series_geom. rewrite pow1 Rmult_1_l !Rabs_pos_eq. apply Req_le ; simpl ; field. apply Rgt_not_eq ; apply -> Rminus_lt_0. eapply Rle_lt_trans, Hx1. by apply Rle_abs. apply Hx. apply -> Rminus_le_0. eapply Rle_trans, Rlt_le, Hx1. by apply Rle_abs. by rewrite Rabs_Rabsolu. eexists ; apply H0, Hx. assert (0 < Rmin (eps / 2 / Rmax 1 (sum_f_R0 (fun n : nat => Rabs (Sa n) * 1 ^ n) N)) 1). apply Rmin_case. apply Rdiv_lt_0_compat. by apply is_pos_div_2. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. by apply Rlt_0_1. exists (mkposreal _ H1) => /= y Hy Hy1. split. apply (Rabs_lt_between' y 1 (Rmin (eps / 2 / Rmax 1 (sum_f_R0 (fun n : nat => Rabs (Sa n) * 1 ^ n) N)) 1)) in Hy. rewrite {1}/Rminus -Rmax_opp_Rmin Rplus_max_distr_l Rplus_min_distr_l in Hy. rewrite -!/(Rminus _ _) Rminus_eq_0 in Hy. rewrite Rabs_pos_eq. by []. apply Rlt_le. eapply Rle_lt_trans, Hy. by apply Rmax_r. split. eapply Rlt_le_trans. rewrite -Rabs_Ropp Ropp_minus_distr'. apply Hy. by apply Rmin_l. apply (Rabs_lt_between' y 1 (Rmin (eps / 2 / Rmax 1 (sum_f_R0 (fun n : nat => Rabs (Sa n) * 1 ^ n) N)) 1)) in Hy. rewrite {1}/Rminus -Rmax_opp_Rmin Rplus_max_distr_l Rplus_min_distr_l in Hy. rewrite -!/(Rminus _ _) Rminus_eq_0 in Hy. eapply Rle_trans, Rlt_le, Hy. by apply Rmax_r. Qed. (** * Analysis *) (** ** Continuity *) Lemma PSeries_continuity (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> continuity_pt (PSeries a) x. Proof. move => H. case: (CV_radius_Reals_2 a x H) => r H0. apply (CVU_continuity (fun (n : nat) (x : R) => sum_f_R0 (fun k : nat => a k * x ^ k) n) (PSeries a) x r H0). move => n y Hy. apply continuity_pt_finite_SF. move => k Hk. apply continuity_pt_scal. elim: k {Hk} => /= [ | k IH]. by apply continuity_pt_const => d f. apply continuity_pt_mult. apply derivable_continuous_pt, derivable_pt_id. by apply IH. rewrite /Boule Rminus_eq_0 Rabs_R0 ; by apply r. Qed. (** ** Differentiability *) Definition PS_derive (a : nat -> R) (n : nat) := INR (S n) * a (S n). Lemma CV_radius_derive (a : nat -> R) : CV_radius (PS_derive a) = CV_radius a. Proof. have H := (CV_radius_bounded a). have H0 := (CV_radius_bounded (PS_derive a)). apply Rbar_le_antisym. apply is_lub_Rbar_subset with (2 := H) (3 := H0) => x [M Ha]. exists (Rmax (Rabs (a O)) (Rabs x * M)) ; case => /= [ | n]. rewrite Rmult_1_r ; by apply Rmax_l. apply Rle_trans with (2 := Rmax_r _ _). replace (a (S n) * (x * x ^ n)) with (x * ((PS_derive a n * x ^ n) / INR (S n))) by (rewrite /PS_derive ; field ; apply not_0_INR, sym_not_eq, O_S). rewrite Rabs_mult ; apply Rmult_le_compat_l. by apply Rabs_pos. rewrite Rabs_div ; [ | by apply not_0_INR, sym_not_eq, O_S]. apply Rle_div_l. by apply Rabs_pos_lt, not_0_INR, sym_not_eq, O_S. apply Rle_trans with (1 := Ha n). rewrite -{1}(Rmult_1_r M). apply Rmult_le_compat_l. by apply Rle_trans with (2 := Ha O), Rabs_pos. by apply Rle_trans with (2 := Rle_abs _), (le_INR 1), le_n_S, Nat.le_0_l. apply H => x [M Hx]. have H1 : Rbar_le (Finite 0) (CV_radius (PS_derive a)). apply H0 ; exists (Rabs (PS_derive a O)) ; case => /= [ | n]. rewrite Rmult_1_r ; by apply Rle_refl. rewrite Rmult_0_l Rmult_0_r Rabs_R0 ; by apply Rabs_pos. wlog: x Hx / (0 < x) => [Hw | Hx0]. case: (Rle_lt_dec x 0) => Hx0. apply Rbar_le_trans with (Finite 0). exact Hx0. by apply H1. by apply Hw. suff : forall y, 0 < y < x -> Rbar_le (Finite y) (CV_radius (PS_derive a)). case: (CV_radius (PS_derive a)) H1 => [l | | ] //= H1 H2. apply Rnot_lt_le => /= H3. have H4 : (0 < (x+l)/2 < x). split. apply Rdiv_lt_0_compat. by apply Rplus_lt_le_0_compat. by apply Rlt_R0_R2. apply Rminus_lt, Ropp_lt_cancel ; field_simplify. rewrite ?Rdiv_1 ; apply Rdiv_lt_0_compat. by apply -> Rminus_lt_0. by apply Rlt_R0_R2. move: (H2 _ H4). apply Rlt_not_le. apply Rminus_lt, Ropp_lt_cancel ; field_simplify. rewrite ?Rdiv_1 ; apply Rdiv_lt_0_compat. rewrite Rplus_comm ; by apply -> Rminus_lt_0. by apply Rlt_R0_R2. move => y Hy. apply H0 ; rewrite /PS_derive. have H2 : is_lim_seq (fun n => INR (S n) / x * (y/x) ^ n) 0. apply ex_series_lim_0. apply ex_series_Rabs. apply CV_disk_DAlembert with 1. move => n. apply Rgt_not_eq, Rdiv_lt_0_compat. by apply lt_0_INR, Nat.lt_0_succ. apply Rlt_trans with y ; by apply Hy. apply is_lim_seq_spec. move => eps. case: (nfloor_ex (/eps)) => [ | N HN]. by apply Rlt_le, Rinv_0_lt_compat, eps. exists (S N) => n Hn. apply Rabs_lt_between'. replace (INR (S (S n)) / x / (INR (S n) / x)) with (INR (S (S n)) / (INR (S n))) by (field ; split ; [apply Rgt_not_eq, Rlt_trans with y ; by apply Hy | by apply Rgt_not_eq, lt_0_INR, Nat.lt_0_succ]). rewrite Rabs_pos_eq. split. apply Rlt_div_r. by apply lt_0_INR, Nat.lt_0_succ. rewrite ?S_INR Rminus_lt_0 ; ring_simplify. rewrite Rplus_assoc. apply Rplus_le_lt_0_compat. apply Rmult_le_pos. by apply (le_INR O), Nat.le_0_l. by apply Rlt_le, eps. by apply Rle_lt_0_plus_1, Rlt_le, eps. apply Rlt_div_l. by apply lt_0_INR, Nat.lt_0_succ. rewrite ?S_INR Rminus_lt_0 ; ring_simplify. rewrite /Rminus Rplus_assoc -/(Rminus eps 1). rewrite -(Ropp_involutive (eps-1)) -Rminus_lt_0 Ropp_minus_distr'. apply Rlt_trans with 1. apply Rminus_lt_0 ; ring_simplify ; by apply eps. replace 1 with (eps*/eps) by (field ; apply Rgt_not_eq, eps). apply Rmult_lt_compat_l. by apply eps. apply Rlt_le_trans with (1 := proj2 HN). rewrite -S_INR ; by apply le_INR. apply Rlt_le, Rdiv_lt_0_compat ; by apply lt_0_INR, Nat.lt_0_succ. right ; split. by apply Rgt_not_eq, Rlt_0_1. rewrite Rinv_1 Rabs_pos_eq. apply -> Rdiv_lt_1. by apply Hy. apply Rlt_trans with y ; by apply Hy. apply Rlt_le, Rdiv_lt_0_compat. by apply Hy. apply Rlt_trans with y ; by apply Hy. apply is_lim_seq_spec in H2. case: (H2 (mkposreal _ (Rlt_0_1))) ; simpl pos => {H2} N HN. set My := fix f n := match n with | O => 1 | S n => Rmax (Rabs (INR (S n) / x * (y / x) ^ n)) (f n) end. exists (M * My N) => n. replace (INR (S n) * a (S n) * y ^ n) with ((a (S n) * x ^ (S n)) * (INR (S n) /x * (y / x) ^ n)) by (rewrite /pow -/pow ; apply Rminus_diag_uniq ; field_simplify ; [rewrite ?Rdiv_1 | apply Rgt_not_eq, Rlt_trans with y ; by apply Hy ] ; rewrite ?Rmult_assoc -(Rmult_minus_distr_l (a (S n))) ; apply Rmult_eq_0_compat_l ; rewrite Rmult_comm Rmult_assoc -(Rmult_minus_distr_l (INR (S n))) ; apply Rmult_eq_0_compat_l, Rminus_diag_eq ; elim: n => /= [ | n IH] ; [ring | rewrite -IH ; field ; apply Rgt_not_eq, Rlt_trans with y ; by apply Hy]). rewrite Rabs_mult ; apply Rmult_le_compat. by apply Rabs_pos. by apply Rabs_pos. by apply Hx. case: (le_lt_dec N n) => Hn. apply Rle_trans with 1. move: (HN n Hn) ; rewrite Rminus_0_r ; by apply Rlt_le. move: (HN n Hn) => {HN Hn} ; elim: N => [ | N IH] H2. simpl ; by apply Rle_refl. apply Rle_trans with (1 := IH H2) ; rewrite /My -/My ; by apply Rmax_r. elim: N n Hn {HN} => [ | N IH] n Hn. by apply Nat.nlt_0_r in Hn. apply le_S_n in Hn ; case: (le_lt_eq_dec _ _ Hn) => {} Hn. apply Rle_trans with (2 := Rmax_r _ (My N)) ; by apply IH. rewrite Hn ; by apply (Rmax_l _ (My N)). Qed. Lemma is_derive_PSeries (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> is_derive (PSeries a) x (PSeries (PS_derive a) x). Proof. move => Hx. case: (CV_radius_Reals_2 _ _ Hx) => r0 Hr0 ; rewrite -CV_radius_derive in Hx ; case: (CV_radius_Reals_2 _ _ Hx) => r1 Hr1 ; rewrite CV_radius_derive in Hx. apply CVU_dom_Reals in Hr0 ; apply CVU_dom_Reals in Hr1. have Hr : 0 < (Rmin r0 r1). apply Rmin_case. by apply r0. by apply r1. set D := (Boule x (mkposreal _ Hr)). assert (Ho : open D). move => y Hy. apply Rabs_lt_between' in Hy ; simpl in Hy. have H : 0 < Rmin ((x+Rmin r0 r1)-y) (y-(x-Rmin r0 r1)). apply Rmin_case. rewrite -(Rminus_eq_0 y) ; by apply Rplus_lt_compat_r, Hy. rewrite -(Rminus_eq_0 ((x-Rmin r0 r1))) /Rminus ; by apply Rplus_lt_compat_r , Hy. exists (mkposreal _ H) => /= z Hz. apply Rabs_lt_between' ; split ; apply (Rplus_lt_reg_l (-y)) ; simpl. apply Ropp_lt_cancel. apply Rle_lt_trans with (1 := Rabs_maj2 _). rewrite Ropp_plus_distr ?Ropp_involutive (Rplus_comm (-y)). apply Rlt_le_trans with (1 := Hz). exact: Rmin_r. apply Rle_lt_trans with (1 := Rle_abs _). rewrite ?(Rplus_comm (-y)). apply Rlt_le_trans with (1 := Hz). exact: Rmin_l. have Hc : is_connected D. move => x0 y z Hx0 Hy Hx0yz. rewrite /D. case: Hx0yz => H1 H2. apply (Rplus_le_compat_r (-x)) in H1. apply (Rplus_le_compat_r (-x)) in H2. move: (conj H1 H2) => {H1 H2} Hxyz. apply Rabs_le_between_Rmax in Hxyz. apply Rle_lt_trans with (1 := Hxyz) => /=. apply Rmax_case. apply Rle_lt_trans with (1 := Rle_abs _). exact: Hy. apply Rle_lt_trans with (1 := Rabs_maj2 _). exact: Hx0. have Hfn : CVU_dom (fun (n : nat) (y : R) => sum_f_R0 (fun k : nat => a k * y ^ k) n) D. apply CVU_dom_include with (Boule x r0). move => y Hy. by apply Rlt_le_trans with (1 := Hy), Rmin_l. exact: Hr0. have Idn : (forall (n : nat) (x : R), (0 < n)%nat -> is_derive (fun (y : R) => sum_f_R0 (fun k : nat => a k * y ^ k) n) x (sum_f_R0 (fun k : nat => (PS_derive a) k * x ^ k) (pred n))). case => [ y Hn | n y _ ]. by apply Nat.lt_irrefl in Hn. elim: n => [ | n] ; simpl pred ; rewrite /sum_f_R0 -/sum_f_R0. replace (PS_derive a 0 * y ^ 0) with (0 + a 1%nat * (1 * 1)) by (rewrite /PS_derive /= ; ring). apply: is_derive_plus. simpl. apply: is_derive_const. apply is_derive_scal. apply: is_derive_scal_l. apply: is_derive_id. move => IH. apply: is_derive_plus. apply IH. rewrite /PS_derive. replace (INR (S (S n)) * a (S (S n)) * y ^ S n) with (a (S (S n)) * (INR (S (S n)) * y^S n)) by ring. by apply is_derive_Reals, derivable_pt_lim_scal, derivable_pt_lim_pow. have Edn : (forall (n : nat) (x : R), D x -> ex_derive (fun (y : R) => sum_f_R0 (fun k : nat => a k * y ^ k) n) x). case => [ | n] y Hy. simpl. apply: ex_derive_const. exists (sum_f_R0 (fun k : nat => PS_derive a k * y ^ k) (pred (S n))). apply (Idn (S n) y). by apply Nat.lt_0_succ. have Cdn : (forall (n : nat) (x : R), D x -> continuity_pt (Derive ((fun (n0 : nat) (y : R) => sum_f_R0 (fun k : nat => a k * y ^ k) n0) n)) x). have Cdn : (forall (n : nat) (x : R), D x -> continuity_pt (fun x => sum_f_R0 (fun k : nat => PS_derive a k * x ^ k) n) x). move => n y Hy. apply derivable_continuous_pt. elim: n => [ /= | n IH]. exact: derivable_pt_const. apply derivable_pt_plus ; rewrite -/sum_f_R0. exact: IH. apply derivable_pt_scal, derivable_pt_pow. case => [ | n] y Hy. simpl ; by apply continuity_pt_const => z. move => e He ; case: (Cdn n y Hy e He) => {Cdn} d [Hd Cdn]. destruct (Ho y Hy) as [d0 Hd0]. have Hd1 : 0 < Rmin d d0. apply Rmin_case ; [exact: Hd | by apply d0]. exists (mkposreal _ Hd1) ; split. exact: Hd1. move => z Hz ; simpl in Hz. rewrite (is_derive_unique _ _ _ (Idn (S n) z (Nat.lt_0_succ _))). rewrite (is_derive_unique _ _ _ (Idn (S n) y (Nat.lt_0_succ _))). apply (Cdn z) ; split. by apply Hz. apply Rlt_le_trans with (1 := proj2 Hz), Rmin_l. have Hdn : CVU_dom (fun (n : nat) (x : R) => Derive ((fun (n0 : nat) (y : R) => sum_f_R0 (fun k : nat => a k * y ^ k) n0) n) x) D. apply CVU_dom_include with (Boule x r1). move => y Hy. by apply Rlt_le_trans with (1 := Hy), Rmin_r. apply CVU_dom_cauchy ; apply CVU_dom_cauchy in Hr1. move => eps. case: (Hr1 eps) => {Hr1} N Hr1. exists (S N) => n m y Hy Hn Hm. case: n Hn => [ | n] Hn. by apply Nat.nle_succ_0 in Hn. apply le_S_n in Hn. case: m Hm => [ | m] Hm. by apply Nat.nle_succ_0 in Hm. apply le_S_n in Hm. rewrite (is_derive_unique _ _ _ (Idn (S n) y (Nat.lt_0_succ _))). rewrite (is_derive_unique _ _ _ (Idn (S m) y (Nat.lt_0_succ _))). by apply Hr1. have Hx' : D x. by rewrite /D /Boule /= Rminus_eq_0 Rabs_R0. have H := (CVU_Derive (fun n y => (sum_f_R0 (fun k : nat => a k * y ^ k)) n) D Ho Hc Hfn Edn Cdn Hdn x Hx'). replace (PSeries (PS_derive a) x) with (real (Lim_seq (fun n : nat => Derive (fun y : R => sum_f_R0 (fun k : nat => a k * y ^ k) n) x))). apply: is_derive_ext H. simpl => t. apply (f_equal real), Lim_seq_ext. intros n; apply sym_eq, sum_n_Reals. rewrite -Lim_seq_incr_1. apply (f_equal real), Lim_seq_ext => n. rewrite sum_n_Reals. apply is_derive_unique, Idn. by apply Nat.lt_0_succ. move => y Hy. apply sym_eq. apply is_lim_seq_unique. apply is_lim_seq_spec. move => eps. case: (Hr1 eps (cond_pos eps)) => {Hr1} N Hr1. exists N => n Hn. rewrite -Rabs_Ropp Ropp_minus_distr'. by apply Hr1. move => y Hy. apply sym_eq. apply is_lim_seq_unique. apply is_lim_seq_spec. move => eps. case: (Hr0 eps (cond_pos eps)) => {Hr0} N Hr0. exists N => n Hn. rewrite -Rabs_Ropp Ropp_minus_distr'. by apply Hr0. move => y Hy. apply sym_eq. apply is_lim_seq_unique. apply is_lim_seq_spec. move => eps. case: (Hr1 eps (cond_pos eps)) => {Hr1} N Hr1. exists N => n Hn. rewrite -Rabs_Ropp Ropp_minus_distr'. by apply Hr1. Qed. Lemma ex_derive_PSeries (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> ex_derive (PSeries a) x. Proof. move => Hx ; exists (PSeries (PS_derive a) x). by apply is_derive_PSeries. Qed. Lemma Derive_PSeries (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> Derive (PSeries a) x = PSeries (PS_derive a) x. Proof. move => H. apply is_derive_unique. by apply is_derive_PSeries. Qed. Lemma is_pseries_derive (a : nat -> R) x : Rbar_lt (Rabs x) (CV_radius a) -> is_pseries (PS_derive a) x (Derive (PSeries a) x). Proof. intros Hx. assert (Ha := is_derive_PSeries _ _ Hx). apply is_derive_unique in Ha. rewrite Ha. apply PSeries_correct. by apply CV_radius_inside ; rewrite CV_radius_derive. Qed. Lemma ex_pseries_derive (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> ex_pseries (PS_derive a) x. Proof. move => Hx. eexists. by apply is_pseries_derive. Qed. Definition PS_derive_n (n : nat) (a : nat -> R) := (fun k => (INR (fact (k + n)%nat) / INR (fact k)) * a (k + n)%nat). Lemma is_derive_n_PSeries (n : nat) (a : nat -> R) : forall x, Rbar_lt (Rabs x) (CV_radius a) -> is_derive_n (PSeries a) n x (PSeries (PS_derive_n n a) x). Proof. elim: n => [ | n IH] x Hx. simpl ; rewrite /PS_derive_n /=. apply PSeries_ext => n. rewrite -plus_n_O. field. apply Rgt_not_eq. by apply INR_fact_lt_0. simpl ; rewrite /PS_derive_n /=. apply is_derive_ext_loc with (PSeries (fun k : nat => INR (fact (k + n)) / INR (fact k) * a (k + n)%nat)). case Ha : (CV_radius a) => [cva | | ]. move: (Hx) ; rewrite Ha ; move/Rminus_lt_0 => Hx0. exists (mkposreal _ Hx0) => /= y Hy. apply sym_eq. apply is_derive_n_unique. apply IH. rewrite Ha /=. replace y with ((y-x) + x) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). by apply Rlt_minus_r. exists (mkposreal _ Rlt_0_1) => /= y Hy. apply sym_eq. apply is_derive_n_unique. apply IH. by rewrite Ha /=. by rewrite Ha in Hx. evar (l : R). replace (PSeries _ x) with l. rewrite /l {l}. apply is_derive_PSeries. replace (CV_radius (fun k : nat => INR (fact (k + n)) / INR (fact k) * a (k + n)%nat)) with (CV_radius a). by apply Hx. elim: n {IH} => [ | n IH]. apply CV_radius_ext => n. rewrite -plus_n_O. field. apply Rgt_not_eq. by apply INR_fact_lt_0. rewrite IH. rewrite -CV_radius_derive. apply CV_radius_ext => k. rewrite /PS_derive. rewrite -plus_n_Sm plus_Sn_m /fact -/fact ?mult_INR ?S_INR. field. rewrite -S_INR ; split ; apply Rgt_not_eq. by apply INR_fact_lt_0. apply (lt_INR O), Nat.lt_0_succ. rewrite /l {l}. apply PSeries_ext. move => k ; rewrite /PS_derive. rewrite -plus_n_Sm plus_Sn_m /fact -/fact ?mult_INR ?S_INR. field. rewrite -S_INR ; split ; apply Rgt_not_eq. by apply INR_fact_lt_0. apply (lt_INR O), Nat.lt_0_succ. Qed. Lemma ex_derive_n_PSeries (n : nat) (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> ex_derive_n (PSeries a) n x. Proof. elim: n a x => [ | n IH] a x Hx. by simpl. simpl. exists (PSeries (PS_derive_n (S n) a) x). by apply (is_derive_n_PSeries (S n)). Qed. Lemma Derive_n_PSeries (n : nat) (a : nat -> R) (x : R) : Rbar_lt (Finite (Rabs x)) (CV_radius a) -> Derive_n (PSeries a) n x = PSeries (PS_derive_n n a) x. Proof. move => H. apply is_derive_n_unique. by apply is_derive_n_PSeries. Qed. Lemma CV_radius_derive_n (n : nat) (a : nat -> R) : CV_radius (PS_derive_n n a) = CV_radius a. Proof. elim: n a => [ | n IH] /= a. apply CV_radius_ext. move => k ; rewrite /PS_derive_n /=. rewrite Nat.add_0_r ; field. by apply INR_fact_neq_0. rewrite -(CV_radius_derive a). rewrite -(IH (PS_derive a)). apply CV_radius_ext. move => k ; rewrite /PS_derive_n /PS_derive. rewrite -plus_n_Sm /fact -/fact mult_INR ; field. by apply INR_fact_neq_0. Qed. (** Coefficients *) Lemma Derive_n_coef (a : nat -> R) (n : nat) : Rbar_lt (Finite 0) (CV_radius a) -> Derive_n (PSeries a) n 0 = a n * (INR (fact n)). Proof. elim: n a => [ | n IH] a Ha. rewrite Rmult_1_r. rewrite /= /PSeries /Series -(Lim_seq_ext (fun _ => a O)). by rewrite Lim_seq_const. elim => /= [ | n IH]. rewrite sum_O ; ring. rewrite sum_Sn -IH /plus /= ; ring. simpl Derive_n. replace (Derive (Derive_n (PSeries a) n) 0) with (Derive_n (PSeries (PS_derive a)) n 0). rewrite IH. rewrite /fact -/fact mult_INR /PS_derive ; ring. by rewrite CV_radius_derive. transitivity (Derive_n (Derive (PSeries a)) n 0). apply Derive_n_ext_loc. case: (Rbar_eq_dec (CV_radius a) p_infty) => H. exists (mkposreal _ Rlt_0_1) => /= x Hx. apply sym_eq ; apply Derive_PSeries. by rewrite H. have Hc : 0 < real (CV_radius a). case: (CV_radius a) Ha H => /= [c | | ] Ha H ; by []. exists (mkposreal _ Hc) => /= x Hx. apply sym_eq ; apply Derive_PSeries. case: (CV_radius a) Hx Ha => /= [c | | ] Hx Ha //. by rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= -/(Rminus _ _) Rminus_0_r in Hx. move: (Derive_n_comp (PSeries a) n 1%nat 0) => /= ->. by replace (n+1)%nat with (S n) by ring. Qed. Lemma PSeries_ext_recip (a b : nat -> R) (n : nat) : Rbar_lt (Finite 0) (CV_radius a) -> Rbar_lt (Finite 0) (CV_radius b) -> locally 0 (fun x => PSeries a x = PSeries b x) -> a n = b n. Proof. move => Ha Hb Hab. have H : a n * (INR (fact n)) = b n * (INR (fact n)). rewrite -?Derive_n_coef => //. by apply Derive_n_ext_loc. replace (a n) with ((a n * INR (fact n)) / (INR (fact n))). rewrite H ; field ; exact: INR_fact_neq_0. field ; exact: INR_fact_neq_0. Qed. Lemma mk_pseries (f : R -> R) (M : R) (r : Rbar) : (forall n x, Rbar_lt (Finite (Rabs x)) r -> (ex_derive_n f n x) /\ Rabs (Derive_n f n x) <= M) -> forall x, Rbar_lt (Finite (Rabs x)) r -> is_pseries (fun n => Derive_n f n 0 / INR (fact n)) x (f x). Proof. move => Hd x Hx. wlog: r Hx Hd /(Finite (real r) = r) => [Hw | Hr]. case: r Hx Hd => /= [r | | ] Hx Hd. by apply (Hw (Finite r)). apply (Hw (Finite (Rabs x+1))). simpl ; exact: Rlt_plus_1. move => n y Hy ; by apply Hd. by []. by []. rewrite -Hr in Hx Hd. move: (real r) Hx Hd => /= {Hr} r Hx Hd. wlog: x Hx f Hd / (0 < x) => [Hw | Hx']. case: (total_order_T 0 x) => Hx'. case: Hx' => Hx'. by apply Hw. rewrite -Hx'. replace (f 0) with (Derive_n f O 0 / INR (fact O)) by (simpl ; field). apply @is_pseries_0. rewrite -Rabs_Ropp in Hx. suff Hf : (forall (n : nat) (x : R), ((Rabs x)) < r -> ex_derive_n (fun x0 : R => f (- x0)) n x /\ Rabs (Derive_n (fun x0 : R => f (- x0)) n x) <= M). move: (Hw _ Hx (fun x => f (-x)) Hf (Ropp_0_gt_lt_contravar _ Hx')) => {} Hw. rewrite Ropp_involutive in Hw. apply is_series_ext with (2:=Hw). intros n; rewrite Derive_n_comp_opp; simpl. rewrite /scal /= /mult /=. apply trans_eq with ((pow_n (K := R_AbsRing) (- x) n * (-1) ^ n) * (Derive_n f n (- 0) / INR (fact n)));[unfold Rdiv; ring|idtac]. rewrite Ropp_0. apply f_equal2; try reflexivity. clear; induction n; simpl. apply Rmult_1_l. rewrite /mult /=. rewrite <- IHn; ring. rewrite Ropp_0 ; exists (mkposreal r (Rle_lt_trans _ _ _ (Rabs_pos _) Hx)) => /= y Hy k Hk. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= -/(Rminus _ _) Rminus_0_r in Hy. by apply (Hd k). move => {x Hx Hx'} n x Hx. rewrite Derive_n_comp_opp. split. apply ex_derive_n_comp_opp. apply Rabs_lt_between in Hx. case: Hx => Hx1 Hx2. apply Rminus_lt_0 in Hx1. apply Rminus_lt_0 in Hx2. have Hx := Rmin_pos _ _ Hx1 Hx2 => {Hx1 Hx2}. exists (mkposreal _ Hx) => /= y Hy k Hk. rewrite /ball /= /AbsRing_ball /= in Hy. apply Rabs_lt_between' in Hy. rewrite /Rminus -Rmax_opp_Rmin Rplus_max_distr_l Rplus_min_distr_l in Hy. case: Hy => Hy1 Hy2. apply Rle_lt_trans with (1 := Rmax_r _ _) in Hy1. ring_simplify in Hy1. apply Rlt_le_trans with (2 := Rmin_l _ _) in Hy2. ring_simplify in Hy2. apply (Hd k y). apply Rabs_lt_between. by split. rewrite Rabs_mult -RPow_abs Rabs_Ropp Rabs_R1 pow1 Rmult_1_l. apply Hd. by rewrite Rabs_Ropp. apply Rabs_lt_between in Hx. case: Hx => Hx1 Hx2. apply Rminus_lt_0 in Hx1. apply Rminus_lt_0 in Hx2. have Hx := Rmin_pos _ _ Hx1 Hx2 => {Hx1 Hx2}. exists (mkposreal _ Hx) => /= y Hy k Hk. rewrite /ball /= /AbsRing_ball /= in Hy. apply Rabs_lt_between' in Hy. rewrite /Rminus -Rmax_opp_Rmin Rplus_max_distr_l Rplus_min_distr_l in Hy. case: Hy => Hy1 Hy2. apply Rle_lt_trans with (1 := Rmax_r _ _) in Hy1. ring_simplify in Hy1. apply Rlt_le_trans with (2 := Rmin_l _ _) in Hy2. ring_simplify in Hy2. apply (Hd k y). apply Rabs_lt_between. by split. move => P [eps Heps]. have : exists N, forall n, (N <= n)%nat -> r ^ (S n) * M / INR (fact (S n)) < eps. have H : is_lim_seq (fun n => r ^ n * M / INR (fact n)) 0. case: (Rlt_dec 0 M) => H. have H0 : forall n : nat, 0 < r ^ n * M / INR (fact n). move => n. apply Rdiv_lt_0_compat. apply Rmult_lt_0_compat. apply pow_lt. apply Rle_lt_trans with (2 := Hx), Rabs_pos. exact: H. exact: INR_fact_lt_0. apply ex_series_lim_0, ex_series_Rabs, ex_series_DAlembert with 0. exact: Rlt_0_1. move => n ; apply Rgt_not_eq, Rlt_gt, H0. apply is_lim_seq_ext with (fun n => r / INR (S n)). move => n ; rewrite Rabs_pos_eq. rewrite /fact -/fact /pow -/pow ?mult_INR ; field. repeat split ; apply Rgt_not_eq, Rlt_gt. exact: INR_fact_lt_0. by apply (lt_INR O), Nat.lt_0_succ. exact: H. apply pow_lt, Rle_lt_trans with (Rabs x), Hx ; by apply Rabs_pos. apply Rlt_le, Rdiv_lt_0_compat ; by apply H0. rewrite -(Rmult_0_r r) ; apply (is_lim_seq_scal_l _ _ 0) => //. apply (is_lim_seq_incr_1 (fun n => / INR n)). replace (Finite 0) with (Rbar_inv p_infty) by auto. apply is_lim_seq_inv. by apply is_lim_seq_INR. by []. apply Rnot_lt_le in H ; case: H => H. contradict H. apply Rle_not_lt. apply Rle_trans with (Rabs (Derive_n f O x)). by apply Rabs_pos. by apply Hd. rewrite H. apply is_lim_seq_ext with (fun _ => 0). move => n ; rewrite /Rdiv ; ring. exact: is_lim_seq_const. apply is_lim_seq_incr_1 in H. apply is_lim_seq_spec in H. case: (H eps) => {H} N H. exists N => n Hn. apply Rle_lt_trans with (2 := H n Hn). rewrite Rminus_0_r. exact: Rle_abs. case => N HN. exists N => n Hn. apply Heps. case: (Taylor_Lagrange f n 0 x). by apply Hx'. move => t Ht k Hk. apply Hd. rewrite Rabs_right. apply Rle_lt_trans with (1 := proj2 Ht). by apply Rle_lt_trans with (1 := Rle_abs _), Hx. by apply Rle_ge, Ht. move => y [Hy ->]. rewrite Rminus_0_r. rewrite (sum_n_ext _ (fun m : nat => x ^ m / INR (fact m) * Derive_n f m 0)). rewrite sum_n_Reals. apply Rle_lt_trans with (2 := HN n Hn). replace (r ^ S n * M / INR (fact (S n))) with ((r^S n / INR (fact (S n))) * M) by (rewrite /Rdiv ; ring). change minus with Rminus. ring_simplify (sum_f_R0 (fun m : nat => x ^ m / INR (fact m) * Derive_n f m 0) n - (sum_f_R0 (fun m : nat => x ^ m / INR (fact m) * Derive_n f m 0) n + x ^ S n / INR (fact (S n)) * Derive_n f (S n) y)). change abs with Rabs. rewrite Rabs_mult Rabs_Ropp. apply Rmult_le_compat. by apply Rabs_pos. by apply Rabs_pos. rewrite Rabs_div. apply Rmult_le_compat. apply Rabs_pos. apply Rlt_le, Rinv_0_lt_compat. apply Rabs_pos_lt. exact: INR_fact_neq_0. rewrite -RPow_abs. apply pow_incr ; split. apply Rabs_pos. by apply Rlt_le. apply Rle_Rinv. exact: (INR_fact_lt_0 (S n)). apply Rabs_pos_lt, INR_fact_neq_0. apply Rle_abs. apply INR_fact_neq_0. apply Hd. apply Rlt_trans with (2 := Hx). rewrite ?Rabs_pos_eq. by apply Hy. apply Rlt_le, Hx'. apply Rlt_le, Hy. intros m; rewrite pow_n_pow. rewrite /scal /= /mult /= /Rdiv ; ring. Qed. coquelicot-coquelicot-3.4.1/theories/RInt.v000066400000000000000000005167021455143432500207410ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2017 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz. From mathcomp Require Import ssreflect ssrbool ssrfun eqtype seq. Require Import Markov Rcomplements Rbar Lub Lim_seq SF_seq Continuity Hierarchy. Local Tactic Notation "intuition" := (intuition auto with arith zarith real rorders). (** This file contains the definition and properties of the Riemann integral, defined on a normed module on [R]. For real functions, a total function [RInt] is available. *) Section is_RInt. (** * Definition of Riemann integral *) Context {V : NormedModule R_AbsRing}. Definition is_RInt (f : R -> V) (a b : R) (If : V) := filterlim (fun ptd => scal (sign (b-a)) (Riemann_sum f ptd)) (Riemann_fine a b) (locally If). Definition ex_RInt (f : R -> V) (a b : R) := exists If : V, is_RInt f a b If. (** ** Usual properties *) (** The integral between a and a is null *) Lemma is_RInt_point : forall (f : R -> V) (a : R), is_RInt f a a zero. Proof. intros f a. apply filterlim_locally. move => eps ; exists (mkposreal _ Rlt_0_1) => ptd _ [Hptd [Hh Hl]]. rewrite Riemann_sum_zero. rewrite scal_zero_r. by apply ball_center. by apply ptd_sort. move: Hl Hh ; rewrite /Rmin /Rmax ; by case: Rle_dec (Rle_refl a) => _ _ ->. Qed. Lemma ex_RInt_point : forall (f : R -> V) a, ex_RInt f a a. Proof. intros f a. exists zero ; by apply is_RInt_point. Qed. (** Swapping bounds *) Lemma is_RInt_swap : forall (f : R -> V) (a b : R) (If : V), is_RInt f b a If -> is_RInt f a b (opp If). Proof. unfold is_RInt. intros f a b If HIf. rewrite -scal_opp_one /=. apply filterlim_ext with (fun ptd => scal (opp (one : R)) (scal (sign (a - b)) (Riemann_sum f ptd))). intros x. rewrite scal_assoc. apply (f_equal (fun s => scal s _)). rewrite /mult /opp /one /=. by rewrite -(Ropp_minus_distr' b a) sign_opp /= Ropp_mult_distr_l_reverse Rmult_1_l. unfold Riemann_fine. rewrite Rmin_comm Rmax_comm. apply filterlim_comp with (1 := HIf). apply: filterlim_scal_r. Qed. Lemma ex_RInt_swap : forall (f : R -> V) (a b : R), ex_RInt f a b -> ex_RInt f b a. Proof. intros f a b. case => If HIf. exists (opp If). now apply is_RInt_swap. Qed. (** Integrable implies bounded *) Lemma ex_RInt_ub (f : R -> V) (a b : R) : ex_RInt f a b -> exists M : R, forall t : R, Rmin a b <= t <= Rmax a b -> norm (f t) <= M. Proof. wlog: a b / (a < b) => [ Hw | Hab ] Hex. case: (Rle_lt_dec a b) => Hab. case: Hab => Hab. by apply Hw. rewrite /Rmin /Rmax ; case: Rle_dec (Req_le _ _ Hab) => // _ _ ; rewrite -Hab. exists (norm (f a)) => t Ht ; replace t with a. exact: Rle_refl. apply Rle_antisym ; by case: Ht. rewrite Rmin_comm Rmax_comm ; apply ex_RInt_swap in Hex ; by apply Hw. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. case: Hex => If Hex. generalize (proj1 (filterlim_locally_ball_norm _ If) Hex) => {Hex} /= Hex. case: (Hex (mkposreal _ Rlt_0_1)) => {Hex} alpha Hex. have Hn : 0 <= ((b-a)/alpha). apply Rdiv_le_0_compat. apply -> Rminus_le_0 ; apply Rlt_le, Hab. by apply alpha. set n := (nfloor _ Hn). set ptd := fun (g : R -> R -> R) => SF_seq_f2 g (unif_part a b n). assert (forall g, pointed_subdiv (ptd g) -> norm (minus (Riemann_sum f (ptd g)) If) < 1). move => g Hg ; replace (Riemann_sum f (ptd g)) with (scal (sign (b - a)) (Riemann_sum f (ptd g))). apply Hex. apply Rle_lt_trans with ((b-a)/(INR n + 1)). clearbody n ; rewrite SF_lx_f2. replace (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n) by auto. suff : forall i, (S i < size (unif_part a b n))%nat -> nth 0 (unif_part a b n) (S i) - nth 0 (unif_part a b n) i = (b-a)/(INR n + 1). elim: (unif_part a b n) => [ /= _ | x0]. apply Rdiv_le_0_compat ; [ by apply Rlt_le, Rgt_minus | by intuition ]. case => /= [ | x1 s] IH Hnth. apply Rdiv_le_0_compat ; [ by apply Rlt_le, Rgt_minus | by intuition ]. replace (seq_step _) with (Rmax (Rabs (x1 - x0)) (seq_step (x1 :: s))) by auto. apply Rmax_case_strong => _. rewrite (Hnth O (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))) Rabs_right. exact: Rle_refl. apply Rle_ge, Rdiv_le_0_compat ; [ by apply Rlt_le, Rgt_minus | by intuition ]. apply IH => i Hi ; exact: (Hnth (S i) ((proj1 (Nat.succ_lt_mono _ _)) Hi)). rewrite size_mkseq => i Hi. rewrite ?nth_mkseq ?S_INR ; try apply SSR_leq. field ; apply Rgt_not_eq ; by intuition. exact: Nat.lt_le_incl. exact: Hi. by apply Nat.lt_0_succ. apply Rlt_div_l. by apply INRp1_pos. rewrite Rmult_comm ; apply Rlt_div_l. by apply alpha. rewrite /n /nfloor ; case: nfloor_ex => /= n' Hn'. by apply Hn'. split. apply Hg. rewrite -> Rmin_left, Rmax_right by now apply Rlt_le. split. apply head_unif_part. clearbody n ; rewrite /Rmax -nth_last SF_lx_f2. rewrite size_mkseq nth_mkseq ?S_INR //. field ; apply Rgt_not_eq ; by intuition. by apply Nat.lt_0_succ. rewrite -> sign_eq_1 by exact: Rlt_Rminus. exact: scal_one. move: H => {} Hex. assert (exists M, forall g : R -> R -> R, pointed_subdiv (ptd g) -> norm (Riemann_sum f (ptd g)) <= M). exists (norm If + 1) ; move => g Hg. replace (Riemann_sum f (ptd g)) with (plus (minus (Riemann_sum f (ptd g)) If) If). apply Rle_trans with (norm (minus (Riemann_sum f (ptd g)) If) + norm If). by generalize (norm_triangle (minus (Riemann_sum f (ptd g)) If) If). rewrite Rplus_comm. apply Rplus_le_compat_l. apply Rlt_le. by apply Hex. by rewrite /minus -plus_assoc plus_opp_l plus_zero_r. clearbody n ; move: H => {} Hex. assert (forall i, (S i < size (unif_part a b n))%nat -> exists M, forall t, nth 0 (unif_part a b n) i <= t <= nth 0 (unif_part a b n) (S i) -> norm (f t) <= M). move => i ; revert ptd Hex. have : sorted Rlt (unif_part a b n). apply sorted_nth => j Hj x0. rewrite size_mkseq /= in Hj. rewrite ?nth_mkseq ?S_INR /= ; try apply SSR_leq. apply Rminus_gt ; field_simplify. rewrite Rplus_comm ?Rdiv_1 ; apply Rdiv_lt_0_compat. exact: Rgt_minus. by intuition. apply Rgt_not_eq ; by intuition. by intuition. by intuition. elim: (unif_part a b n) i => [ /= i _ _ Hi | x0]. by apply Nat.nlt_0_r in Hi. case => [ /= _ i _ _ Hi | x1 s IH]. by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. case => [ | i] Hlt /= Hex Hi. assert (exists M, forall t g, x0 <= t <= x1 -> pointed_subdiv (SF_seq_f2 g [:: x1 & s]) -> norm (plus (scal (x1 - x0) (f t)) (Riemann_sum f (SF_seq_f2 g [:: x1 & s]))) <= M). case: (Hex) => M Hex'. exists M ; move => t g Ht Hg. set g0 := fun x y => match Req_EM_T x x0 with | left _ => t | right _ => g x y end. replace (plus (scal (x1 - x0) (f t)) (Riemann_sum f (SF_seq_f2 g (x1 :: s)))) with (Riemann_sum f (SF_seq_f2 g0 [:: x0, x1 & s])). apply Hex'. case => [ | j] Hj ; rewrite SF_size_f2 /= in Hj ; rewrite SF_ly_f2 SF_lx_f2 /=. 2: apply Nat.lt_0_succ. rewrite /g0. by case: Req_EM_T (refl_equal x0). rewrite (nth_pairmap 0). rewrite /g0. suff : (nth 0 (x1 :: s) j) <> x0. case: Req_EM_T => // _ _. move: (Hg j). rewrite SF_size_f2 ; rewrite SF_ly_f2 SF_lx_f2 /=. 2: apply Nat.lt_0_succ. rewrite (nth_pairmap 0). move => Hg' ; by apply Hg', Nat.succ_lt_mono. apply SSR_leq ; by intuition. apply Rgt_not_eq. apply Nat.succ_lt_mono in Hj. elim: j Hj => {IH} [ | j IH] Hj. by apply Hlt. apply Rlt_trans with (nth 0 (x1 :: s) j). apply IH ; by intuition. apply (sorted_nth Rlt). by apply Hlt. by intuition. apply SSR_leq ; by intuition. by apply Nat.lt_0_succ. rewrite SF_cons_f2 /=. rewrite Riemann_sum_cons /=. apply f_equal2. apply f_equal. rewrite /g0. by case: Req_EM_T (refl_equal x0). case: s Hlt {IH Hex Hex' Hi Hg} => [ | x2 s] Hlt. reflexivity. rewrite !(SF_cons_f2 _ x1) /=. rewrite !Riemann_sum_cons /=. apply f_equal2. apply f_equal. rewrite /g0. by case: Req_EM_T (Rgt_not_eq _ _ (proj1 Hlt)). elim: s x2 Hlt => [ | x3 s IH] x2 Hlt. reflexivity. rewrite !(SF_cons_f2 _ x2) /=. rewrite !Riemann_sum_cons /=. apply f_equal2. apply f_equal. rewrite /g0. by case: Req_EM_T (Rgt_not_eq _ _ (Rlt_trans _ _ _ (proj1 Hlt) (proj1 (proj2 Hlt)))). apply IH. split. by apply Hlt. split. apply Rlt_trans with x2 ; by apply Hlt. by apply Hlt. by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. move: H => {} Hex. case: (Hex) => M Hex'. exists ((M + norm (Riemann_sum f (SF_seq_f2 (fun x y => x) (x1 :: s)))) / abs (x1 - x0)). move => t Ht. have Hg : pointed_subdiv (SF_seq_f2 (fun x y : R => x) (x1 :: s)). move => j ; rewrite SF_size_f2 SF_lx_f2. rewrite SF_ly_f2 /= => Hj. rewrite (nth_pairmap 0). split. apply Rle_refl. apply Rlt_le, (sorted_nth Rlt (x1::s)). by apply Hlt. by []. apply SSR_leq ; by intuition. apply Nat.lt_0_succ. specialize (Hex' _ _ Ht Hg). rewrite -(scal_one (f t)). rewrite /one /= -(Rinv_l (x1 - x0)). 2: by apply Rgt_not_eq, Rgt_minus, Hlt. rewrite -scal_assoc. eapply Rle_trans ; try apply @norm_scal. rewrite Rmult_comm. rewrite /abs /= Rabs_Rinv. 2: by apply Rgt_not_eq, Rgt_minus, Hlt. apply Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat. apply Rabs_pos_lt, Rgt_not_eq. by apply Rgt_minus, Hlt. set v:= scal _ _. replace v with (minus (plus (scal (x1 - x0) (f t)) (Riemann_sum f (SF_seq_f2 (fun x _ : R => x) (x1 :: s)))) (Riemann_sum f (SF_seq_f2 (fun x _ : R => x) (x1 :: s)))). rewrite /minus. apply Rle_trans with (norm (plus (scal (x1 - x0) (f t)) (Riemann_sum f (SF_seq_f2 (fun x _ : R => x) (x1 :: s)))) + norm (opp (Riemann_sum f (SF_seq_f2 (fun x _ : R => x) (x1 :: s))))). by generalize (norm_triangle (plus (scal (x1 - x0) (f t)) (Riemann_sum f (SF_seq_f2 (fun x _ : R => x) (x1 :: s)))) (opp (Riemann_sum f (SF_seq_f2 (fun x _ : R => x) (x1 :: s))))). rewrite norm_opp. apply Rplus_le_compat_r. apply Hex'. rewrite /minus -plus_assoc plus_opp_r. by apply plus_zero_r. apply IH. by apply Hlt. case: Hex => M Hex. exists ((M + norm (scal (x1 - x0) (f x0)))) => g Hg. set g0 := fun x y => match Req_EM_T x x0 with | left _ => x0 | right _ => g x y end. have Hg0 : pointed_subdiv (SF_seq_f2 g0 (x0::x1 :: s)). move => j ; rewrite SF_size_f2 SF_lx_f2. 2: apply Nat.lt_0_succ. rewrite SF_ly_f2 => Hj. rewrite nth_behead (nth_pairmap 0) /=. case: j Hj => /= [ | j ] Hj. rewrite /g0. case: Req_EM_T (refl_equal x0) => // _ _. split. exact: Rle_refl. by apply Rlt_le, Hlt. suff : (nth 0 (x1 :: s) j) <> x0. rewrite /g0 ; case: Req_EM_T => // _ _. move: (Hg j). rewrite SF_size_f2 SF_lx_f2. 2: apply Nat.lt_0_succ. rewrite SF_ly_f2 /= => {} Hg. move: (Hg (proj2 (Nat.succ_lt_mono _ _) Hj)) ; rewrite (nth_pairmap 0). by []. apply SSR_leq ; by intuition. apply Rgt_not_eq. elim: j Hj => {IH} /= [ | j IH] Hj. by apply Hlt. apply Rlt_trans with (nth 0 (x1 :: s) j). apply IH ; by intuition. apply (sorted_nth Rlt (x1::s)). by apply Hlt. by intuition. apply SSR_leq ; by intuition. replace (Riemann_sum f (SF_seq_f2 g (x1 :: s))) with (minus (Riemann_sum f (SF_seq_f2 g0 (x0::x1::s))) (scal (x1 - x0) (f x0))). apply Rle_trans with (norm (Riemann_sum f (SF_seq_f2 g0 [:: x0, x1 & s])) + norm (opp (scal (x1 - x0) (f x0)))). by generalize (norm_triangle (Riemann_sum f (SF_seq_f2 g0 [:: x0, x1 & s])) (opp (scal (x1 - x0) (f x0)))). rewrite norm_opp. apply Rplus_le_compat_r, (Hex _ Hg0). rewrite /minus plus_comm SF_cons_f2 /=. rewrite Riemann_sum_cons /= plus_assoc. replace (Riemann_sum f (SF_seq_f2 g0 (x1 :: s))) with (Riemann_sum f (SF_seq_f2 g (x1 :: s))). replace (g0 x0 x1) with x0. by rewrite plus_opp_l plus_zero_l. rewrite /g0 ; case: Req_EM_T (refl_equal x0) => //. elim: s x1 Hlt {IH Hex Hg Hg0 Hi} => [ | x2 s IH] x1 Hlt. reflexivity. rewrite !(SF_cons_f2 _ x1) /=. rewrite !Riemann_sum_cons /=. apply f_equal2. rewrite /g0 ; by case: Req_EM_T (Rgt_not_eq _ _ (proj1 Hlt)). apply IH. split. apply Rlt_trans with x1 ; by apply Hlt. by apply Hlt. exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. exact: (proj2 (Nat.succ_lt_mono _ _)). move:H => {} Hex. replace b with (last 0 (unif_part a b n)). pattern a at 1 ; replace a with (head 0 (unif_part a b n)). elim: (unif_part a b n) Hex => /= [ | x0]. exists (norm (f 0)) => t Ht ; rewrite (Rle_antisym t 0) ; by intuition. case => /= [ | x1 s] IH Hex. exists (norm (f x0)) => t Ht ; rewrite (Rle_antisym t x0) ; by intuition. case: (Hex _ (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))) => /= M0 H0. case: IH => [ | M IH]. move => i Hi ; case: (Hex _ (proj1 (Nat.succ_lt_mono _ _) Hi)) => {Hex} /= M Hex. by exists M. exists (Rmax M0 M) => t Ht ; case: (Rlt_le_dec t x1) => Ht0. apply Rle_trans with (2 := RmaxLess1 _ _) ; apply H0 ; by intuition. apply Rle_trans with (2 := RmaxLess2 _ _) ; apply IH ; by intuition. apply head_unif_part. apply last_unif_part. Qed. (** Extensionality *) Lemma is_RInt_ext : forall (f g : R -> V) (a b : R) (l : V), (forall x, Rmin a b < x < Rmax a b -> f x = g x) -> is_RInt f a b l -> is_RInt g a b l. Proof. intros f g a b. wlog: a b / (a < b) => [Hw | Hab] l Heq Hf. case: (Rle_lt_dec a b) => Hab. case: Hab => Hab. by apply Hw. rewrite -Hab in Hf |- *. move: Hf ; apply filterlim_ext => x. by rewrite Rminus_eq_0 sign_0 !scal_zero_l. rewrite -(opp_opp l). apply is_RInt_swap. apply Hw. by []. by rewrite Rmin_comm Rmax_comm. by apply is_RInt_swap. move: Heq ; rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ Heq. apply filterlim_locally_ball_norm => eps. destruct (proj1 (filterlim_locally_ball_norm _ _) Hf (pos_div_2 eps)) as [d Hd]. set dx := fun x => pos_div_2 (pos_div_2 eps) / Rmax 1 (norm (minus (g x) (f x))). assert (forall x, 0 < dx x). intros x. apply Rdiv_lt_0_compat. apply is_pos_div_2. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. assert (Hdelta : 0 < Rmin d (Rmin (dx a) (dx b))). repeat apply Rmin_case => //. by apply d. exists (mkposreal _ Hdelta) => /= y Hstep [Hptd [Hya Hyb]]. rewrite (double_var eps). eapply ball_norm_triangle. apply Hd. eapply Rlt_le_trans, Rmin_l. by apply Hstep. split => //. have: (seq_step (SF_lx y) < (Rmin (dx a) (dx b))) => [ | {} Hstep]. eapply Rlt_le_trans, Rmin_r. by apply Hstep. clear d Hd Hdelta Hf. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite !scal_one. move: Hya Hyb ; rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ Hya Hyb. move: Hab Heq Hstep ; rewrite -Hyb => {b Hyb} ; set b := last (SF_h y) (unzip1 (SF_t y)) ; rewrite -Hya => {a Hya} ; set a := SF_h y => Hab Heq Hstep. (* *) revert a b Hab Heq Hptd Hstep ; apply SF_cons_ind with (s := y) => {y} [x0 | x0 y IH] a b Hab Heq Hptd Hstep. rewrite !Riemann_sum_zero //. by apply (ball_norm_center _ (pos_div_2 eps)). rewrite !Riemann_sum_cons. assert (Hx0 := proj1 (ptd_sort _ Hptd)). case: Hx0 => /= Hx0. 2 : { (* fst x0 = SF_h y *) rewrite Hx0 Rminus_eq_0 !scal_zero_l !plus_zero_l. apply: IH. move: Hab ; unfold a, b ; simpl ; by rewrite Hx0. intros x Hx. apply Heq ; split. unfold a ; simpl ; rewrite Hx0 ; apply Hx. unfold b ; simpl ; apply Hx. eapply ptd_cons, Hptd. move: Hstep ; unfold a, b ; simpl ; rewrite Hx0. apply Rle_lt_trans, Rmax_r. } (* fst x0 < SF_h y *) clear IH. rewrite (double_var (eps / 2)). eapply Rle_lt_trans, Rplus_lt_compat. eapply Rle_trans, norm_triangle. apply Req_le, f_equal. replace (@minus V _ _) with (plus (scal (SF_h y - fst x0) (minus (g (snd x0)) (f (snd x0)))) (minus (Riemann_sum g y) (Riemann_sum f y))). by []. rewrite /minus opp_plus scal_distr_l -scal_opp_r -!plus_assoc. apply f_equal. rewrite !plus_assoc ; apply f_equal2 => //. by apply plus_comm. eapply Rle_lt_trans. apply @norm_scal. assert (Ha := proj1 (Hptd O (Nat.lt_0_succ _))). case: Ha => /= Ha. assert (Hb : snd x0 <= b). eapply Rle_trans, sorted_last. 2: apply ptd_sort. 2: eapply ptd_cons, Hptd. 2: apply Nat.lt_0_succ. simpl. apply (Hptd O), Nat.lt_0_succ. case: Hb => //= Hb. rewrite Heq. rewrite minus_eq_zero norm_zero Rmult_0_r. apply (is_pos_div_2 (pos_div_2 eps)). by split. rewrite Hb. eapply Rle_lt_trans. apply Rmult_le_compat_l, (Rmax_r 1). by apply abs_ge_0. apply Rlt_div_r. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. rewrite -/(dx b). eapply Rlt_le_trans, Rmin_r. eapply Rle_lt_trans, Hstep. by apply Rmax_l. rewrite -Ha. eapply Rle_lt_trans. apply Rmult_le_compat_l, (Rmax_r 1). by apply abs_ge_0. apply Rlt_div_r. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. rewrite -/(dx a). eapply Rlt_le_trans, Rmin_l. eapply Rle_lt_trans, Hstep. by apply Rmax_l. have: (forall x : R, SF_h y <= x < b -> f x = g x) => [ | {} Heq]. intros. apply Heq ; split. by eapply Rlt_le_trans, H0. by apply H0. have: (seq_step (SF_lx y) < (dx b)) => [ | {} Hstep]. eapply Rlt_le_trans, Rmin_r. eapply Rle_lt_trans, Hstep. apply Rmax_r. simpl in b. apply ptd_cons in Hptd. clear a Hab x0 Hx0. revert b Heq Hptd Hstep ; apply SF_cons_ind with (s := y) => {y} [x0 | x0 y IH] b Heq Hptd Hstep. rewrite !Riemann_sum_zero // minus_eq_zero norm_zero. apply (is_pos_div_2 (pos_div_2 _)). rewrite !Riemann_sum_cons. replace (minus (plus (scal (SF_h y - fst x0) (g (snd x0))) (Riemann_sum g y)) (plus (scal (SF_h y - fst x0) (f (snd x0))) (Riemann_sum f y))) with (plus (scal (SF_h y - fst x0) (minus (g (snd x0)) (f (snd x0)))) (minus (Riemann_sum g y) (Riemann_sum f y))). eapply Rle_lt_trans. apply @norm_triangle. assert (SF_h y <= b). eapply Rle_trans, sorted_last. 2: apply ptd_sort ; eapply ptd_cons, Hptd. 2: apply Nat.lt_0_succ. simpl ; by apply Rle_refl. case: H0 => Hb. rewrite Heq. rewrite minus_eq_zero scal_zero_r norm_zero Rplus_0_l. apply IH ; intros. apply Heq ; split. eapply Rle_trans, H0. eapply Rle_trans ; by apply (Hptd O (Nat.lt_0_succ _)). by apply H0. eapply ptd_cons, Hptd. eapply Rle_lt_trans, Hstep. by apply Rmax_r. split. apply (Hptd O (Nat.lt_0_succ _)). eapply Rle_lt_trans, Hb. apply (Hptd O (Nat.lt_0_succ _)). clear IH. rewrite Hb !Riemann_sum_zero //. rewrite minus_eq_zero norm_zero Rplus_0_r. eapply Rle_lt_trans. apply @norm_scal. assert (snd x0 <= b). rewrite -Hb. apply (Hptd O (Nat.lt_0_succ _)). case: H0 => Hb'. rewrite Heq. rewrite minus_eq_zero norm_zero Rmult_0_r. apply (is_pos_div_2 (pos_div_2 _)). split. apply (Hptd O (Nat.lt_0_succ _)). by []. rewrite Hb'. eapply Rle_lt_trans. apply Rmult_le_compat_l. apply abs_ge_0. apply (Rmax_r 1). apply Rlt_div_r. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. eapply Rle_lt_trans, Hstep. rewrite -Hb. by apply Rmax_l. apply ptd_sort ; eapply ptd_cons, Hptd. apply ptd_sort ; eapply ptd_cons, Hptd. rewrite /minus opp_plus scal_distr_l -scal_opp_r -!plus_assoc. apply f_equal. rewrite !plus_assoc. apply f_equal2 => //. by apply plus_comm. Qed. Lemma ex_RInt_ext : forall (f g : R -> V) (a b : R), (forall x, Rmin a b < x < Rmax a b -> f x = g x) -> ex_RInt f a b -> ex_RInt g a b. Proof. intros f g a b Heq [If Hex]. exists If. revert Hex. now apply is_RInt_ext. Qed. (** ** Constant functions *) Lemma is_RInt_const : forall (a b : R) (v : V), is_RInt (fun _ => v) a b (scal (b - a) v). Proof. intros a b v. apply filterlim_within_ext with (fun _ => scal (b - a) v). 2: apply filterlim_const. intros ptd [_ [Hhead Hlast]]. rewrite Riemann_sum_const. rewrite Hlast Hhead. rewrite scal_assoc. apply (f_equal (fun x => scal x v)). apply sym_eq, sign_min_max. Qed. Lemma ex_RInt_const : forall (a b : R) (v : V), ex_RInt (fun _ => v) a b. Proof. intros a b v. exists (scal (b - a) v). apply is_RInt_const. Qed. (** ** Composition *) Lemma is_RInt_comp_opp : forall (f : R -> V) (a b : R) (l : V), is_RInt f (-a) (-b) l -> is_RInt (fun y => opp (f (- y))) a b l. Proof. intros f a b l Hf. apply filterlim_locally => eps. generalize (proj1 (filterlim_locally _ _) Hf eps) ; clear Hf ; intros [delta Hf]. exists delta. intros ptd Hstep [Hptd [Hh Hl]]. rewrite Riemann_sum_opp. rewrite scal_opp_r -scal_opp_l /opp /= -sign_opp. rewrite Ropp_plus_distr. set ptd' := (mkSF_seq (-SF_h ptd) (seq.map (fun X => (- fst X,- snd X)) (SF_t ptd))). replace (Riemann_sum (fun x => f (-x)) ptd) with (Riemann_sum f (SF_rev ptd')). have H : SF_size ptd = SF_size ptd'. rewrite /SF_size /=. by rewrite size_map. apply Hf. clear H ; revert ptd' Hstep ; apply SF_cons_dec with (s := ptd) => [ x0 s' Hs'| h0 s] ; rewrite /seq_step. apply cond_pos. set s' := {| SF_h := - SF_h s; SF_t := [seq (- fst X, - snd X) | X <- SF_t s] |}. rewrite (SF_rev_cons (-fst h0,-snd h0) s'). rewrite SF_lx_rcons. rewrite behead_rcons ; [ | rewrite SF_size_lx ; by apply Nat.lt_0_succ ]. rewrite head_rcons. rewrite SF_lx_cons. revert h0 s' ; move: {1 3}(0) ; apply SF_cons_ind with (s := s) => {s} [ x1 | h1 s IH] x0 h0 s' Hs' ; simpl in Hs'. rewrite /= -Ropp_minus_distr' /Rminus -Ropp_plus_distr Ropp_involutive. by apply Hs'. set s'' := {| SF_h := - SF_h s; SF_t := [seq (- fst X, - snd X) | X <- SF_t s] |}. rewrite (SF_rev_cons (-fst h1,-snd h1) s''). rewrite SF_lx_rcons. rewrite behead_rcons ; [ | rewrite SF_size_lx ; by apply Nat.lt_0_succ ]. rewrite head_rcons. rewrite pairmap_rcons. rewrite foldr_rcons. apply: IH => /=. replace (Rmax (Rabs (SF_h s - fst h1)) (foldr Rmax (Rmax (Rabs (- fst h0 - - fst h1)) x0) (pairmap (fun x y : R => Rabs (y - x)) (SF_h s) (unzip1 (SF_t s))))) with (Rmax (Rabs (fst h1 - fst h0)) (Rmax (Rabs (SF_h s - fst h1)) (foldr Rmax x0 (pairmap (fun x y : R => Rabs (y - x)) (SF_h s) (unzip1 (SF_t s)))))). by []. rewrite Rmax_assoc (Rmax_comm (Rabs _)) -Rmax_assoc. apply f_equal. rewrite -(Ropp_minus_distr' (-fst h0)) /Rminus -Ropp_plus_distr Ropp_involutive. elim: (pairmap (fun x y : R => Rabs (y + - x)) (SF_h s) (unzip1 (SF_t s))) x0 {Hs'} (Rabs (fst h1 + - fst h0)) => [ | x2 t IH] x0 x1 /=. by []. rewrite Rmax_assoc (Rmax_comm x1) -Rmax_assoc. apply f_equal. by apply IH. split. revert ptd' Hptd H ; apply SF_cons_ind with (s := ptd) => [ x0 | h0 s IH] s' Hs' H i Hi ; rewrite SF_size_rev -H in Hi. by apply Nat.nlt_0_r in Hi. rewrite SF_size_cons in Hi. apply ->Nat.lt_succ_r in Hi. set s'' := {| SF_h := - SF_h s; SF_t := [seq (- fst X, - snd X) | X <- SF_t s] |}. rewrite (SF_rev_cons (-fst h0,-snd h0) s''). rewrite SF_size_cons (SF_size_cons (-fst h0,-snd h0) s'') in H. apply eq_add_S in H. rewrite SF_lx_rcons SF_ly_rcons. rewrite ?nth_rcons. rewrite ?SF_size_lx ?SF_size_ly ?SF_size_rev -H. move: (proj2 (SSR_leq _ _) (le_n_S _ _ Hi)) ; case: (ssrnat.leq (S i) (S (SF_size s))) => // _. apply le_lt_eq_dec in Hi ; case: Hi => [Hi | -> {i}]. move: (proj2 (SSR_leq _ _) Hi) ; case: (ssrnat.leq (S i) (SF_size s)) => // _. move: (proj2 (SSR_leq _ _) (le_n_S _ _ Hi)) ; case: (ssrnat.leq (S (S i)) (S (SF_size s))) => // _. apply IH. move: Hs' ; apply ptd_cons. apply H. rewrite SF_size_rev -H. intuition. have : ~ is_true (ssrnat.leq (S (SF_size s)) (SF_size s)). have H0 := Nat.lt_succ_diag_r (SF_size s). contradict H0. apply SSR_leq in H0. by apply Nat.le_ngt. case: (ssrnat.leq (S (SF_size s)) (SF_size s)) => // _. move: (@eqtype.eq_refl ssrnat_eqType (SF_size s)) ; case: (@eqtype.eq_op ssrnat_eqType (SF_size s) (SF_size s)) => // _. have : ~ is_true (ssrnat.leq (S (S (SF_size s))) (S (SF_size s))). have H0 := Nat.lt_succ_diag_r (SF_size s). contradict H0. apply SSR_leq in H0. by apply Nat.le_ngt, le_S_n. case: (ssrnat.leq (S (S (SF_size s))) (S (SF_size s))) => // _. move: (@eqtype.eq_refl ssrnat_eqType (S (SF_size s))) ; case: (@eqtype.eq_op ssrnat_eqType (S (SF_size s)) (S (SF_size s))) => // _. rewrite H SF_lx_rev nth_rev SF_size_lx //=. replace (ssrnat.subn (S (SF_size s'')) (S (SF_size s''))) with 0%nat by intuition. simpl. split ; apply Ropp_le_contravar ; apply (Hs' 0%nat) ; rewrite SF_size_cons ; by apply Nat.lt_0_succ. split. rewrite Rmin_opp_Rmax -Hl. simpl. clear H. revert ptd' ; move: (0) ; apply SF_cons_ind with (s := ptd) => [ h0 | h0 s IH] x0 s'. by simpl. set s'' := {| SF_h := - SF_h s; SF_t := [seq (- fst X, - snd X) | X <- SF_t s] |}. rewrite (SF_lx_cons (-fst h0,-snd h0) s'') rev_cons /=. rewrite head_rcons. by apply IH. rewrite Rmax_opp_Rmin -Hh. simpl. clear H. revert ptd' ; move: (0) ; apply SF_cons_dec with (s := ptd) => [ h0 | h0 s] x0 s'. by simpl. set s'' := {| SF_h := - SF_h s; SF_t := [seq (- fst X, - snd X) | X <- SF_t s] |}. rewrite (SF_lx_cons (-fst h0,-snd h0) s'') rev_cons /=. rewrite head_rcons. rewrite behead_rcons ; [ | rewrite size_rev SF_size_lx ; by apply Nat.lt_0_succ]. rewrite unzip1_zip. by rewrite last_rcons. rewrite size_rcons size_behead ?size_rev SF_size_ly SF_size_lx //=. revert ptd' ; apply SF_cons_ind with (s := ptd) => /= [x0 | h ptd' IH]. easy. rewrite Riemann_sum_cons. rewrite (SF_rev_cons (-fst h, -snd h) (mkSF_seq (- SF_h ptd') (seq.map (fun X : R * R => (- fst X, - snd X)) (SF_t ptd')))). rewrite -IH => {IH}. set s := {| SF_h := - SF_h ptd'; SF_t := seq.map (fun X : R * R => (- fst X, - snd X)) (SF_t ptd') |}. rewrite Riemann_sum_rcons. rewrite SF_lx_rev. have H : (forall s x0, last x0 (rev s) = head x0 s). move => T s0 x0. case: s0 => [ | x1 s0] //=. rewrite rev_cons. by rewrite last_rcons. rewrite H /=. rewrite plus_comm. apply: (f_equal (fun x => plus (scal x _) _)). simpl ; ring. Qed. Lemma ex_RInt_comp_opp : forall (f : R -> V) (a b : R), ex_RInt f (-a) (-b) -> ex_RInt (fun y => opp (f (- y))) a b. Proof. intros f a b [l If]. exists l. by apply is_RInt_comp_opp. Qed. Lemma is_RInt_comp_lin (f : R -> V) (u v a b : R) (l : V) : is_RInt f (u * a + v) (u * b + v) l -> is_RInt (fun y => scal u (f (u * y + v))) a b l. Proof. case: (Req_dec u 0) => [-> {u} If | ]. evar_last. apply is_RInt_ext with (fun _ => zero). move => x _ ; apply sym_eq ; apply: scal_zero_l. apply is_RInt_const. apply filterlim_locally_unique with (2 := If). rewrite !Rmult_0_l Rplus_0_l. rewrite scal_zero_r. apply is_RInt_point. wlog: u a b / (u > 0) => [Hw | Hu _]. case: (Rlt_le_dec 0 u) => Hu. by apply Hw. case: Hu => // Hu _ If. apply is_RInt_ext with (fun y => opp (scal (- u) (f ((- u) * (- y) + v)))). move => x _. rewrite -(scal_opp_l (- u) (f (- u * - x + v))) /=. rewrite /opp /= Ropp_involutive. apply f_equal. apply f_equal ; ring. apply (is_RInt_comp_opp (fun y => scal (- u) (f (- u * y + v)))). apply Hw. by apply Ropp_gt_lt_0_contravar. by apply Ropp_neq_0_compat, Rlt_not_eq. by rewrite ?Rmult_opp_opp. wlog: a b l / (a < b) => [Hw | Hab]. case: (Rlt_le_dec a b) => Hab If. by apply Hw. case: Hab If => [Hab | -> {b}] If. rewrite -(opp_opp l). apply is_RInt_swap. apply Hw. by []. by apply is_RInt_swap. evar_last. apply is_RInt_point. apply filterlim_locally_unique with (2 := If). apply is_RInt_point. intros If. apply filterlim_locally. generalize (proj1 (filterlim_locally _ l) If). move => {} If eps. case: (If eps) => {If} alpha If. have Ha : 0 < alpha / Rabs u. apply Rdiv_lt_0_compat. by apply alpha. by apply Rabs_pos_lt, Rgt_not_eq. exists (mkposreal _ Ha) => /= ptd Hstep [Hptd [Hfirst Hlast]]. set ptd' := mkSF_seq (u * SF_h ptd + v) (map (fun X => (u * fst X + v,u * snd X + v)) (SF_t ptd)). replace (scal (sign (b - a)) (Riemann_sum (fun y : R => scal u (f (u * y + v))) ptd)) with (scal (sign (u * b + v - (u * a + v))) (Riemann_sum f ptd')). apply: If. revert ptd' ; case: (ptd) Hstep => x0 s Hs /= ; rewrite /seq_step /= in Hs |- *. elim: s x0 Hs => [ | [x1 y0] s IH] /= x0 Hs. by apply alpha. apply Rmax_case. replace (u * x1 + v - (u * x0 + v)) with (u * (x1 - x0)) by ring. rewrite Rabs_mult Rmult_comm ; apply Rlt_div_r. by apply Rabs_pos_lt, Rgt_not_eq. by apply Rle_lt_trans with (2 := Hs), Rmax_l. apply IH. by apply Rle_lt_trans with (2 := Hs), Rmax_r. split. revert ptd' ; case: (ptd) Hptd => x0 s Hs /= i Hi ; rewrite /SF_size size_map /= in Hi ; move: (Hs i) => {} Hs ; rewrite /SF_size /= in Hs ; move: (Hs Hi) => {Hs} ; rewrite /SF_lx /SF_ly /= => Hs. elim: s i x0 Hi Hs => /= [ | [x1 y0] s IH] i x0 Hi Hs. by apply Nat.nlt_0_r in Hi. case: i Hi Hs => /= [ | i] Hi Hs. split ; apply Rplus_le_compat_r ; apply Rmult_le_compat_l ; try by apply Rlt_le. by apply Hs. by apply Hs. apply IH. by apply Nat.lt_succ_r. by apply Hs. split. rewrite /ptd' /= Hfirst. rewrite -Rplus_min_distr_r. rewrite -Rmult_min_distr_l. reflexivity. by apply Rlt_le. rewrite -Rplus_max_distr_r. rewrite -Rmult_max_distr_l. rewrite -Hlast. rewrite /ptd' /=. elim: (SF_t ptd) (SF_h ptd) => [ | [x1 _] /= s IH] x0 //=. by apply Rlt_le. apply f_equal2. replace (u * b + v - (u * a + v)) with (u * (b - a)) by ring. rewrite sign_mult. rewrite (sign_eq_1 _ Hu). apply Rmult_1_l. revert ptd' ; apply SF_cons_ind with (s := ptd) => [x0 | [x0 y0] s IH] //=. set s' := {| SF_h := u * SF_h s + v; SF_t := [seq (u * fst X + v, u * snd X + v) | X <- SF_t s] |}. rewrite Riemann_sum_cons (Riemann_sum_cons _ (u * x0 + v,u * y0 + v) s') /=. rewrite IH. apply f_equal2 => //=. rewrite scal_assoc /=. apply (f_equal (fun x => scal x _)). rewrite /mult /= ; ring. Qed. Lemma ex_RInt_comp_lin (f : R -> V) (u v a b : R) : ex_RInt f (u * a + v) (u * b + v) -> ex_RInt (fun y => scal u (f (u * y + v))) a b. Proof. case => l Hf. exists l. by apply is_RInt_comp_lin. Qed. (** ** Chasles *) Lemma is_RInt_Chasles_0 (f : R -> V) (a b c : R) (l1 l2 : V) : a < b < c -> is_RInt f a b l1 -> is_RInt f b c l2 -> is_RInt f a c (plus l1 l2). Proof. intros [Hab Hbc] H1 H2. case: (ex_RInt_ub f a b). by exists l1. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => //= _ _ M1 HM1. case: (ex_RInt_ub f b c). by exists l2. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hbc) => //= _ _ M2 HM2. apply filterlim_locally_ball_norm => eps. generalize (proj1 (filterlim_locally_ball_norm _ _) H1 (pos_div_2 (pos_div_2 eps))) => {} H1. generalize (proj1 (filterlim_locally_ball_norm _ _) H2 (pos_div_2 (pos_div_2 eps))) => {} H2. case: H1 => d1 H1. case: H2 => d2 H2. move: H1 ; rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => //= _ _ H1. move: H2 ; rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hbc) => //= _ _ H2. have Hd3 : 0 < eps / (4 * ((M1 + 1) + (M2 + 1))). apply Rdiv_lt_0_compat. by apply eps. repeat apply Rmult_lt_0_compat. by apply Rlt_0_2. by apply Rlt_0_2. apply Rplus_lt_0_compat ; apply Rplus_le_lt_0_compat, Rlt_0_1. specialize (HM1 _ (conj (Rle_refl _) (Rlt_le _ _ Hab))). apply Rle_trans with (2 := HM1), norm_ge_0. specialize (HM2 _ (conj (Rle_refl _) (Rlt_le _ _ Hbc))). apply Rle_trans with (2 := HM2), norm_ge_0. have Hd : 0 < Rmin (Rmin d1 d2) (mkposreal _ Hd3). repeat apply Rmin_case. by apply d1. by apply d2. by apply Hd3. exists (mkposreal _ Hd) => /= ptd Hstep [Hptd [Hh Hl]]. move: Hh Hl ; rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ (Rlt_trans _ _ _ Hab Hbc)) => //= _ _ Hh Hl. rewrite -> sign_eq_1 by now apply Rlt_Rminus, Rlt_trans with b. rewrite scal_one. rewrite /ball_norm (double_var eps). apply Rle_lt_trans with (norm (minus (Riemann_sum f ptd) (plus (Riemann_sum f (SF_cut_down ptd b)) (Riemann_sum f (SF_cut_up ptd b)))) + norm (minus (plus (Riemann_sum f (SF_cut_down ptd b)) (Riemann_sum f (SF_cut_up ptd b))) (plus l1 l2))). set v:= minus _ (plus l1 l2). replace v with (plus (minus (Riemann_sum f ptd) (plus (Riemann_sum f (SF_cut_down ptd b)) (Riemann_sum f (SF_cut_up ptd b)))) (minus (plus (Riemann_sum f (SF_cut_down ptd b)) (Riemann_sum f (SF_cut_up ptd b))) (plus l1 l2))). exact: norm_triangle. rewrite /v /minus -plus_assoc. apply f_equal. by rewrite plus_assoc plus_opp_l plus_zero_l. apply Rplus_lt_compat. apply Rlt_le_trans with (2 := Rmin_r _ _) in Hstep. generalize (fun H H0 => Riemann_sum_Chasles_0 f (M1 + 1 + (M2 + 1)) b ptd (mkposreal _ Hd3) H H0 Hptd Hstep). rewrite /= Hl Hh => H. replace (eps / 2) with (2 * (mkposreal _ Hd3) * (M1 + 1 + (M2 + 1))). rewrite -norm_opp opp_plus opp_opp plus_comm. simpl ; apply H. intros x Hx. case: (Rle_lt_dec x b) => Hxb. apply Rlt_trans with (M1 + 1). apply Rle_lt_trans with M1. apply HM1 ; split. by apply Hx. by apply Hxb. apply Rminus_lt_0 ; ring_simplify ; by apply Rlt_0_1. apply Rminus_lt_0 ; ring_simplify. apply Rplus_le_lt_0_compat with (2 := Rlt_0_1). specialize (HM2 _ (conj (Rle_refl _) (Rlt_le _ _ Hbc))). apply Rle_trans with (2 := HM2), norm_ge_0. apply Rlt_trans with (M2 + 1). apply Rle_lt_trans with M2. apply HM2 ; split. by apply Rlt_le, Hxb. by apply Hx. apply Rminus_lt_0 ; ring_simplify ; by apply Rlt_0_1. apply Rminus_lt_0 ; ring_simplify. apply Rplus_le_lt_0_compat with (2 := Rlt_0_1). specialize (HM1 _ (conj (Rle_refl _) (Rlt_le _ _ Hab))). apply Rle_trans with (2 := HM1), norm_ge_0. split ; by apply Rlt_le. simpl ; field. apply Rgt_not_eq. apply Rplus_lt_0_compat ; apply Rplus_le_lt_0_compat, Rlt_0_1. specialize (HM1 _ (conj (Rle_refl _) (Rlt_le _ _ Hab))). apply Rle_trans with (2 := HM1), norm_ge_0. specialize (HM2 _ (conj (Rle_refl _) (Rlt_le _ _ Hbc))). apply Rle_trans with (2 := HM2), norm_ge_0. apply Rlt_le_trans with (2 := Rmin_l _ _) in Hstep. specialize (H1 (SF_cut_down ptd b)). specialize (H2 (SF_cut_up ptd b)). apply Rle_lt_trans with (norm (minus (scal (sign (b - a)) (Riemann_sum f (SF_cut_down ptd b))) l1) + norm (minus (scal (sign (c - b)) (Riemann_sum f (SF_cut_up ptd b))) l2)). replace (minus (plus (Riemann_sum f (SF_cut_down ptd b)) (Riemann_sum f (SF_cut_up ptd b))) (plus l1 l2)) with (plus (minus (scal (sign (b - a)) (Riemann_sum f (SF_cut_down ptd b))) l1) (minus (scal (sign (c - b)) (Riemann_sum f (SF_cut_up ptd b))) l2)). apply @norm_triangle. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite 2!scal_one /minus opp_plus -2!plus_assoc. apply f_equal. rewrite plus_comm -plus_assoc. apply f_equal. by apply plus_comm. rewrite (double_var (eps / 2)) ; apply Rplus_lt_compat. apply H1. apply SF_cut_down_step. rewrite /= Hl Hh ; split ; by apply Rlt_le. by apply Rlt_le_trans with (1 := Hstep), Rmin_l. split. apply SF_cut_down_pointed. rewrite Hh ; by apply Rlt_le. by []. split. rewrite SF_cut_down_h. by apply Hh. rewrite Hh ; by apply Rlt_le. move: (SF_cut_down_l ptd b) => //=. apply H2. apply SF_cut_up_step. rewrite /= Hl Hh ; split ; by apply Rlt_le. by apply Rlt_le_trans with (1 := Hstep), Rmin_r. split. apply SF_cut_up_pointed. rewrite Hh ; by apply Rlt_le. by []. split. by rewrite SF_cut_up_h. move: (SF_cut_up_l ptd b) => /= ->. by apply Hl. rewrite Hl ; by apply Rlt_le. Qed. Lemma ex_RInt_Chasles_0 (f : R -> V) (a b c : R) : a <= b <= c -> ex_RInt f a b -> ex_RInt f b c -> ex_RInt f a c. Proof. case => Hab Hbc H1 H2. case: Hab => [ Hab | -> ] //. case: Hbc => [ Hbc | <- ] //. case: H1 => [l1 H1] ; case: H2 => [l2 H2]. exists (plus l1 l2). apply is_RInt_Chasles_0 with b ; try assumption. by split. Qed. Lemma is_RInt_Chasles_1 (f : R -> V) (a b c : R) l1 l2 : a < b < c -> is_RInt f a c l1 -> is_RInt f b c l2 -> is_RInt f a b (minus l1 l2). Proof. intros [Hab Hbc] H1 H2. apply filterlim_locally_ball_norm => eps. generalize (proj1 (filterlim_locally_ball_norm _ _) H1 (pos_div_2 eps)) ; case => {H1} d1 /= H1. generalize (proj1 (filterlim_locally_ball_norm _ _) H2 (pos_div_2 eps)) ; case => {H2} d2 /= H2. exists d1 ; simpl ; intros y Hstep [Hptd [Hh Hl]]. assert (exists y, seq_step (SF_lx y) < Rmin d1 d2 /\ pointed_subdiv y /\ SF_h y = Rmin b c /\ last (SF_h y) (unzip1 (SF_t y)) = Rmax b c). apply filter_ex. exists (mkposreal _ (Rmin_stable_in_posreal d1 d2)) ; intros y0 H3 [H4 [H5 H6]]. repeat (split => //=). by apply H5. by apply H6. case: H => y2 [Hstep2 H]. specialize (H2 y2 (Rlt_le_trans _ _ _ Hstep2 (Rmin_r _ _)) H). case: H => Hptd2 [Hh2 Hl2]. set y1 := mkSF_seq (SF_h y) (SF_t y ++ SF_t y2). move: Hl Hh2 Hh Hl2 H1 H2 ; rewrite /Rmax /Rmin ; case: Rle_dec (Rlt_le _ _ Hab) (Rlt_le _ _ Hbc) => // _ _ ; case: Rle_dec => // _ _. case: Rle_dec (Rlt_le _ _ (Rlt_trans _ _ _ Hab Hbc)) => // _ _. move => Hl Hh2 Hh Hl2 H1 H2. rewrite -Hl in Hab, Hbc, H2, Hh2 |-* => {b Hl}. rewrite -Hh in H1, Hab |- * => {a Hh}. rewrite -Hl2 in Hbc, H2, H1 => {c Hl2}. assert (seq_step (SF_lx y1) < d1). unfold y1 ; move: Hstep Hh2. clear -Hstep2. apply SF_cons_ind with (s := y) => {y} [ x0 | [x0 y0] y IH ] /= Hstep Hl. rewrite -Hl. by apply Rlt_le_trans with (1 := Hstep2), Rmin_l. rewrite /SF_lx /seq_step /= in Hstep |- * ; move: (Rle_lt_trans _ _ _ (Rmax_r _ _) Hstep) (Rle_lt_trans _ _ _ (Rmax_l _ _) Hstep) => {Hstep} /= H H0. apply Rmax_case. by []. by apply IH. assert (pointed_subdiv y1 /\ SF_h y1 = SF_h y /\ last (SF_h y1) (unzip1 (SF_t y1)) = last (SF_h y2) (unzip1 (SF_t y2))). split. unfold y1 ; move: Hptd Hh2. clear -Hptd2. apply SF_cons_ind with (s := y) => {y} [ x0 | [x0 y0] y IH ] /= Hptd Hl. rewrite -Hl ; by apply Hptd2. case => [ | i] /= Hi. by apply (Hptd O (Nat.lt_0_succ _)). apply (IH (ptd_cons _ _ Hptd) Hl i (proj2 (Nat.succ_lt_mono _ _) Hi)). unfold y1 ; simpl ; split. by []. move: Hh2 ; clear ; apply SF_cons_ind with (s := y) => {y} [ x0 | [x0 y0] y IH ] /= Hl. by rewrite Hl. by apply IH. specialize (H1 y1 H H0). move: Hab Hbc Hh2 H1 H2 ; clear ; set c := last (SF_h y2) (unzip1 (SF_t y2)) ; set b := last (SF_h y) (unzip1 (SF_t y)) ; set a := SF_h y => Hab Hbc Hl. rewrite -> sign_eq_1 by now apply Rlt_Rminus, Rlt_trans with b. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite 3!scal_one. replace (Riemann_sum f y) with (minus (Riemann_sum f y1) (Riemann_sum f y2)). move => H1 H2. unfold ball_norm. set v := minus _ _. replace v with (minus (minus (Riemann_sum f y1) l1) (minus (Riemann_sum f y2) l2)). rewrite (double_var eps). apply Rle_lt_trans with (2 := Rplus_lt_compat _ _ _ _ H1 H2). rewrite -(norm_opp (minus (Riemann_sum f y2) l2)). by apply @norm_triangle. rewrite /v /minus 2!opp_plus opp_opp 2!plus_assoc. apply (f_equal (fun x => plus x _)). rewrite -!plus_assoc. apply f_equal. by apply plus_comm. move: Hl ; unfold y1, b. clear. apply SF_cons_ind with (s := y) => {y} [ x0 | [x0 y0] y IH ] /= Hl. by rewrite -Hl /minus plus_opp_r. rewrite (Riemann_sum_cons _ (x0,y0) {| SF_h := SF_h y; SF_t := SF_t y ++ SF_t y2 |}) /=. rewrite Riemann_sum_cons /=. rewrite /minus -plus_assoc. apply f_equal. by apply IH. Qed. Lemma is_RInt_Chasles_2 (f : R -> V) (a b c : R) l1 l2 : a < b < c -> is_RInt f a c l1 -> is_RInt f a b l2 -> is_RInt f b c (minus l1 l2). Proof. intros [Hab Hbc] H1 H2. rewrite -(Ropp_involutive a) -(Ropp_involutive b) -(Ropp_involutive c) in H1 H2. apply is_RInt_comp_opp, is_RInt_swap in H1. apply is_RInt_comp_opp, is_RInt_swap in H2. apply Ropp_lt_contravar in Hab. apply Ropp_lt_contravar in Hbc. generalize (is_RInt_Chasles_1 _ _ _ _ _ _ (conj Hbc Hab) H1 H2). clear => H. apply is_RInt_comp_opp, is_RInt_swap in H. replace (minus l1 l2) with (opp (minus (opp l1) (opp l2))). move: H ; apply is_RInt_ext. now move => x _ ; rewrite opp_opp Ropp_involutive. by rewrite /minus opp_plus 2!opp_opp. Qed. Lemma is_RInt_Chasles (f : R -> V) (a b c : R) (l1 l2 : V) : is_RInt f a b l1 -> is_RInt f b c l2 -> is_RInt f a c (plus l1 l2). Proof. wlog: a c l1 l2 / (a <= c) => [Hw | Hac]. move => H1 H2. case: (Rle_lt_dec a c) => Hac. by apply Hw. rewrite -(opp_opp (plus _ _)) opp_plus plus_comm. apply is_RInt_swap. apply Hw. by apply Rlt_le. by apply is_RInt_swap. by apply is_RInt_swap. case: (Req_dec a b) => [ <- {b} | Hab'] H1. - move => H2. apply filterlim_locally_ball_norm => /= eps. generalize (proj1 (filterlim_locally_ball_norm _ _) H1 (pos_div_2 eps)) ; case => /= {H1} d1 H1. assert (pointed_subdiv (SF_nil a) /\ SF_h (SF_nil (T := V) a) = Rmin a a /\ last (SF_h (SF_nil (T := V) a)) (unzip1 (SF_t (SF_nil (T := V) a))) = Rmax a a). split. move => i Hi ; by apply Nat.nlt_0_r in Hi. rewrite /Rmin /Rmax ; by case: Rle_dec (Rle_refl a). specialize (H1 (SF_nil a) (cond_pos d1) H) => {H d1}. rewrite Rminus_eq_0 sign_0 in H1. assert (H := scal_zero_l (Riemann_sum f (SF_nil a))). rewrite /ball_norm H /minus plus_zero_l in H1 => {H}. generalize (proj1 (filterlim_locally_ball_norm _ _) H2 (pos_div_2 eps)) ; case => /= {H2} d2 H2. exists d2 => ptd Hstep Hptd. apply Rle_lt_trans with (norm (minus (scal (sign (c - a)) (Riemann_sum f ptd)) l2) + norm (opp l1)). apply Rle_trans with (2 := norm_triangle _ _). apply Req_le, f_equal. rewrite /minus opp_plus -plus_assoc. by apply f_equal, @plus_comm. rewrite (double_var eps) ; apply Rplus_lt_compat. by apply H2. by apply H1. case: (Req_dec b c) => [ <- | Hbc'] H2. - apply filterlim_locally_ball_norm => /= eps. generalize (proj1 (filterlim_locally_ball_norm _ _) H2 (pos_div_2 eps)) ; case => /= {H2} d2 H2. assert (pointed_subdiv (SF_nil b) /\ SF_h (SF_nil (T := V) b) = Rmin b b /\ last (SF_h (SF_nil (T := V) b)) (unzip1 (SF_t (SF_nil (T := V) b))) = Rmax b b). split. move => i Hi ; by apply Nat.nlt_0_r in Hi. rewrite /Rmin /Rmax ; by case: Rle_dec (Rle_refl b). specialize (H2 (SF_nil b) (cond_pos d2) H) => {H d2}. rewrite Rminus_eq_0 sign_0 in H2. assert (H := scal_zero_l (Riemann_sum f (SF_nil a))). rewrite /ball_norm H /minus plus_zero_l in H2 => {H}. generalize (proj1 (filterlim_locally_ball_norm _ _) H1 (pos_div_2 eps)) ; case => /= {H1} d1 H1. exists d1 => ptd Hstep Hptd. apply Rle_lt_trans with (norm (minus (scal (sign (b - a)) (Riemann_sum f ptd)) l1) + norm (opp l2)). apply Rle_trans with (2 := norm_triangle _ _). apply Req_le, f_equal. by rewrite /minus opp_plus -plus_assoc. rewrite (double_var eps) ; apply Rplus_lt_compat. by apply H1. by apply H2. case: (Req_dec a c) => Hac'. - rewrite -Hac' in H1 Hbc' H2 Hac |- * => {c Hac'}. apply is_RInt_swap in H2. apply filterlim_locally_ball_norm => /= eps. exists (mkposreal _ Rlt_0_1) => y Hstep Hy. rewrite Rminus_eq_0 sign_0. assert (H := scal_zero_l (Riemann_sum f y)). rewrite /ball_norm H /minus plus_zero_l opp_plus => {H y Hstep Hy}. generalize (proj1 (filterlim_locally_ball_norm _ _) H1 (pos_div_2 eps)) ; case => /= {H1} d1 H1. generalize (proj1 (filterlim_locally_ball_norm _ _) H2 (pos_div_2 eps)) ; case => /= {H2} d2 H2. assert (exists y, seq_step (SF_lx y) < Rmin d1 d2 /\ pointed_subdiv y /\ SF_h y = Rmin a b /\ last (SF_h y) (unzip1 (SF_t y)) = Rmax a b). apply filter_ex. exists (mkposreal _ (Rmin_stable_in_posreal d1 d2)) ; intros y0 H3 [H4 [H5 H6]]. repeat (split => //=). by apply H5. by apply H6. case: H => y [Hstep Hy]. specialize (H1 _ (Rlt_le_trans _ _ _ Hstep (Rmin_l _ _)) Hy). specialize (H2 _ (Rlt_le_trans _ _ _ Hstep (Rmin_r _ _)) Hy). rewrite (double_var eps). rewrite /ball_norm -norm_opp /minus opp_plus opp_opp in H2. apply Rle_lt_trans with (2 := Rplus_lt_compat _ _ _ _ H1 H2). apply Rle_trans with (2 := norm_triangle _ _). apply Req_le, f_equal. rewrite plus_assoc /minus. apply (f_equal (fun x => plus x _)). by rewrite plus_comm plus_assoc plus_opp_l plus_zero_l. case: (Rle_lt_dec a b) => Hab ; try (case: Hab => //= Hab) ; clear Hab' ; case: (Rle_lt_dec b c) => Hbc ; try (case: Hbc => //= Hbc) ; clear Hbc' ; try (case: Hac => //= Hac) ; clear Hac'. by apply is_RInt_Chasles_0 with b. apply is_RInt_swap in H2. rewrite -(opp_opp l2). by apply is_RInt_Chasles_1 with b. apply is_RInt_swap in H1. rewrite -(opp_opp l1) plus_comm. by apply is_RInt_Chasles_2 with b. now contradict Hab ; apply Rle_not_lt, Rlt_le, Rlt_trans with c. Qed. Lemma ex_RInt_Chasles (f : R -> V) (a b c : R) : ex_RInt f a b -> ex_RInt f b c -> ex_RInt f a c. Proof. intros [l1 H1] [l2 H2]. exists (plus l1 l2). by apply is_RInt_Chasles with b. Qed. (** ** Operations *) Lemma is_RInt_scal : forall (f : R -> V) (a b : R) (k : R) (If : V), is_RInt f a b If -> is_RInt (fun y => scal k (f y)) a b (scal k If). Proof. intros f a b k If Hf. apply filterlim_ext with (fun ptd => scal k (scal (sign (b - a)) (Riemann_sum f ptd))). intros ptd. rewrite Riemann_sum_scal. rewrite 2!scal_assoc. apply (f_equal (fun x => scal x _)). apply Rmult_comm. apply filterlim_comp with (1 := Hf). apply: filterlim_scal_r. Qed. Lemma ex_RInt_scal : forall (f : R -> V) (a b : R) (k : R), ex_RInt f a b -> ex_RInt (fun y => scal k (f y)) a b. Proof. intros f a b k [If Hf]. exists (scal k If). now apply is_RInt_scal. Qed. Lemma is_RInt_opp : forall (f : R -> V) (a b : R) (If : V), is_RInt f a b If -> is_RInt (fun y => opp (f y)) a b (opp If). Proof. intros f a b If Hf. apply filterlim_ext with (fun ptd => (scal (opp 1) (scal (sign (b - a)) (Riemann_sum f ptd)))). intros ptd. rewrite Riemann_sum_opp. rewrite scal_opp_one. apply sym_eq, scal_opp_r. apply filterlim_comp with (1 := Hf). rewrite -(scal_opp_one If). apply: filterlim_scal_r. Qed. Lemma ex_RInt_opp : forall (f : R -> V) (a b : R), ex_RInt f a b -> ex_RInt (fun x => opp (f x)) a b. Proof. intros f a b [If Hf]. exists (opp If). now apply is_RInt_opp. Qed. Lemma is_RInt_plus : forall (f g : R -> V) (a b : R) (If Ig : V), is_RInt f a b If -> is_RInt g a b Ig -> is_RInt (fun y => plus (f y) (g y)) a b (plus If Ig). Proof. intros f g a b If Ig Hf Hg. apply filterlim_ext with (fun ptd => (plus (scal (sign (b - a)) (Riemann_sum f ptd)) (scal (sign (b - a)) (Riemann_sum g ptd)))). intros ptd. rewrite Riemann_sum_plus. apply sym_eq, @scal_distr_l. apply filterlim_comp_2 with (1 := Hf) (2 := Hg). apply: filterlim_plus. Qed. Lemma ex_RInt_plus : forall (f g : R -> V) (a b : R), ex_RInt f a b -> ex_RInt g a b -> ex_RInt (fun y => plus (f y) (g y)) a b. Proof. intros f g a b [If Hf] [Ig Hg]. exists (plus If Ig). now apply is_RInt_plus. Qed. Lemma is_RInt_minus : forall (f g : R -> V) (a b : R) (If Ig : V), is_RInt f a b If -> is_RInt g a b Ig -> is_RInt (fun y => minus (f y) (g y)) a b (minus If Ig). Proof. intros f g a b If Ig Hf Hg. apply filterlim_ext with (fun ptd => (plus (scal (sign (b - a)) (Riemann_sum f ptd)) (scal (opp 1) (scal (sign (b - a)) (Riemann_sum g ptd))))). intros ptd. rewrite Riemann_sum_minus. unfold minus. rewrite scal_opp_one. rewrite -scal_opp_r. apply sym_eq, @scal_distr_l. eapply filterlim_comp_2 with (1 := Hf). apply filterlim_comp with (1 := Hg). eapply @filterlim_scal_r. rewrite scal_opp_one. apply: filterlim_plus. Qed. Lemma ex_RInt_minus : forall (f g : R -> V) (a b : R), ex_RInt f a b -> ex_RInt g a b -> ex_RInt (fun y => minus (f y) (g y)) a b. Proof. intros f g a b [If Hf] [Ig Hg]. exists (minus If Ig). now apply is_RInt_minus. Qed. End is_RInt. Lemma ex_RInt_Chasles_1 {V : CompleteNormedModule R_AbsRing} (f : R -> V) (a b c : R) : a <= b <= c -> ex_RInt f a c -> ex_RInt f a b. Proof. intros [Hab Hbc] If. case: Hab => [Hab | <- ]. 2: by apply ex_RInt_point. apply (filterlim_locally_closely (F := Riemann_fine a b) (fun ptd : SF_seq => scal (sign (b - a)) (Riemann_sum f ptd))). apply: (filterlim_filter_le_2 _ closely_norm_le_closely). apply <- (filterlim_closely_norm (F := Riemann_fine a b) (fun ptd : SF_seq => scal (sign (b - a)) (Riemann_sum f ptd))). intros eps. generalize (filterlim_locally_closely (F := Riemann_fine a c) (fun ptd : SF_seq => scal (sign (c - a)) (Riemann_sum f ptd))). move /proj2 /(_ If). move /(filterlim_filter_le_2 _ closely_le_closely_norm) => H. case: (proj1 (filterlim_closely_norm (F := Riemann_fine a c) (fun ptd : SF_seq => scal (sign (c - a)) (Riemann_sum f ptd))) H eps) => {H If} [P [[alpha HP] If]]. destruct (filter_ex (F := Riemann_fine b c) (fun y => seq_step (SF_lx y) < alpha /\ pointed_subdiv y /\ SF_h y = Rmin b c /\ seq.last (SF_h y) (SF_lx y) = Rmax b c)) as [y' Hy']. by exists alpha. exists (fun y => P (SF_cat y y') /\ last (SF_h y) (SF_lx y) = Rmax a b) ; split. exists alpha ; intros. assert (last 0 (SF_lx y) = head 0 (SF_lx y')). simpl in H0, Hy' |- *. rewrite (proj1 (proj2 (proj2 Hy'))). rewrite (proj2 (proj2 H0)). rewrite /Rmin ; case: Rle_dec => // _. rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => //. split. apply HP ; intuition. rewrite SF_lx_cat seq_step_cat. by apply Rmax_case. by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. by []. apply SF_cat_pointed => //. rewrite H3 /Rmin ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. case: Rle_dec (Rlt_le _ _ (Rlt_le_trans _ _ _ Hab Hbc)) => //. rewrite SF_last_cat // H8. rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. case: Rle_dec (Rlt_le _ _ (Rlt_le_trans _ _ _ Hab Hbc)) => //. by apply H0. intros. specialize (If _ _ (proj1 H) (proj1 H0)). rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite -> sign_eq_1 in If by now apply Rlt_Rminus, Rlt_le_trans with b. apply Rle_lt_trans with (2 := If). apply Req_le, f_equal. rewrite !scal_one. case: H => _ ; case: H0 => _ ; clear ; intros. rewrite -b1 in b0. move: v u b0 y' {b1}. apply (SF_cons_ind (fun v => forall u : SF_seq, last (SF_h v) (SF_lx v) = last (SF_h u) (SF_lx u) -> forall y' : SF_seq, minus (Riemann_sum f v) (Riemann_sum f u) = minus (Riemann_sum f (SF_cat v y')) (Riemann_sum f (SF_cat u y')))) => [v0 | v0 v IH u Huv y]. apply (SF_cons_ind (fun u => last (SF_h (SF_nil v0)) (SF_lx (SF_nil v0)) = last (SF_h u) (SF_lx u) -> forall y' : SF_seq, minus (Riemann_sum f (SF_nil v0)) (Riemann_sum f u) = minus (Riemann_sum f (SF_cat (SF_nil v0) y')) (Riemann_sum f (SF_cat u y')))) => [u0 /= Huv | u0 u IH Huv y]. apply (SF_cons_ind (fun y' : SF_seq => minus (Riemann_sum f (SF_nil v0)) (Riemann_sum f (SF_nil u0)) = minus (Riemann_sum f (SF_cat (SF_nil v0) y')) (Riemann_sum f (SF_cat (SF_nil u0) y')))) => [y0 | y0 y IH]. by []. simpl in Huv. rewrite Huv /SF_cat /=. rewrite (Riemann_sum_cons _ (u0,snd y0)) /=. rewrite /minus opp_plus (plus_comm (scal _ _)) -plus_assoc. now rewrite (plus_assoc (scal _ _)) !plus_opp_r plus_zero_l plus_opp_r. rewrite -SF_cons_cat !Riemann_sum_cons. rewrite /minus !opp_plus !(plus_comm (opp (scal _ _))) !plus_assoc. by rewrite -!/(minus _ _) -IH. rewrite -SF_cons_cat !Riemann_sum_cons. rewrite /minus -!plus_assoc. by rewrite -!/(minus _ _) -IH. Qed. Lemma ex_RInt_Chasles_2 {V : CompleteNormedModule R_AbsRing} (f : R -> V) (a b c : R) : a <= b <= c -> ex_RInt f a c -> ex_RInt f b c. Proof. intros. rewrite -(Ropp_involutive a) -(Ropp_involutive c) in H0. apply ex_RInt_comp_opp in H0. apply ex_RInt_swap in H0. eapply ex_RInt_Chasles_1 in H0. apply ex_RInt_comp_opp in H0. apply ex_RInt_swap in H0. move: H0 ; apply ex_RInt_ext => x _. by rewrite opp_opp Ropp_involutive. split ; apply Ropp_le_contravar ; apply H. Qed. Lemma ex_RInt_inside {V : CompleteNormedModule R_AbsRing} : forall (f : R -> V) (a b x e : R), ex_RInt f (x-e) (x+e) -> Rabs (a-x) <= e -> Rabs (b-x) <= e -> ex_RInt f a b. Proof. intros f a b x e Hf Ha Hb. wlog: a b Ha Hb / (a <= b) => [Hw | Hab]. case (Rle_or_lt a b); intros H. now apply Hw. apply ex_RInt_swap. apply Hw; try easy. now left. apply (ex_RInt_Chasles_1 f a b) with (x+e). split. exact Hab. assert (x-e <= b <= x+e) by now apply Rabs_le_between'. apply H. apply ex_RInt_Chasles_2 with (x-e). now apply Rabs_le_between'. exact Hf. Qed. (** ** Exchange limit and integral *) Lemma filterlim_RInt {U} {V : CompleteNormedModule R_AbsRing} : forall (f : U -> R -> V) (a b : R) F (FF : ProperFilter F) g h, (forall x, is_RInt (f x) a b (h x)) -> (filterlim f F (locally g)) -> exists If, filterlim h F (locally If) /\ is_RInt g a b If. Proof. intros f a b F FF g h Hfh Hfg. wlog: a b h Hfh / (a <= b) => [Hw | Hab]. case: (Rle_lt_dec a b) => Hab. by apply Hw. destruct (Hw b a (fun x => opp (h x))) as [If [Hfh' Hfg']]. intro x. by apply @is_RInt_swap. by apply Rlt_le. exists (opp If) ; split. apply filterlim_ext with (fun x => opp (opp (h x))). move => x. by apply opp_opp. eapply (filterlim_comp _ _ _ (fun x => opp (h x)) opp). by apply Hfh'. now generalize (filterlim_opp If). by apply @is_RInt_swap. case: Hab => Hab. destruct (fun FF2 HF2 => filterlim_switch_dom F FF (locally_dist (fun ptd : SF_seq.SF_seq => SF_seq.seq_step (SF_seq.SF_lx ptd))) FF2 (fun ptd : SF_seq.SF_seq => SF_seq.pointed_subdiv ptd /\ SF_seq.SF_h ptd = Rmin a b /\ seq.last (SF_seq.SF_h ptd) (SF_seq.SF_lx ptd) = Rmax a b) HF2 (fun (x : U) ptd => scal (sign (b - a)) (Riemann_sum (f x) ptd)) (fun ptd => scal (sign (b - a)) (Riemann_sum g ptd)) h) as [If [Hh Hg]]. by apply locally_dist_filter. intros P [eP HP]. assert (Hn : 0 <= ((b - a) / eP)). apply Rdiv_le_0_compat. apply -> Rminus_le_0. apply Rlt_le, Hab. apply cond_pos. set n := (nfloor _ Hn). exists (SF_seq.SF_seq_f2 (fun x y => x) (SF_seq.unif_part (Rmin a b) (Rmax a b) n)). destruct (Riemann_fine_unif_part (fun x y => x) a b n). intros u v Huv. split. apply Rle_refl. exact Huv. now apply Rlt_le, Hab. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. split. apply H0. apply HP. apply Rle_lt_trans with (1 := H). apply Rlt_div_l. apply INRp1_pos. unfold n, nfloor. destruct nfloor_ex as [n' Hn']. simpl. rewrite Rmult_comm. apply Rlt_div_l. apply cond_pos. apply Hn'. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. 2: by apply Hfh. set (M := @norm_factor _ V). intros P [eps HP]. have He: 0 < (eps / (b - a)) / (2 * M). apply Rdiv_lt_0_compat. apply Rdiv_lt_0_compat. by apply eps. by rewrite -Rminus_lt_0. apply Rmult_lt_0_compat. by apply Rlt_0_2. apply norm_factor_gt_0. generalize (Hfg _ (locally_ball g (mkposreal _ He))) => {Hfg Hfh}. unfold filtermap ; apply filter_imp => x Hx. apply HP. case => t [Ht [Ha Hb]] /=. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite 2!scal_one. apply: norm_compat1. generalize (Riemann_sum_minus (f x) g t) => <-. refine (_ (Riemann_sum_norm (fun x0 : R => minus (f x x0) (g x0)) (fun _ => M * ((eps / (b - a)) / (2 * M))) t Ht _)). move => H ; apply Rle_lt_trans with (1 := H). rewrite Riemann_sum_const. rewrite Hb Ha. rewrite /scal /= /mult /=. replace ((b - a) * (M * ((eps / (b - a)) / (2 * M)))) with (eps / 2). rewrite {2}(double_var eps) -{1}(Rplus_0_l (eps / 2)). apply Rplus_lt_compat_r. apply Rdiv_lt_0_compat. by apply eps. by apply Rlt_0_2. field. split. apply Rgt_not_eq. apply Rlt_gt. by rewrite -Rminus_lt_0. apply Rgt_not_eq. apply norm_factor_gt_0. intros t0 Ht0. apply Rlt_le. apply (norm_compat2 _ _ (mkposreal _ He) (Hx t0)). exists If ; split. by apply Hh. by apply Hg. exists zero. rewrite -Hab in Hfh |- * => {b Hab}. split. apply filterlim_ext with (fun _ => zero). intros x. apply filterlim_locally_unique with (2 := Hfh x). apply is_RInt_point. apply filterlim_const. apply is_RInt_point. Qed. (** ** Continuous imply Riemann-integrable *) Section StepFun. Context {V : NormedModule R_AbsRing}. Lemma is_RInt_SF (f : R -> V) (s : SF_seq) : SF_sorted Rle s -> let a := SF_h s in let b := last (SF_h s) (unzip1 (SF_t s)) in is_RInt (SF_fun (SF_map f s) zero) a b (Riemann_sum f s). Proof. apply SF_cons_ind with (s := s) => {s} [ x0 | x0 s IH] Hsort a b. rewrite Riemann_sum_zero //. by apply is_RInt_point. - rewrite Riemann_sum_cons. apply is_RInt_Chasles with (SF_h s). move: (proj1 Hsort) ; unfold a ; clear IH Hsort a b ; simpl => Hab. eapply is_RInt_ext, is_RInt_const. rewrite /Rmin /Rmax ; case: Rle_dec => // _ x Hx. unfold SF_fun ; simpl. case: Rlt_dec => //= H. contradict H ; apply Rle_not_lt, Rlt_le, Hx. move: Hab Hx ; apply SF_cons_dec with (s := s) => {s} /= [x1 | x1 s] Hab Hx. case: Rle_dec (Rlt_le _ _ (proj2 Hx)) => //. case: Rlt_dec (proj2 Hx) => //. - eapply is_RInt_ext, IH. clear a IH. revert b ; simpl. rewrite /Rmin /Rmax ; case: Rle_dec => // Hab x Hx. rewrite /SF_fun /=. case: Rlt_dec => /= Hx0. contradict Hx0. apply Rle_not_lt. eapply Rle_trans, Rlt_le, Hx. by apply Hsort. move: Hab Hx Hsort ; apply SF_cons_dec with (s := s) => {s} [x1 | x1 s] //= Hab Hx Hsort. case: Hx => H H'. contradict H' ; by apply Rle_not_lt, Rlt_le. case: Rlt_dec => //= H. contradict H ; by apply Rle_not_lt, Rlt_le, Hx. contradict Hab. apply (sorted_last ((SF_h s) :: (unzip1 (SF_t s))) O (proj2 Hsort) (Nat.lt_0_succ _) (SF_h s)). by apply Hsort. Qed. Lemma ex_RInt_SF (f : R -> V) (s : SF_seq) : SF_sorted Rle s -> let a := SF_h s in let b := last (SF_h s) (unzip1 (SF_t s)) in ex_RInt (SF_fun (SF_map f s) zero) a b. Proof. intros. eexists. by apply is_RInt_SF. Qed. End StepFun. Lemma ex_RInt_continuous {V : CompleteNormedModule R_AbsRing} (f : R -> V) (a b : R) : (forall z, Rmin a b <= z <= Rmax a b -> continuous f z) -> ex_RInt f a b. Proof. wlog: f / (forall z : R, continuous f z) => [ Hw Cf | Cf _ ]. destruct (C0_extension_le f (Rmin a b) (Rmax a b)) as [g [Cg Hg]]. by apply Cf. apply ex_RInt_ext with g. intros x Hx ; apply Hg ; split ; apply Rlt_le ; apply Hx. apply Hw => // z _ ; by apply Cg. wlog: a b / (a < b) => [Hw | Hab]. case: (Rle_lt_dec a b) => Hab. case: Hab => Hab. by apply Hw. rewrite Hab ; by apply ex_RInt_point. apply ex_RInt_swap. by apply Hw. assert (H := unifcont_normed_1d f a b (fun x Hx => Cf x)). set n := fun eps => proj1_sig (seq_step_unif_part_ex a b (proj1_sig (H eps))). set s := fun eps => (SF_seq_f2 (fun x y => ((x+y)/2)%R) (unif_part a b (n eps))). set (f_eps := fun eps => fun x => match (Rle_dec a x) with | left _ => match (Rle_dec x b) with | left _ => SF_fun (SF_map f (s eps)) zero x | right _ => f x end | right _ => f x end). set F := fun (P : posreal -> Prop) => exists eps : posreal, forall x : posreal, x < eps -> P x. set If_eps := fun eps => Riemann_sum f (s eps). assert (FF : ProperFilter F). - assert (forall P, F P <-> at_right 0 (fun x => 0 < x /\ forall Hx, P (mkposreal x Hx))). split ; intros [e He]. exists e => y Hy H0 ; split => //. move => {} H0. apply He. eapply Rle_lt_trans, Hy. rewrite minus_zero_r. by apply Req_le, sym_eq, Rabs_pos_eq, Rlt_le. exists e ; intros [ y H0] Hy. apply He. apply Rabs_lt_between. rewrite minus_zero_r ; split. eapply Rlt_trans, H0. rewrite -Ropp_0 ; apply Ropp_lt_contravar, e. by apply Hy. by apply H0. case: (at_right_proper_filter 0) => H1 H2. split. + intros P HP. apply H0 in HP. destruct (H1 _ HP) as [x [Hx Px]]. by exists (mkposreal x Hx). destruct H2 ; split. + by exists (mkposreal _ Rlt_0_1). + intros. apply H0. eapply filter_imp. 2: apply filter_and ; apply H0. 2: apply H2. 2: apply H3. intuition ; apply H4. + intros. apply H0. eapply filter_imp. 2: apply H0 ; apply H3. intuition. by apply H4. by apply H2, H4. assert (Ha : forall eps, a = (SF_h (s eps))). intros eps ; simpl. rewrite /Rdiv ; ring. assert (Hb : forall eps, b = (last (SF_h (s eps)) (unzip1 (SF_t (s eps))))). intros eps. rewrite -(last_unif_part 0 a b (n eps)) ; simpl. apply f_equal. elim: {2 4}(n eps) (a + 1 * (b - a) / (INR (n eps) + 1))%R (2%nat) => [ | m IH] //= x0 k. by rewrite -IH. destruct (filterlim_RInt f_eps a b F FF f If_eps) as [If HI]. - intros eps. rewrite (Ha eps) (Hb eps). eapply is_RInt_ext. 2: apply (is_RInt_SF f (s eps)). rewrite -Hb -Ha. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ x [Hax Hxb]. rewrite /f_eps. case: Rle_dec (Rlt_le _ _ Hax) => // _ _. case: Rle_dec (Rlt_le _ _ Hxb) => // _ _. rewrite /s /SF_sorted SF_lx_f2. by apply unif_part_sort, Rlt_le. by apply Nat.lt_0_succ. - apply (filterlim_locally f_eps) => /= eps. rewrite /ball /= /fct_ball. exists eps => e He t. eapply ball_le. apply Rlt_le, He. apply (norm_compat1 (f t) (f_eps e t) e). rewrite /f_eps. case: Rle_dec => Hat. case: Rle_dec => Hta. rewrite SF_fun_incr. rewrite SF_map_lx SF_lx_f2. by apply unif_part_sort, Rlt_le. by apply Nat.lt_0_succ. rewrite SF_map_lx SF_lx_f2. rewrite last_unif_part head_unif_part. by split. by apply Nat.lt_0_succ. intros Hsort Ht. case: sorted_dec. + rewrite SF_map_lx SF_lx_f2. intros Hi ; set i := proj1_sig Hi. rewrite SF_map_ly (nth_map 0). apply (proj2_sig (H e)). by split. split ; eapply Rle_trans. 2: apply ptd_f2. rewrite SF_lx_f2 {1}(Ha e). apply sorted_head. apply unif_part_sort. by apply Rlt_le. eapply Nat.lt_trans, (proj2_sig Hi). eapply Nat.lt_trans ; apply Nat.lt_succ_diag_r. by apply Nat.lt_0_succ. by apply unif_part_sort, Rlt_le. intros x y Hxy. lra. rewrite SF_size_f2. move: (proj2 (proj2_sig Hi)). unfold i. case: (size (unif_part a b (n e))) (proj1_sig Hi) => [ | m] /= k Hk. by apply Nat.nlt_0_r in Hk. apply Nat.succ_lt_mono. eapply Nat.lt_trans, Hk. by apply Nat.lt_succ_diag_r. apply ptd_f2. by apply unif_part_sort, Rlt_le. intros x y Hxy. lra. rewrite SF_size_f2. move: (proj2 (proj2_sig Hi)). unfold i ; case: (size (unif_part a b (n e))) (proj1_sig Hi) => [ | m] /= k Hk. by apply Nat.nlt_0_r in Hk. apply Nat.succ_lt_mono. eapply Nat.lt_trans, Hk. by apply Nat.lt_succ_diag_r. rewrite SF_lx_f2 ; try by apply Nat.lt_0_succ. rewrite {2}(Hb e). eapply Rle_trans, (sorted_last _ i). apply Req_le. unfold s ; simpl. unfold i ; elim: {1 3 6}(n e) (2%nat) (a + 1 * (b - a) / (INR (n e) + 1))%R (proj1_sig Hi) (proj2 (proj2_sig Hi)) => [ | m IH] // k x0 j Hj. simpl in Hj ; by apply Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.nlt_0_r in Hj. case: j Hj => [ | j] Hj //=. rewrite -IH //. apply Nat.succ_lt_mono. rewrite size_mkseq. by rewrite size_mkseq in Hj. move: (unif_part_sort a b (n e) (Rlt_le _ _ Hab)). unfold s. elim: (unif_part a b (n e)) => [ | h] //=. case => [ | h0 l] IH // [Hh Hl]. move: (IH Hl) => /=. case: l Hl {IH} => //= ; split => // ; by apply Hl. rewrite size_mkseq in Hi, i |- *. apply Nat.succ_lt_mono. eapply Nat.lt_le_trans. eapply Nat.lt_trans, (proj2_sig Hi). by apply Nat.lt_succ_diag_r. rewrite /s. elim: (n e) (a) (b) => [ | m IH] // a' b'. apply le_n_S ; rewrite unif_part_S ; by apply IH. apply Rle_lt_trans with (norm (minus (nth 0 (unif_part a b (n e)) (S i)) (nth 0 (unif_part a b (n e)) i))). change norm with Rabs. apply Rabs_le_between ; rewrite Rabs_pos_eq. change minus with Rminus ; rewrite Ropp_minus_distr'. rewrite /i {i}. destruct Hi as [i [[H1 H2] H3]]. simpl sval. cut (nth 0 (unif_part a b (n e)) i <= nth 0 (SF_ly (s e)) i <= nth 0 (unif_part a b (n e)) (S i)). lra. rewrite SF_ly_f2 nth_behead (nth_pairmap 0). move: {-2 4}(S i) H2 => Si /= ; clear -H1 H3 ; lra. now apply SSR_leq, Nat.lt_le_incl. apply -> Rminus_le_0. apply (sorted_nth Rle (unif_part a b (n e))). by apply unif_part_sort, Rlt_le. move: (proj2 (proj2_sig Hi)). unfold i ; case: (size (unif_part a b (n e))) (proj1_sig Hi) => [ | m] j /= Hm. by apply Nat.nlt_0_r in Hm. apply Nat.succ_lt_mono. eapply Nat.lt_trans, Hm. by apply Nat.lt_succ_diag_r. eapply Rle_lt_trans. apply nth_le_seq_step. eapply Nat.lt_trans, (proj2_sig Hi). by apply Nat.succ_lt_mono. apply (proj2_sig (seq_step_unif_part_ex a b (proj1_sig (H e)))). rewrite SSR_leq. rewrite SF_size_ly. apply le_S_n ; rewrite -SF_size_lx. rewrite SF_lx_f2. by apply Nat.lt_le_incl, (proj2_sig Hi). by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. + intros Hi. move: Hsort Ht Hi. rewrite SF_map_lx SF_size_map SF_size_lx. rewrite SF_lx_f2. rewrite -SF_size_ly SF_ly_f2 size_behead size_pairmap size_mkseq. simpl (S (Peano.pred (S (S (n e)))) - 2)%nat. simpl (S (Peano.pred (S (S (n e)))) - 1)%nat. simpl (Peano.pred (S (S (n e))) - 1)%nat. rewrite Nat.sub_0_r. intros Hsort Ht Hi. rewrite SF_map_ly (nth_map 0). apply (proj2_sig (H e)). by split. split ; eapply Rle_trans. 2: apply ptd_f2. rewrite SF_lx_f2 {1}(Ha e). apply sorted_head. apply unif_part_sort. by apply Rlt_le. rewrite size_mkseq. eapply Nat.lt_trans ; apply Nat.lt_succ_diag_r. by apply Nat.lt_0_succ. by apply unif_part_sort, Rlt_le. intros x y Hxy. lra. rewrite SF_size_f2. rewrite size_mkseq. by apply Nat.lt_succ_diag_r. apply ptd_f2. by apply unif_part_sort, Rlt_le. intros x y Hxy. lra. rewrite SF_size_f2. rewrite size_mkseq. by apply Nat.lt_succ_diag_r. rewrite SF_lx_f2 ; try by apply Nat.lt_0_succ. rewrite {2}(Hb e). apply Req_le. rewrite (last_unzip1 _ 0). fold (SF_last 0 (s e)). rewrite SF_last_lx SF_lx_f2. by rewrite (last_nth 0) size_mkseq. apply Nat.lt_0_succ. apply Rle_lt_trans with (norm (minus (nth 0 (unif_part a b (n e)) (S (n e))) (nth 0 (unif_part a b (n e)) (n e)))). change norm with Rabs. apply Rabs_le_between ; rewrite Rabs_pos_eq. change minus with Rminus ; rewrite Ropp_minus_distr'. cut (nth 0 (unif_part a b (n e)) (n e) <= nth 0 (SF_ly (s e)) (n e) <= nth 0 (unif_part a b (n e)) (S (n e))). lra. rewrite SF_ly_f2 nth_behead (nth_pairmap 0). move: {-2 4}(S (n e)) Hi => Si /= ; clear ; lra. rewrite size_mkseq. apply SSR_leq, Nat.le_refl. apply -> Rminus_le_0. apply (sorted_nth Rle (unif_part a b (n e))). by apply unif_part_sort, Rlt_le. rewrite size_mkseq ; by apply Nat.lt_succ_diag_r. eapply Rle_lt_trans. apply nth_le_seq_step. rewrite size_mkseq ; by apply Nat.lt_succ_diag_r. apply (proj2_sig (seq_step_unif_part_ex a b (proj1_sig (H e)))). rewrite SSR_leq. rewrite SF_size_ly. apply le_S_n ; rewrite -SF_size_lx. rewrite SF_lx_f2. rewrite size_mkseq ; by apply Nat.le_refl. by apply Nat.lt_0_succ. by apply Nat.lt_0_succ. rewrite minus_eq_zero norm_zero ; by apply e. rewrite minus_eq_zero norm_zero ; by apply e. now exists If. Qed. (** ** Norm *) Section norm_RInt. Context {V : NormedModule R_AbsRing}. Lemma norm_RInt_le : forall (f : R -> V) (g : R -> R) (a b : R) (lf : V) (lg : R), a <= b -> (forall x, a <= x <= b -> norm (f x) <= g x) -> is_RInt f a b lf -> is_RInt g a b lg -> norm lf <= lg. Proof. intros f g a b lf lg Hab H Hf Hg. change (Rbar_le (norm lf) lg). apply (filterlim_le (F := Riemann_fine a b)) with (fun ptd : SF_seq => norm (scal (sign (b - a)) (Riemann_sum f ptd))) (fun ptd : SF_seq => scal (sign (b - a)) (Riemann_sum g ptd)). 3: apply Hg. exists (mkposreal _ Rlt_0_1) => ptd _ [Hptd [Hh Hl]]. destruct Hab as [Hab|Hab]. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite !scal_one. apply Riemann_sum_norm. by []. move => t. rewrite Hl Hh /Rmin /Rmax ; case: Rle_dec => [_|]. apply H. move => /Rnot_le_lt Hab'. elim (Rlt_not_le _ _ Hab). now apply Rlt_le. rewrite -> Rminus_diag_eq by now apply sym_eq. rewrite sign_0. rewrite 2!scal_zero_l. rewrite norm_zero ; by right. apply filterlim_comp with (locally lf). by apply Hf. by apply filterlim_norm. Qed. Lemma norm_RInt_le_const : forall (f : R -> V) (a b : R) (lf : V) (M : R), a <= b -> (forall x, a <= x <= b -> norm (f x) <= M) -> is_RInt f a b lf -> norm lf <= (b - a) * M. Proof. intros f a b lf M Hab H Hf. apply norm_RInt_le with (1 := Hab) (2 := H) (3 := Hf). apply: is_RInt_const. Qed. Lemma norm_RInt_le_const_abs : forall (f : R -> V) (a b : R) (lf : V) (M : R), (forall x, Rmin a b <= x <= Rmax a b -> norm (f x) <= M) -> is_RInt f a b lf -> norm lf <= Rabs (b - a) * M. Proof. intros f a b lf M H Hf. unfold Rabs. case Rcase_abs => Hab. apply Rminus_lt in Hab. rewrite Ropp_minus_distr. apply is_RInt_swap in Hf. rewrite <- norm_opp. apply norm_RInt_le_const with (3 := Hf). now apply Rlt_le. intros x Hx. apply H. now rewrite -> Rmin_right, Rmax_left by now apply Rlt_le. apply Rminus_ge in Hab. apply Rge_le in Hab. apply norm_RInt_le_const with (1 := Hab) (3 := Hf). intros x Hx. apply H. now rewrite -> Rmin_left, Rmax_right. Qed. End norm_RInt. (** * Specific Normed Modules *) (** Pairs *) Section prod. Context {U V : NormedModule R_AbsRing}. Lemma is_RInt_fct_extend_fst (f : R -> U * V) (a b : R) (l : U * V) : is_RInt f a b l -> is_RInt (fun t => fst (f t)) a b (fst l). Proof. intros Hf P [eP HP]. destruct (Hf (fun u : U * V => P (fst u))) as [ef Hf']. exists eP => y Hy. apply HP. apply Hy. exists ef => y H1 H2. replace (Riemann_sum (fun t : R => fst (f t)) y) with (fst (Riemann_sum f y)). by apply Hf'. clear. apply SF_cons_ind with (s := y) => {y} [x0 | [x1 y0] y IH]. by rewrite /Riemann_sum /=. by rewrite ?Riemann_sum_cons /= IH. Qed. Lemma is_RInt_fct_extend_snd (f : R -> U * V) (a b : R) (l : U * V) : is_RInt f a b l -> is_RInt (fun t => snd (f t)) a b (snd l). Proof. intros Hf P [eP HP]. destruct (Hf (fun u : U * V => P (snd u))) as [ef Hf']. exists eP => y Hy. apply HP. apply Hy. exists ef => y H1 H2. replace (Riemann_sum (fun t : R => snd (f t)) y) with (snd (Riemann_sum f y)). by apply Hf'. clear. apply SF_cons_ind with (s := y) => {y} [x0 | [x1 y0] y IH]. by rewrite /Riemann_sum /=. by rewrite ?Riemann_sum_cons /= IH. Qed. Lemma is_RInt_fct_extend_pair (f : R -> U * V) (a b : R) lu lv : is_RInt (fun t => fst (f t)) a b lu -> is_RInt (fun t => snd (f t)) a b lv -> is_RInt f a b (lu,lv). Proof. move => H1 H2. apply filterlim_locally => eps. generalize (proj1 (filterlim_locally _ _) H1 eps) => {H1} ; intros [d1 H1]. generalize (proj1 (filterlim_locally _ _) H2 eps) => {H2} ; intros [d2 H2]. simpl in H1, H2. exists (mkposreal _ (Rmin_stable_in_posreal d1 d2)) => /= ptd Hstep Hptd. rewrite (Riemann_sum_pair f ptd) ; simpl. split. apply H1 => //. by apply Rlt_le_trans with (2 := Rmin_l d1 d2). apply H2 => //. by apply Rlt_le_trans with (2 := Rmin_r d1 d2). Qed. Lemma ex_RInt_fct_extend_fst (f : R -> U * V) (a b : R) : ex_RInt f a b -> ex_RInt (fun t => fst (f t)) a b. Proof. intros [l Hl]. exists (fst l). by apply is_RInt_fct_extend_fst. Qed. Lemma ex_RInt_fct_extend_snd (f : R -> U * V) (a b : R) : ex_RInt f a b -> ex_RInt (fun t => snd (f t)) a b. Proof. intros [l Hl]. exists (snd l). by apply is_RInt_fct_extend_snd. Qed. Lemma ex_RInt_fct_extend_pair (f : R -> U * V) (a b : R) : ex_RInt (fun t => fst (f t)) a b -> ex_RInt (fun t => snd (f t)) a b -> ex_RInt f a b. Proof. move => [l1 H1] [l2 H2]. exists (l1,l2). by apply is_RInt_fct_extend_pair. Qed. Lemma RInt_fct_extend_pair (U_RInt : (R -> U) -> R -> R -> U) (V_RInt : (R -> V) -> R -> R -> V) : (forall f a b l, is_RInt f a b l -> U_RInt f a b = l) -> (forall f a b l, is_RInt f a b l -> V_RInt f a b = l) -> forall f a b l, is_RInt f a b l -> (U_RInt (fun t => fst (f t)) a b, V_RInt (fun t => snd (f t)) a b) = l. Proof. intros HU HV f a b l Hf. apply injective_projections ; simpl. apply HU ; by apply is_RInt_fct_extend_fst. apply HV ; by apply is_RInt_fct_extend_snd. Qed. End prod. (** * The total function [RInt] *) Section RInt. Context {V : CompleteNormedModule R_AbsRing}. Definition RInt (f : R -> V) (a b : R) := iota (is_RInt f a b). Lemma is_RInt_unique (f : R -> V) (a b : R) (l : V) : is_RInt f a b l -> RInt f a b = l. Proof. apply iota_filterlim_locally. Qed. Lemma RInt_correct (f : R -> V) (a b : R) : ex_RInt f a b -> is_RInt f a b (RInt f a b). Proof. intros [If HIf]. erewrite is_RInt_unique ; exact HIf. Qed. Lemma opp_RInt_swap : forall f a b, ex_RInt f a b -> opp (RInt f a b) = RInt f b a. Proof. intros f a b [If HIf]. apply sym_eq, is_RInt_unique. apply: is_RInt_swap. apply RInt_correct. now exists If. Qed. (** Correction of RInt *) (* Lemma is_RInt_lim_seq (f : R -> R) (a b : R) : forall If : R, is_RInt f a b If -> is_lim_seq (RInt_val f a b) If. Proof. wlog: a b /(a < b) => [Hw | Hab] If Hex. case: (Rle_lt_dec a b) => Hab. case: Hab => Hab. by apply Hw. Focus 2. cut (is_lim_seq (RInt_val f b a) (-If)). intros H. apply is_lim_seq_spec in H. apply is_lim_seq_spec. move => eps ; case: (H eps) => {H} N H ; exists N => n Hn. rewrite RInt_val_swap. rewrite /opp /=. replace (- RInt_val f b a n - If) with (- (RInt_val f b a n - - If)) by ring. rewrite Rabs_Ropp ; by apply H. apply Hw. exact: Hab. exact: is_RInt_swap. assert (forall n, RInt_val f a a n = 0). move => n ; by rewrite RInt_val_point. rewrite -Hab in Hex |- * => {Hab b}. replace If with 0. apply is_lim_seq_spec. move => eps ; exists O => n _. rewrite H. rewrite Rminus_0_r Rabs_R0 ; apply eps. suff H0 : forall eps : posreal, Rabs If < eps. apply Rle_antisym ; apply le_epsilon => e He ; set eps := mkposreal e He ; apply Rlt_le. rewrite -(Rminus_eq_0 If) ; apply Rplus_lt_compat_l, Rle_lt_trans with (Rabs If). exact: Rabs_maj2. by apply (H0 eps). rewrite Rplus_0_l ; apply Rle_lt_trans with (Rabs If). exact: Rle_abs. by apply (H0 eps). generalize (proj1 (filterlim_locally _ If) Hex). clear Hex. intros Hex. move => eps ; move: (Hex eps) => {Hex}. rewrite Rminus_eq_0 sign_0. case => alpha Halpha. set ptd := @SF_nil R a. replace If with (If - 0 * Riemann_sum f ptd) by ring. rewrite Rabs_minus_sym. apply Halpha. by apply alpha. split. move => i /= Hi. by apply Nat.nlt_0_r in Hi. split. rewrite /Rmin ; by case: Rle_dec (Rle_refl a). rewrite /Rmax ; by case: Rle_dec (Rle_refl a). (* * Preuve dans la cas a < b *) apply is_lim_seq_spec. move => eps. generalize (proj1 (filterlim_locally _ If) Hex). clear Hex. intros Hex. case: (Hex eps) => {Hex} alpha Hex. (* ** Trouver N *) have HN : 0 <= (b-a)/alpha. apply Rdiv_le_0_compat. apply -> Rminus_le_0 ; apply Rlt_le, Hab. by apply alpha. set N := (nfloor _ HN). exists N => n Hn. rewrite -Rabs_Ropp. set ptd := SF_seq_f2 (fun x y => (x+y)/2) (unif_part a b n). (* ** Appliquer Hex *) replace (- (RInt_val f a b n - If)) with (If - sign (b - a) * Riemann_sum f ptd). rewrite Rabs_minus_sym. apply: Hex. apply Rle_lt_trans with ((b-a)/(INR n + 1)). suff : forall i, (S i < size (SF_lx ptd))%nat -> nth 0 (SF_lx ptd) (S i) - nth 0 (SF_lx ptd) i = (b-a)/(INR n + 1). elim: (SF_lx ptd) => /= [ | x0]. move => _ ; apply Rdiv_le_0_compat ; [ by apply Rlt_le, Rgt_minus | by apply INRp1_pos]. case => /=[ | x1 s] IH Hs. apply Rdiv_le_0_compat ; [ by apply Rlt_le, Rgt_minus | by apply INRp1_pos]. replace (seq_step _) with (Rmax (Rabs (x1 - x0)) (seq_step (x1::s))) by auto. rewrite (Hs _ (lt_n_S _ _ (Nat.lt_0_succ _))) Rabs_right. apply Rmax_lub. by apply Rle_refl. apply IH => i Hi. by apply (Hs _ (lt_n_S _ _ Hi)). apply Rle_ge, Rdiv_le_0_compat ; [ by apply Rlt_le, Rgt_minus | by apply INRp1_pos]. rewrite SF_lx_f2. replace (head 0%R (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n) by auto. rewrite size_mkseq => i Hi ; rewrite !nth_mkseq ?S_INR. field ; apply Rgt_not_eq, INRp1_pos. apply SSR_leq ; by intuition. apply SSR_leq ; by intuition. eapply Nat.lt_0_succ. apply Rle_lt_trans with ((b-a)/(INR N + 1)). apply Rmult_le_compat_l. by apply Rlt_le, Rgt_minus. apply Rinv_le_contravar. by apply INRp1_pos. by apply Rplus_le_compat_r, le_INR. apply Rlt_div_l. by apply INRp1_pos. rewrite Rmult_comm ; apply Rlt_div_l. by apply alpha. rewrite /N /nfloor ; case: nfloor_ex => N' HN' /=. by apply HN'. split. move => i. rewrite SF_size_f2 size_mkseq => Hi ; simpl in Hi. rewrite SF_ly_f2 SF_lx_f2. 2: apply Nat.lt_0_succ. replace (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n) by auto. rewrite nth_behead (nth_pairmap 0). replace (nth 0 (0 :: unif_part a b n) (S i)) with (nth 0 (unif_part a b n) i) by auto. have : nth 0 (unif_part a b n) i <= nth 0 (unif_part a b n) (S i). apply (sorted_nth Rle). by apply unif_part_sort, Rlt_le. by rewrite size_mkseq. move : (nth 0 (unif_part a b n) i) (nth 0 (unif_part a b n) (S i)) => x y Hxy. lra. apply SSR_leq ; rewrite size_mkseq ; by intuition. split. rewrite /Rmin /= ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. field ; apply Rgt_not_eq, INRp1_pos. rewrite -nth_last SF_lx_f2. 2: apply Nat.lt_0_succ. rewrite size_mkseq nth_mkseq ?S_INR /=. rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. field ; apply Rgt_not_eq, INRp1_pos. by []. rewrite Ropp_minus_distr'. apply f_equal. rewrite -> sign_eq_1 by exact: Rlt_Rminus. rewrite Rmult_1_l. by []. Qed. *) (** ** Usual rewritings *) Lemma RInt_ext (f g : R -> V) (a b : R) : (forall x, Rmin a b < x < Rmax a b -> f x = g x) -> RInt f a b = RInt g a b. Proof. intros Hfg. apply eq_close. apply: close_iota ; split ; apply is_RInt_ext. exact Hfg. intros t Ht. now apply sym_eq, Hfg. Qed. Lemma RInt_point (a : R) (f : R -> V) : RInt f a a = zero. Proof. apply is_RInt_unique. exact: is_RInt_point. Qed. Lemma RInt_const (a b : R) (c : V) : RInt (fun _ => c) a b = scal (b - a) c. Proof. apply is_RInt_unique. exact: is_RInt_const. Qed. (* Lemma RInt_comp_opp (f : R -> V) (a b : R) : ex_RInt f (-a) (-b) -> RInt (fun y => f (- y)) a b = opp (RInt f (-a) (-b)). Proof. intros Hf. apply is_RInt_unique. apply: is_RInt_comp_opp. case: (Req_dec a b) => [<- {b} | Hab]. by rewrite ?RInt_point. wlog: a b Hab / (a < b) => [Hw | {Hab} Hab]. case: (Rle_lt_dec a b) => Hab'. case: Hab' => // Hab'. by apply Hw. rewrite -(RInt_swap _ b) -(RInt_swap _ (-b)). rewrite Hw => //. by apply Rlt_not_eq. rewrite /RInt. case: Rle_dec (Rlt_le _ _ Hab) => // _ _. case: Rle_dec (Rlt_not_le _ _ (Ropp_lt_contravar _ _ Hab)) => // _ _. rewrite -Rbar_opp_real. apply f_equal. rewrite -Lim_seq_opp. apply Lim_seq_ext => n. rewrite RInt_val_swap /RInt_val Riemann_sum_opp. simpl opp ; apply f_equal. rewrite Riemann_sum_map SF_map_f2. replace (unif_part (- b) (- a) n) with (map Ropp (unif_part b a n)). Focus 2. apply eq_from_nth with 0. by rewrite size_map !size_mkseq. rewrite size_map !size_mkseq => i Hi. rewrite (nth_map 0 0). rewrite ?(nth_mkseq 0) => //. field ; rewrite -S_INR ; apply not_0_INR, sym_not_eq, O_S. by rewrite size_mkseq. elim: (unif_part b a n) => /= [ | x0 s IH]. rewrite /Riemann_sum /=. apply opp_zero. destruct s as [ | x1 s]. rewrite /Riemann_sum /=. apply opp_zero. rewrite (SF_cons_f2 _ (- x0)). 2: by apply Nat.lt_0_succ. rewrite Riemann_sum_cons /=. rewrite (SF_cons_f2 _ (x0)). 2: by apply Nat.lt_0_succ. rewrite Riemann_sum_cons /=. rewrite -IH /opp /plus /= Ropp_plus_distr. apply f_equal2. replace (- ((x0 + x1) / 2)) with ((- x0 + - x1) / 2) by field. rewrite /scal /= /mult /=. ring. apply f_equal. clear. by []. Qed. *) Lemma RInt_comp_lin (f : R -> V) (u v a b : R) : ex_RInt f (u * a + v) (u * b + v) -> RInt (fun y => scal u (f (u * y + v))) a b = RInt f (u * a + v) (u * b + v). Proof. intros Hf. apply is_RInt_unique. apply: is_RInt_comp_lin. exact: RInt_correct. Qed. Lemma RInt_Chasles : forall f a b c, ex_RInt f a b -> ex_RInt f b c -> plus (RInt f a b) (RInt f b c) = RInt f a c. Proof. intros f a b c H1 H2. apply sym_eq, is_RInt_unique. apply: is_RInt_Chasles ; now apply RInt_correct. Qed. Lemma RInt_scal (f : R -> V) (a b l : R) : ex_RInt f a b -> RInt (fun x => scal l (f x)) a b = scal l (RInt f a b). Proof. intros Hf. apply is_RInt_unique. apply: is_RInt_scal. exact: RInt_correct. Qed. Lemma RInt_opp (f : R -> V) (a b : R) : ex_RInt f a b -> RInt (fun x => opp (f x)) a b = opp (RInt f a b). Proof. intros Hf. apply is_RInt_unique. apply: is_RInt_opp. exact: RInt_correct. Qed. Lemma RInt_plus : forall f g a b, ex_RInt f a b -> ex_RInt g a b -> RInt (fun x => plus (f x) (g x)) a b = plus (RInt f a b) (RInt g a b). Proof. intros f g a b Hf Hg. apply is_RInt_unique. apply: is_RInt_plus ; now apply RInt_correct. Qed. Lemma RInt_minus : forall f g a b, ex_RInt f a b -> ex_RInt g a b -> RInt (fun x => minus (f x) (g x)) a b = minus (RInt f a b) (RInt g a b). Proof. intros f g a b Hf Hg. apply is_RInt_unique. apply: is_RInt_minus ; now apply RInt_correct. Qed. End RInt. (** ** Order *) Lemma is_RInt_ge_0 (f : R -> R) (a b If : R) : a <= b -> is_RInt f a b If -> (forall x, a < x < b -> 0 <= f x) -> 0 <= If. Proof. intros Hab HIf Hf. set (f' := fun x => if Rle_dec x a then 0 else if Rle_dec b x then 0 else f x). apply is_RInt_ext with (g := f') in HIf. apply closed_filterlim_loc with (1 := HIf) (3 := closed_ge 0). unfold Riemann_fine, within. apply filter_forall. intros ptd Hptd. replace 0 with (scal (sign (b - a)) (Riemann_sum (fun _ => 0) ptd)). apply Rmult_le_compat_l. apply sign_ge_0. now apply Rge_le, Rge_minus, Rle_ge. apply Riemann_sum_le. apply Hptd. intros t _. unfold f'. case Rle_dec as [H1|H1]. apply Rle_refl. case Rle_dec as [H2|H2]. apply Rle_refl. apply Hf. now split; apply Rnot_le_lt. rewrite Riemann_sum_const. by rewrite !scal_zero_r. rewrite (Rmin_left _ _ Hab) (Rmax_right _ _ Hab). intros x Hx. unfold f'. case Rle_dec as [H1|H1]. now elim (Rle_not_lt _ _ H1). case Rle_dec as [H2|H2]. now elim (Rle_not_lt _ _ H2). easy. Qed. Lemma RInt_ge_0 (f : R -> R) (a b : R) : a <= b -> ex_RInt f a b -> (forall x, a < x < b -> 0 <= f x) -> 0 <= RInt f a b. Proof. intros Hab Hf Hpos. apply: is_RInt_ge_0 Hab _ Hpos. exact: RInt_correct. Qed. Lemma is_RInt_le (f g : R -> R) (a b If Ig : R) : a <= b -> is_RInt f a b If -> is_RInt g a b Ig -> (forall x, a < x < b -> f x <= g x) -> If <= Ig. Proof. intros Hab Hf Hg Hfg. apply Rminus_le_0. apply: is_RInt_ge_0 Hab _ _. apply: is_RInt_minus Hg Hf. intros x Hx. apply -> Rminus_le_0. apply Hfg, Hx. Qed. Lemma RInt_le (f g : R -> R) (a b : R) : a <= b -> ex_RInt f a b -> ex_RInt g a b-> (forall x, a < x < b -> f x <= g x) -> RInt f a b <= RInt g a b. Proof. intros Hab Hf Hg Hfg. apply: is_RInt_le Hab _ _ Hfg. exact: RInt_correct. exact: RInt_correct. Qed. Lemma RInt_gt_0 (g : R -> R) (a b : R) : (a < b) -> (forall x, a < x < b -> (0 < g x)) -> (forall x, a <= x <= b -> continuous g x) -> 0 < RInt g a b. Proof. intros Hab Hg Cg. set c := (a + b) / 2. assert (Hc : a < c < b). unfold c ; lra. assert (H : locally c (fun (x : R) => g c / 2 <= g x)). specialize (Hg _ Hc). specialize (Cg c (conj (Rlt_le _ _ (proj1 Hc)) (Rlt_le _ _ (proj2 Hc)))). case: (proj1 (filterlim_locally _ _) Cg (pos_div_2 (mkposreal _ Hg))) => /= d Hd. exists d => /= x Hx. specialize (Hd _ Hx). rewrite /ball /= /AbsRing_ball in Hd. apply Rabs_lt_between' in Hd. field_simplify (g c - g c / 2) in Hd. by apply Rlt_le, Hd. assert (Ig : ex_RInt g a b). apply @ex_RInt_continuous. rewrite Rmin_left. rewrite Rmax_right. intros. now apply Cg. by apply Rlt_le. by apply Rlt_le. case: H => /= d Hd. set a' := Rmax (c - d / 2) ((a + c) / 2). set b' := Rmin (c + d / 2) ((c + b) / 2). assert (Hab' : a' < b'). apply Rlt_trans with c. apply Rmax_case. generalize (cond_pos d) ; lra. lra. apply Rmin_case. generalize (cond_pos d) ; lra. lra. assert (Ha' : a < a' < b). split. eapply Rlt_le_trans, Rmax_r. lra. apply Rmax_case. generalize (cond_pos d) ; lra. lra. assert (Hb' : a < b' < b). split. lra. eapply Rle_lt_trans. apply Rmin_r. lra. assert (ex_RInt g a a'). eapply @ex_RInt_Chasles_1, Ig ; split ; by apply Rlt_le, Ha'. assert (ex_RInt g a' b). eapply @ex_RInt_Chasles_2, Ig ; split ; by apply Rlt_le, Ha'. assert (ex_RInt g a' b'). eapply @ex_RInt_Chasles_1, H0 ; split => // ; apply Rlt_le => //. by apply Hb'. assert (ex_RInt g b' b). eapply @ex_RInt_Chasles_2, H0 ; split => // ; apply Rlt_le => //. by apply Hb'. rewrite -(RInt_Chasles g a a' b) //. apply Rplus_le_lt_0_compat. apply (is_RInt_ge_0 g a a'). by apply Rlt_le, Ha'. exact: RInt_correct. intros ; apply Rlt_le, Hg ; split. by apply H3. eapply Rlt_trans, Ha'. apply H3. rewrite -(RInt_Chasles g a' b' b) //. apply Rplus_lt_le_0_compat. apply Rlt_le_trans with ((b' - a') * (g c / 2)). specialize (Hg _ Hc). apply Rmult_lt_0_compat. by apply -> Rminus_lt_0. apply Rdiv_lt_0_compat => //. by apply Rlt_0_2. eapply is_RInt_le. apply Rlt_le, Hab'. apply @is_RInt_const. exact: RInt_correct. intros ; apply Hd. rewrite (double_var d). apply Rabs_lt_between' ; split. eapply Rlt_trans, H3. eapply Rlt_le_trans, Rmax_l. apply Rminus_lt_0 ; ring_simplify. by apply is_pos_div_2. eapply Rlt_trans. apply H3. eapply Rle_lt_trans. apply Rmin_l. apply Rminus_lt_0 ; ring_simplify. by apply is_pos_div_2. eapply is_RInt_ge_0. 2: exact: RInt_correct. apply Rlt_le, Hb'. intros ; apply Rlt_le, Hg. split. eapply Rlt_trans, H3. by apply Hb'. by apply H3. Qed. Lemma RInt_lt (f g : R -> R) (a b : R) : a < b -> (forall x : R, a <= x <= b ->continuous g x) -> (forall x : R, a <= x <= b ->continuous f x) -> (forall x : R, a < x < b -> f x < g x) -> RInt f a b < RInt g a b. Proof. intros Hab Cg Cf Hfg. apply Rminus_lt_0. assert (Ig : ex_RInt g a b). apply @ex_RInt_continuous. rewrite Rmin_left. rewrite Rmax_right. intros. now apply Cg. by apply Rlt_le. by apply Rlt_le. assert (ex_RInt f a b). apply @ex_RInt_continuous. rewrite Rmin_left. rewrite Rmax_right. intros. now apply Cf. by apply Rlt_le. by apply Rlt_le. rewrite -[Rminus]/(@minus R_AbelianGroup) -RInt_minus //. apply RInt_gt_0 => //. now intros ; apply -> Rminus_lt_0 ; apply Hfg. intros. apply @continuous_minus. by apply Cg. by apply Cf. Qed. Lemma abs_RInt_le_const : forall (f : R -> R) a b M, a <= b -> ex_RInt f a b -> (forall t, a <= t <= b -> Rabs (f t) <= M) -> Rabs (RInt f a b) <= (b - a) * M. Proof. intros f a b M Hab If H. apply: (norm_RInt_le_const f) => //. exact: RInt_correct. Qed. (** * Equivalence with standard library *) Lemma ex_RInt_Reals_aux_1 (f : R -> R) (a b : R) : forall pr : Riemann_integrable f a b, is_RInt f a b (RiemannInt pr). Proof. wlog: a b / (a < b) => [Hw | Hab]. case: (total_order_T a b) => [[Hab | <-] | Hab] pr. by apply Hw. rewrite RiemannInt_P9. apply: is_RInt_point. move: (RiemannInt_P1 pr) => pr'. rewrite (RiemannInt_P8 pr pr'). apply: is_RInt_swap. apply Hw => //. rewrite /is_RInt. intros pr. apply filterlim_locally. unfold Riemann_fine. rewrite Rmin_left. 2: now apply Rlt_le. rewrite Rmax_right. 2: now apply Rlt_le. rewrite -> sign_eq_1 by exact: Rlt_Rminus. cut (forall (phi : StepFun a b) (eps : posreal), exists alpha : posreal, forall ptd : SF_seq, pointed_subdiv ptd -> seq_step (SF_lx ptd) < alpha -> SF_h ptd = a -> last (SF_h ptd) (unzip1 (SF_t ptd)) = b -> Rabs (RiemannInt_SF phi - 1 * Riemann_sum phi ptd) <= eps). intros H. rewrite /RiemannInt /= -/(Rminus _ _) => eps ; case: RiemannInt_exists => If HIf. set eps2 := pos_div_2 eps. set eps4 := pos_div_2 eps2. (* RInt (f-phi) < eps/4 *) case: (HIf _ (cond_pos eps4)) => {HIf} N HIf. case: (nfloor_ex (/eps4) (Rlt_le _ _ (Rinv_0_lt_compat _ (cond_pos eps4)))) => n Hn. move: (HIf (N+n)%nat (Nat.le_add_r _ _)) => {HIf}. rewrite /phi_sequence /R_dist ; case: pr => phi [psi pr] ; simpl RiemannInt_SF => HIf. (* RInt psi < eps/4*) have H0 : Rabs (RiemannInt_SF psi) < eps4. apply Rlt_le_trans with (1 := proj2 pr). rewrite -(Rinv_involutive eps4 (Rgt_not_eq _ _ (cond_pos eps4))) /=. apply Rle_Rinv. apply Rinv_0_lt_compat, eps4. intuition. apply Rlt_le, Rlt_le_trans with (1 := proj2 Hn). apply Rplus_le_compat_r. apply le_INR, MyNat.le_add_l. (* Rsum phi < eps/4 and Rsum psi < eps/4 *) case: (H phi eps4) => alpha0 Hphi. case: (H psi eps4) => {H} alpha1 Hpsi. have Halpha : (0 < Rmin alpha0 alpha1). apply Rmin_case_strong => _ ; [apply alpha0 | apply alpha1]. set alpha := mkposreal _ Halpha. exists alpha => ptd Hstep [Hsort [Ha Hb]]. rewrite (double_var eps) 1?(double_var (eps/2)) ?Rplus_assoc. rewrite /ball /= /AbsRing_ball /= /abs /=. rewrite Rabs_minus_sym. replace (_-_) with (-(RiemannInt_SF phi - If) + (RiemannInt_SF phi - Riemann_sum f ptd)) ; [ | rewrite /scal /= /mult /= ; by ring_simplify ]. apply Rle_lt_trans with (1 := Rabs_triang _ _), Rplus_lt_le_compat. rewrite Rabs_Ropp ; apply HIf. clear HIf ; replace (_-_) with ((RiemannInt_SF phi - 1* Riemann_sum phi ptd) + (Riemann_sum phi ptd - Riemann_sum f ptd)) ; [ | by ring_simplify]. apply Rle_trans with (1 := Rabs_triang _ _), Rplus_le_compat. apply Hphi => //. apply Rlt_le_trans with (1 := Hstep) ; rewrite /alpha ; apply Rmin_l. rewrite -Ropp_minus_distr' Rabs_Ropp. change Rminus with (@minus R_AbelianGroup). rewrite -Riemann_sum_minus. have H1 : (forall t : R, SF_h ptd <= t <= last (SF_h ptd) (SF_lx ptd) -> Rabs (f t - phi t) <= psi t). move => t Ht. apply pr ; move: (Rlt_le _ _ Hab) ; rewrite /Rmin /Rmax ; case: Rle_dec => // _ _ ; rewrite -Ha -Hb //. apply Rle_trans with (1 := Riemann_sum_norm (fun t => f t - phi t) _ _ Hsort H1). apply Rle_trans with (1 := Rle_abs _). replace (Riemann_sum psi ptd) with (-(RiemannInt_SF psi - 1* Riemann_sum psi ptd) + RiemannInt_SF psi) ; [ | by ring_simplify]. apply Rle_trans with (1 := Rabs_triang _ _), Rplus_le_compat. rewrite Rabs_Ropp ; apply Hpsi => //. apply Rlt_le_trans with (1 := Hstep) ; rewrite /alpha ; apply Rmin_r. apply Rlt_le, H0. (* forall StepFun *) case => phi [lx [ly Hphi]] eps /= ; rewrite /RiemannInt_SF /subdivision /subdivision_val ; move: (Rlt_le _ _ Hab) ; case: Rle_dec => //= _ _. clear pr. move: (Rlt_le _ _ Hab) Hphi => {Hab} ; elim: lx ly eps a b => [ | lx0 lx IH] ly eps a b Hab. (* lx = [::] *) case ; intuition ; by []. case: lx IH ly => [ | lx1 lx] IH ; case => [ {IH} | ly0 ly] Had ; try by (case: Had ; intuition ; by []). (* lx = [:: lx0] *) exists eps => ptd Hptd Hstep (*Hsort*) Ha Hb /=. rewrite Riemann_sum_zero. rewrite Rmult_0_r Rminus_0_r Rabs_R0 ; apply Rlt_le, eps. by apply ptd_sort. rewrite /SF_lx /= Hb Ha ; case: Had => {Ha Hb} _ [Ha [Hb _]] ; move: Ha Hb ; rewrite /Rmin /Rmax ; case: Rle_dec => // _ <- <- //. (* lx = [:: lx0, lx1 & lx] *) set eps2 := pos_div_2 eps ; set eps4 := pos_div_2 eps2. (* * alpha1 from IH *) case: (IH ly eps4 lx1 b) => {IH}. replace b with (last 0 (cons lx0 (cons lx1 lx))). apply (sorted_last (cons lx0 (cons lx1 lx)) 1%nat) with (x0 := 0). apply sorted_compat; apply Had. simpl ; apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. case: Had => /= _ [_ [Hb _]] ; move: Hb ; rewrite /Rmax ; case : Rle_dec => //= _ ; elim: (lx) lx1 => //= h s IH _ ; apply IH. apply (StepFun_P7 Hab Had). move => /= alpha1 IH. (* * alpha2 from H *) cut (forall eps : posreal, exists alpha : posreal, forall ptd : SF_seq, pointed_subdiv ptd -> seq_step (SF_lx ptd) < alpha -> SF_h ptd = a -> last (SF_h ptd) (SF_lx ptd) = lx1 -> Rabs (ly0 * (lx1 - lx0) - Riemann_sum phi ptd) <= eps). intros H. case: (H eps4) => {H} alpha2 H. (* * alpha3 from (fmax - fmin) *) set fmin1 := foldr Rmin 0 (ly0::ly). set fmin2 := foldr Rmin 0 (map phi (lx0::lx1::lx)). set fmin := Rmin fmin1 fmin2. set fmax1 := foldr Rmax 0 (ly0::ly). set fmax2 := foldr Rmax 0 (map phi (lx0::lx1::lx)). set fmax := Rmax fmax1 fmax2. have Ha3 : (0 < eps4 / (Rmax (fmax - fmin) 1)). apply Rdiv_lt_0_compat ; [ apply eps4 | ]. apply Rlt_le_trans with (2 := RmaxLess2 _ _), Rlt_0_1. set alpha3 := mkposreal _ Ha3. (* * alpha = Rmin (Rmin alpha1 alpha2) alpha3 *) have Halpha : (0 < Rmin (Rmin alpha1 alpha2) alpha3). apply Rmin_case_strong => _ ; [ | apply alpha3]. apply Rmin_case_strong => _ ; [ apply alpha1 | apply alpha2]. set alpha := mkposreal _ Halpha. exists alpha => ptd Hptd Hstep Ha Hb. suff Hff : forall x, a <= x <= b -> fmin <= phi x <= fmax. suff Hab1 : forall i, (i <= SF_size ptd)%nat -> a <= nth 0 (SF_lx ptd) i <= b. suff Hab0 : a <= lx1 <= b. rewrite (SF_Chasles _ _ lx1 (SF_h ptd)) /=. replace (_-_) with ((ly0 * (lx1 - lx0) - 1* Riemann_sum phi (SF_cut_down' ptd lx1 (SF_h ptd))) + (Int_SF ly (cons lx1 lx) - 1* Riemann_sum phi (SF_cut_up' ptd lx1 (SF_h ptd)))) ; [ | rewrite /plus /= ; by ring_simplify]. rewrite (double_var eps) ; apply Rle_trans with (1 := Rabs_triang _ _), Rplus_le_compat. (* partie [lx0;lx1] *) set ptd_r_last := (SF_last a (SF_cut_down' ptd lx1 a)). set ptd_r_belast := (SF_belast (SF_cut_down' ptd lx1 a)). set ptd_r := SF_rcons ptd_r_belast (lx1, (fst (SF_last a ptd_r_belast) + lx1)/2). move: (H ptd_r) => {} H. replace (_-_) with ((ly0 * (lx1 - lx0) - Riemann_sum phi ptd_r) + (phi ((fst (SF_last 0 ptd_r_belast) + lx1)/2) - phi (snd ptd_r_last)) * (lx1 - fst (SF_last 0 ptd_r_belast))). rewrite (double_var (eps/2)) ; apply Rle_trans with (1 := Rabs_triang _ _), Rplus_le_compat. (* * appliquer H *) apply: H => {IH}. 3: { rewrite -Ha /ptd_r /ptd_r_belast. move: (proj1 Hab0) ; rewrite -Ha. apply SF_cons_dec with (s := ptd) => [x0 | [x0 y0] s] //= Hx0 ; by case: Rle_dec. } 3 : { revert ptd_r_belast ptd_r ; move: (proj1 Hab0) ; rewrite -Ha ; apply SF_cons_ind with (s := ptd) => [x0 | [x0 y0] s IH] //= Hx0 ; case: Rle_dec => //= _. by rewrite unzip1_rcons /= last_rcons. } (* ** ptd_r est une subdivision pointée *) revert ptd_r_belast ptd_r Hptd ; apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH ] Hptd. rewrite /SF_cut_down' /SF_belast /SF_last /SF_rcons /SF_ly /=. rewrite -?(last_map (@fst R R)) -unzip1_fst /=. rewrite ?unzip2_rcons ?unzip1_rcons /=. rewrite ?unzip1_belast ?unzip2_belast /=. rewrite ?unzip1_behead ?unzip2_behead /=. case => /= [ _ | i Hi] . case: Rle_dec => //= Hx0 ; lra. contradict Hi ; apply Nat.le_ngt. case: Rle_dec => //= Hx0 ; rewrite /SF_size /= ; apply le_n_S, Nat.le_0_l. move: (IH (ptd_cons _ _ Hptd)) => {} IH. case => [ _ | i Hi]. rewrite /SF_cut_down' /SF_belast /SF_last /SF_rcons /SF_ly /=. rewrite -?(last_map (@fst R R)) -unzip1_fst /=. rewrite ?unzip2_rcons ?unzip1_rcons /=. rewrite ?unzip1_belast ?unzip2_belast /=. rewrite ?unzip1_behead ?unzip2_behead /=. case: Rle_dec => //= Hx0. case: Rle_dec => //= Hx1. move: Hptd Hx1 ; apply SF_cons_dec with (s := s) => {s IH} /= [x1 | [x1 y1] s] //= Hptd Hx1. by apply (Hptd O (Nat.lt_0_succ _)). case: Rle_dec => //= Hx2. by apply (Hptd O (Nat.lt_0_succ _)). by apply (Hptd O (Nat.lt_0_succ _)). lra. lra. move: Hi (IH i) => {IH}. rewrite ?SF_size_rcons -?SF_size_lx ?SF_lx_rcons ?SF_ly_rcons. rewrite /SF_cut_down' /SF_belast /SF_last /SF_rcons /SF_ly /=. rewrite -?(last_map (@fst R R)) -?unzip1_fst. rewrite ?unzip2_rcons ?unzip1_rcons /=. rewrite ?unzip1_belast ?unzip2_belast /=. rewrite ?unzip1_behead ?unzip2_behead /=. case: (Rle_dec x0 lx1) => //= Hx0. case: (Rle_dec (SF_h s) lx1) => //= Hx1. rewrite size_belast size_belast'. move: Hx1 ; apply SF_cons_dec with (s := s) => {s Hptd} /= [ x1 | [x1 y1] s] //= Hx1. move => Hi IH ; apply IH ; by apply Nat.succ_lt_mono. case: Rle_dec => //= Hx2. move => Hi IH ; apply IH ; by apply Nat.succ_lt_mono. move => Hi IH ; apply IH ; by apply Nat.succ_lt_mono. move => Hi ; by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. move => Hi ; by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. apply Rlt_le_trans with (2 := Rmin_r alpha1 alpha2) ; apply Rlt_le_trans with (2 := Rmin_l _ alpha3). apply Rle_lt_trans with (2 := Hstep) => {Hstep}. move: Hab0 ; rewrite -Ha -Hb ; revert ptd_r_belast ptd_r => {Hab1} ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] //= Hab0. rewrite /SF_lx /SF_rcons /SF_belast /SF_last /SF_cut_down' /=. move: (proj1 Hab0) ; case: Rle_dec => //= _ _. rewrite (Rle_antisym _ _ (proj1 Hab0) (proj2 Hab0)) /seq_step /=. rewrite Rminus_eq_0 Rabs_R0 ; apply Rmax_case_strong ; by intuition. move: Hab0 (fun Hx1 => IH (conj Hx1 (proj2 Hab0))) => {IH}. apply SF_cons_dec with (s := s) => {s} /= [x1 | [x1 y1] s] //= Hab0 IH. rewrite /SF_cut_down' /SF_belast /SF_last /SF_rcons /SF_lx /=. move: (proj1 Hab0) ; case: (Rle_dec x0 lx1) => //= _ _. case: Rle_dec => //= Hx1. rewrite /seq_step /=. apply Rle_max_compat_l. rewrite (Rle_antisym _ _ Hx1 (proj2 Hab0)) Rminus_eq_0 Rabs_R0. apply Rmax_case_strong ; by intuition. rewrite /seq_step /=. apply Rle_max_compat_r. apply Rle_trans with (2 := Rle_abs _) ; rewrite Rabs_right. apply Rplus_le_compat_r. by apply Rlt_le, Rnot_le_lt. apply Rle_ge ; rewrite -Rminus_le_0 ; by apply Hab0. move: IH ; rewrite /SF_cut_down' /SF_belast /SF_last /SF_rcons /SF_lx /=. move: (proj1 Hab0) ; case: (Rle_dec x0 lx1) => //= _ _. case: (Rle_dec x1 lx1) => //= Hx1 IH. move: (IH Hx1) => {IH}. case: (Rle_dec (SF_h s) lx1) => //= Hx2. rewrite /seq_step -?(last_map (@fst R R)) /= => IH ; apply Rle_max_compat_l, IH. rewrite /seq_step /= ; apply Rle_max_compat_l. rewrite /seq_step /= ; apply Rmax_le_compat. apply Rle_trans with (2 := Rle_abs _) ; rewrite Rabs_right. by apply Rplus_le_compat_r, Rlt_le, Rnot_le_lt, Hx1. apply Rle_ge ; rewrite -Rminus_le_0 ; apply Hab0. apply Rmax_case_strong => _. apply Rabs_pos. apply SF_cons_ind with (s := s) => {s IH Hab0} /= [x2 | [x2 y2] s IH] //=. exact: Rle_refl. apply Rmax_case_strong => _. apply Rabs_pos. exact: IH. (* ** transition 1 *) clear H IH. apply Rle_trans with ((fmax - fmin) * alpha3). rewrite Rabs_mult ; apply Rmult_le_compat ; try apply Rabs_pos. apply Rabs_le_between. rewrite Ropp_minus_distr'. suff H0 : a <= (fst (SF_last 0 ptd_r_belast) + lx1) / 2 <= b. suff H1 : a <= snd ptd_r_last <= b. split ; apply Rplus_le_compat, Ropp_le_contravar ; by apply Hff. revert ptd_r_last Hab1 Hptd. apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH] // Hab1 Hptd. rewrite /SF_cut_down' /= ; case: Rle_dec => //= ; by intuition. rewrite SF_size_cons in Hab1. move: (IH (fun i Hi => Hab1 (S i) (le_n_S _ _ Hi)) (ptd_cons _ _ Hptd)) => {IH}. move: Hptd (Hab1 O (Nat.le_0_l _)) (Hab1 1%nat (le_n_S _ _ (Nat.le_0_l _))) => {Hab1}. apply SF_cons_dec with (s := s) => {s Hab0} /= [ x1 | [x1 y1] s] //= Hptd Hx0 Hx1. rewrite /SF_cut_down' /SF_last /= -?(last_map (@snd R R)) -?unzip2_snd. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; split. apply Rle_trans with (1 := proj1 Hx0), (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (2 := proj2 Hx1), (Hptd O (Nat.lt_0_succ _)). move => _ ; split. apply Rle_trans with (1 := proj1 Hx0), (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (2 := proj2 Hx1), (Hptd O (Nat.lt_0_succ _)). move => _ ; by intuition. rewrite /SF_cut_down' /SF_last /= -?(last_map (@snd R R)) -?unzip2_snd. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. move => _ ; split. apply Rle_trans with (1 := proj1 Hx0), (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (2 := proj2 Hx1), (Hptd O (Nat.lt_0_succ _)). move => _ ; by intuition. cut (a <= fst (SF_last 0 ptd_r_belast) <= b). lra. split. revert ptd_r_belast ptd_r Hab1 Hptd. apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH] // Hab1 Hptd. rewrite /SF_cut_down' /= ; case: Rle_dec => //= Hx0. by apply (Hab1 O (Nat.le_0_l _)). by apply Hab0. rewrite SF_size_cons in Hab1. move: (IH (fun i Hi => Hab1 (S i) (le_n_S _ _ Hi)) (ptd_cons _ _ Hptd)) => {IH}. move: Hptd (Hab1 O (Nat.le_0_l _)) (Hab1 1%nat (le_n_S _ _ (Nat.le_0_l _))) => {Hab1}. apply SF_cons_dec with (s := s) => {s} /= [ x1 | [x1 y1] s] //= Hptd Hx0 Hx1. rewrite /SF_cut_down' /SF_last /= -?(last_map (@fst R R)) -?unzip1_fst. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hx0. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hab0. rewrite /SF_cut_down' /SF_last /= -?(last_map (@fst R R)) -?unzip1_fst. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. move => _ ; by apply Hx0. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hab0. revert ptd_r_belast ptd_r Hab1 Hptd. apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH] // Hab1 Hptd. rewrite /SF_cut_down' /= ; case: Rle_dec => //= Hx0. by apply (Hab1 O (Nat.le_0_l _)). by apply Hab0. rewrite SF_size_cons in Hab1. move: (IH (fun i Hi => Hab1 (S i) (le_n_S _ _ Hi)) (ptd_cons _ _ Hptd)) => {IH}. move: Hptd (Hab1 O (Nat.le_0_l _)) (Hab1 1%nat (le_n_S _ _ (Nat.le_0_l _))) => {Hab1}. apply SF_cons_dec with (s := s) => {s} /= [ x1 | [x1 y1] s] //= Hptd Hx0 Hx1. rewrite /SF_cut_down' /SF_last /= -?(last_map (@fst R R)) -?unzip1_fst. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hx0. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hab0. rewrite /SF_cut_down' /SF_last /= -?(last_map (@fst R R)) -?unzip1_fst. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. move => _ ; by apply Hx0. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hab0. apply Rle_trans with (2 := Rmin_r (Rmin alpha1 alpha2) alpha3). apply Rle_trans with (2 := Rlt_le _ _ Hstep). rewrite Rabs_right. rewrite -Ha -Hb in Hab0 ; revert ptd_r_belast ptd_r Hptd Hab0 ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] //=. rewrite /SF_cut_down' /SF_belast /SF_last /seq_step /= => Hptd Hab0. move: (proj1 Hab0) ; case: Rle_dec => //= _ _. rewrite (Rle_antisym _ _ (proj1 Hab0) (proj2 Hab0)) ; apply Req_le ; by ring. move => Hptd Hab0 ; move: (fun Hx1 => IH (ptd_cons _ _ Hptd) (conj Hx1 (proj2 Hab0))) => {IH}. rewrite /SF_cut_down' /SF_belast /SF_last /=. move: (proj1 Hab0) ; case: (Rle_dec x0 _) => //= _ _. case: (Rle_dec (SF_h s)) => //= Hx1 IH. move: (proj1 Hab0) Hx1 (IH Hx1) => {IH Hab0} Hx0. apply SF_cons_dec with (s := s) => {s Hptd} /= [x1 | [x1 y1] s] /= Hx1. rewrite /seq_step /= => IH. apply Rle_trans with (1 := IH) ; by apply RmaxLess2. case: (Rle_dec (SF_h s)) => //= Hx2 IH. move: Hx2 IH ; apply SF_cons_dec with (s := s) => {s} /= [x2 | [x2 y2] s] /= Hx2. rewrite /seq_step /= => IH. apply Rle_trans with (1 := IH) ; by apply RmaxLess2. case: (Rle_dec (SF_h s)) => //= Hx3 IH. apply Rle_trans with (1 := IH). rewrite /seq_step /= ; by apply RmaxLess2. rewrite /seq_step /=. apply Rle_trans with (2 := RmaxLess2 _ _). apply Rle_trans with (2 := RmaxLess2 _ _). apply Rle_trans with (2 := RmaxLess1 _ _). apply Rle_trans with (2 := Rle_abs _), Rplus_le_compat_r, Rlt_le, Rnot_le_lt, Hx3. rewrite /seq_step /=. apply Rle_trans with (2 := RmaxLess2 _ _). apply Rle_trans with (2 := RmaxLess1 _ _). apply Rle_trans with (2 := Rle_abs _), Rplus_le_compat_r, Rlt_le, Rnot_le_lt, Hx2. rewrite /seq_step /=. apply Rle_trans with (2 := RmaxLess1 _ _). apply Rle_trans with (2 := Rle_abs _), Rplus_le_compat_r, Rlt_le, Rnot_le_lt, Hx1. apply Rle_ge ; rewrite -Rminus_le_0. revert ptd_r_belast ptd_r ; rewrite -Ha in Hab0 ; move: (proj1 Hab0) ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] /= Hx0. rewrite /SF_cut_down' /SF_belast /SF_last /=. by case: Rle_dec. move: IH ; rewrite /SF_cut_down' /SF_belast /SF_last /=. case: (Rle_dec x0 _) => //= _. case: (Rle_dec (SF_h s) _) => //= Hx1 IH. move: Hx1 (IH Hx1) => {IH}. apply SF_cons_dec with (s := s) => {s} /= [x1 | [x1 y1] s] //= Hx1. case: (Rle_dec (SF_h s) _) => //=. apply SF_cons_dec with (s := s) => {s} /= [x2 | [x2 y2] s] //= Hx2. case: (Rle_dec (SF_h s) _) => //=. rewrite /alpha3 /=. apply (Rmax_case_strong (fmax - fmin)) => H. apply Req_le ; field. apply Rgt_not_eq, Rlt_le_trans with 1 ; by intuition. rewrite Rdiv_1 -{2}(Rmult_1_l (eps/2/2)). apply Rmult_le_compat_r, H. apply Rlt_le, eps4. clear H IH. rewrite Rplus_assoc Rmult_1_l. apply (f_equal (Rplus (ly0 * (lx1 - lx0)))). rewrite -(Ropp_involutive (-_+_)). apply Ropp_eq_compat. rewrite Ropp_plus_distr Ropp_involutive. revert ptd_r_last ptd_r_belast ptd_r ; move: (proj1 Hab0) ; rewrite -Ha => {Hab0} ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] /= Hx0. rewrite /SF_cut_down' /=. case: (Rle_dec x0 lx1) => //= _. rewrite /Riemann_sum /= /plus /zero /scal /= /mult /=. by ring. case: (Rle_dec (SF_h s) lx1) => //= Hx1. move: Hx1 (IH Hx1) => {IH}. apply SF_cons_dec with (s := s) => {s} [x1 | [x1 y1] s] /= Hx1. rewrite /SF_cut_down' /= ; case: (Rle_dec x0 _) => //= _ ; case: (Rle_dec x1 _) => //= _. rewrite /Riemann_sum /= => _. rewrite /plus /zero /scal /= /mult /=. ring. rewrite /SF_cut_down' /= ; case: (Rle_dec x0 _) => //= _ ; case: (Rle_dec x1 _) => //= _ ; case: (Rle_dec (SF_h s) _) => //= Hx2. rewrite /SF_belast /SF_last /SF_rcons /=. rewrite (Riemann_sum_cons phi (x0,y0) ({| SF_h := x1; SF_t := (SF_h s, y1) :: seq_cut_down' (SF_t s) lx1 y1 |})). rewrite (Riemann_sum_cons phi (x0,y0) ({| SF_h := x1; SF_t := rcons (seq.belast (SF_h s, y1) (seq_cut_down' (SF_t s) lx1 y1)) (lx1, (fst (last (x1, y0) (seq.belast (SF_h s, y1) (seq_cut_down' (SF_t s) lx1 y1))) + lx1) / 2) |})). move => <- /=. rewrite Rplus_assoc ; apply f_equal. rewrite -!(last_map (@fst R R)) -!unzip1_fst /=. ring. rewrite /Riemann_sum /= => _. rewrite /plus /zero /scal /= /mult /=. ring. rewrite /SF_cut_down' /= ; case: Rle_dec => //= _ ; case: Rle_dec => //= _. rewrite /Riemann_sum /= /plus /zero /scal /= /mult /=. ring. (* partie [lx1 ; b] *) set ptd_l_head := (SF_head a (SF_cut_up' ptd lx1 a)). set ptd_l_behead := (SF_behead (SF_cut_up' ptd lx1 a)). set ptd_l := SF_cons (lx1, (lx1 + fst (SF_head a ptd_l_behead))/2) ptd_l_behead. move: (IH ptd_l) => {} IH. replace (_-_) with ((Int_SF ly (cons lx1 lx) - 1 * Riemann_sum phi ptd_l) - (phi ((lx1 + fst (SF_head 0 ptd_l_behead))/2) - phi (snd ptd_l_head)) * (lx1 - fst (SF_head 0 ptd_l_behead))). rewrite (double_var (eps/2)) ; apply Rle_trans with (1 := Rabs_triang _ _), Rplus_le_compat. (* * hypothèse d'induction *) apply: IH. (* ** ptd_l est une subdivision pointée *) case. move => _ ; move: (proj1 Hab0) ; rewrite -Ha => /= Hx0 ; case: Rle_dec => //= _. rewrite seq_cut_up_head'. move: Hx0 ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] /= Hx0. split ; apply Req_le ; field. case: Rle_dec => //= Hx1. move: Hx1 (IH Hx1) => {IH}. apply SF_cons_dec with (s := s) => {s} /= [x1 | [x1 y1] s] //= Hx1. case: Rle_dec => //= Hx2. lra. rewrite /ptd_l SF_lx_cons SF_ly_cons SF_size_cons => i Hi ; move: i {Hi} (proj2 (Nat.succ_lt_mono _ _) Hi). revert ptd_l_behead ptd_l Hptd ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] /= Hptd. rewrite /SF_cut_up' /=. case: Rle_dec => //=. rewrite /SF_size /SF_behead /= => _ i Hi ; by apply Nat.nlt_0_r in Hi. move: (IH (ptd_cons _ _ Hptd)) => {IH}. rewrite /SF_cut_up' /=. case: (Rle_dec x0 _) => //= Hx0. case: (Rle_dec (SF_h s) _) => //= Hx1. rewrite !seq_cut_up_head'. move: Hx1 ; apply SF_cons_dec with (s := s) => {s Hptd} /= [x1 | [x1 y1] s] //= Hx1. case: (Rle_dec (SF_h s) _) => //= Hx2. (* * seq_step (SF_lx ptd_l) < alpha1 *) apply Rlt_le_trans with (2 := Rmin_l alpha1 alpha2). apply Rlt_le_trans with (2 := Rmin_l _ alpha3). apply Rle_lt_trans with (2 := Hstep). revert ptd_l_behead ptd_l ; move :(proj1 Hab0) ; rewrite -Ha ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] /= s IH] Hx0. rewrite /SF_cut_up' /= ; case: (Rle_dec x0 _) => //= _. rewrite /seq_step /= Rminus_eq_0 Rabs_R0 ; apply Rmax_case_strong ; by intuition. rewrite /SF_cut_up' /= ; case: (Rle_dec x0 _) => //= _. move: IH ; rewrite /SF_cut_up' /= ; case: (Rle_dec (SF_h s) _) => //= Hx1 ; rewrite ?seq_cut_up_head' => IH. move: Hx1 (IH Hx1) => {IH} ; apply SF_cons_dec with (s := s) => {s} /= [x1 | [x1 y1] /= s] Hx1 IH. apply Rle_trans with (1 := IH) => {IH} ; rewrite /seq_step /= ; exact: RmaxLess2. move: IH ; case: (Rle_dec (SF_h s) _) => //= Hx2 IH. apply Rle_trans with (1 := IH) => {IH} ; rewrite /seq_step /= ; exact: RmaxLess2. apply Rle_trans with (1 := IH) => {IH} ; rewrite /seq_step /= ; exact: RmaxLess2. clear IH ; rewrite /seq_step /=. apply Rle_max_compat_r. apply Rle_trans with (2 := Rle_abs _) ; rewrite Rabs_right. by apply Rplus_le_compat_l, Ropp_le_contravar. by apply Rle_ge, (Rminus_le_0 lx1 _), Rlt_le, Rnot_le_lt. by rewrite /ptd_l /=. rewrite -Hb. move: (proj1 Hab0) ; rewrite -Ha /=; case: (Rle_dec (SF_h ptd) lx1) => //= _ _. rewrite seq_cut_up_head'. move: Hab0 ; rewrite -Ha -Hb ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] /= [Hx0 Hlx1]. by apply Rle_antisym. move: (fun Hx1 => IH (conj Hx1 Hlx1)) => {IH} ; case: (Rle_dec (SF_h s) _) => //= Hx1. move => IH ; rewrite -(IH Hx1) => {IH}. move: Hx1 Hlx1 ; apply SF_cons_dec with (s := s) => {s} /= [x1 | [x1 y1] /= s ] Hx1 Hlx1. by []. case: (Rle_dec (SF_h s) _) => /= Hx2 ; by []. (* ** transition 2 *) clear H IH. apply Rle_trans with ((fmax - fmin) * alpha3). rewrite Rabs_Ropp Rabs_mult ; apply Rmult_le_compat ; try apply Rabs_pos. apply Rabs_le_between. rewrite Ropp_minus_distr'. suff H0 : a <= (lx1 + fst (SF_head 0 ptd_l_behead)) / 2 <= b. suff H1 : a <= snd ptd_l_head <= b. split ; apply Rplus_le_compat, Ropp_le_contravar ; by apply Hff. revert ptd_l_head Hab1 Hptd. apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH] // Hab1 Hptd. rewrite /SF_cut_up' /= ; case: Rle_dec => //= ; by intuition. rewrite SF_size_cons in Hab1. move: (IH (fun i Hi => Hab1 (S i) (le_n_S _ _ Hi)) (ptd_cons _ _ Hptd)) => {IH}. move: Hptd (Hab1 O (Nat.le_0_l _)) (Hab1 1%nat (le_n_S _ _ (Nat.le_0_l _))) => {Hab1}. apply SF_cons_dec with (s := s) => {s Hab0} /= [ x1 | [x1 y1] s] //= Hptd Hx0 Hx1. rewrite /SF_cut_up' /SF_head /=. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; split. apply Rle_trans with (1 := proj1 Hx0), (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (2 := proj2 Hx1), (Hptd O (Nat.lt_0_succ _)). move => _ ; by intuition. rewrite /SF_cut_up' /SF_head /=. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. move => _ ; split. apply Rle_trans with (1 := proj1 Hx0), (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (2 := proj2 Hx1), (Hptd O (Nat.lt_0_succ _)). move => _ ; by intuition. cut (a <= fst (SF_head 0 ptd_l_behead) <= b). lra. split. revert ptd_l_behead ptd_l Hab1 Hptd. apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH] // Hab1 Hptd. rewrite /SF_cut_down' /= ; case: Rle_dec => //= Hx0. by apply Hab0. by apply (Hab1 O (Nat.le_0_l _)). rewrite SF_size_cons in Hab1. move: (IH (fun i Hi => Hab1 (S i) (le_n_S _ _ Hi)) (ptd_cons _ _ Hptd)) => {IH}. move: Hptd (Hab1 O (Nat.le_0_l _)) (Hab1 1%nat (le_n_S _ _ (Nat.le_0_l _))) => {Hab1}. apply SF_cons_dec with (s := s) => {s} /= [ x1 | [x1 y1] s] //= Hptd Hx0 Hx1. rewrite /SF_cut_up' /SF_head /= -?(head_map (@fst R R)) -?unzip1_fst. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hx0. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. by rewrite ?seq_cut_up_head'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hx0. move => _ ; by apply Hx0. revert ptd_l_behead ptd_l Hab1 Hptd. apply SF_cons_ind with (s := ptd) => /= [ x0 | [x0 y0] s IH] // Hab1 Hptd. case: Rle_dec => //= Hx0. by apply Hab0. by apply (Hab1 O (Nat.le_0_l _)). rewrite SF_size_cons in Hab1. move: (IH (fun i Hi => Hab1 (S i) (le_n_S _ _ Hi)) (ptd_cons _ _ Hptd)) => {IH}. move: Hptd (Hab1 O (Nat.le_0_l _)) (Hab1 1%nat (le_n_S _ _ (Nat.le_0_l _))) => {Hab1}. apply SF_cons_dec with (s := s) => {s} /= [ x1 | [x1 y1] s] //= Hptd Hx0 Hx1. rewrite -?(head_map (@fst R R)) -?unzip1_fst. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec x1 lx1) => //= Hx1'. move => _ ; by apply Hx0. move => _ ; by apply Hx0. case: (Rle_dec x0 lx1) => //= Hx0'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. by rewrite !seq_cut_up_head'. case: (Rle_dec x1 lx1) => //= Hx1'. case: (Rle_dec _ lx1) => //= Hx2'. move => _ ; by apply Hx0. move => _ ; by apply Hx0. move => _ ; by apply Hx0. apply Rle_trans with (2 := Rmin_r (Rmin alpha1 alpha2) alpha3). apply Rle_trans with (2 := Rlt_le _ _ Hstep). rewrite -Rabs_Ropp Rabs_right ?Ropp_minus_distr'. rewrite -Ha -Hb in Hab0 ; revert ptd_l_behead ptd_l Hptd Hab0 ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] //=. rewrite /seq_step /= => Hptd Hab0. move: (proj1 Hab0) ; case: Rle_dec => //= _ _. apply Req_le ; by ring. move => Hptd Hab0 ; move: (fun Hx1 => IH (ptd_cons _ _ Hptd) (conj Hx1 (proj2 Hab0))) => {IH}. move: (proj1 Hab0) ; case: (Rle_dec x0 _) => //= _ _. case: (Rle_dec (SF_h s)) => //= Hx1 IH. move: (proj1 Hab0) Hx1 (IH Hx1) => {IH Hab0} Hx0. apply SF_cons_dec with (s := s) => {s Hptd} /= [x1 | [x1 y1] s] /= Hx1. rewrite /seq_step /= => IH. apply Rle_trans with (1 := IH) ; by apply RmaxLess2. case: (Rle_dec (SF_h s)) => //= Hx2 IH. move: Hx2 IH ; apply SF_cons_dec with (s := s) => {s} /= [x2 | [x2 y2] s] /= Hx2. rewrite /seq_step /= => IH. apply Rle_trans with (1 := IH) ; by apply RmaxLess2. case: (Rle_dec (SF_h s)) => //= Hx3 IH. rewrite !seq_cut_up_head' in IH |-*. apply Rle_trans with (1 := IH). rewrite /seq_step /= ; by apply RmaxLess2. rewrite /seq_step /=. apply Rle_trans with (2 := RmaxLess2 _ _). apply Rle_trans with (2 := RmaxLess2 _ _). apply Rle_trans with (2 := RmaxLess1 _ _). by apply Rle_trans with (2 := Rle_abs _), Rplus_le_compat_l, Ropp_le_contravar. rewrite /seq_step /=. apply Rle_trans with (2 := RmaxLess2 _ _). apply Rle_trans with (2 := RmaxLess1 _ _). by apply Rle_trans with (2 := Rle_abs _), Rplus_le_compat_l, Ropp_le_contravar. rewrite /seq_step /=. apply Rle_trans with (2 := RmaxLess1 _ _). apply Rle_trans with (2 := Rle_abs _), Rplus_le_compat_l, Ropp_le_contravar, Hab0. apply Rle_ge, (Rminus_le_0 lx1). revert ptd_l_behead ptd_l ; rewrite -Ha -Hb in Hab0 ; move: Hab0 ; apply SF_cons_ind with (s := ptd) => /= [x0 | [x0 y0] s IH] /= Hx0. case: Rle_dec => /= _. exact: Rle_refl. exact: (proj2 Hx0). move: (proj1 Hx0) ; case: Rle_dec => //= _ _. move: (fun Hx1 => IH (conj Hx1 (proj2 Hx0))) => {IH}. case: (Rle_dec (SF_h s)) => //= Hx1 IH. rewrite !seq_cut_up_head' in IH |-* ; move: (IH Hx1) => {IH}. move: Hx0 Hx1 ; apply SF_cons_dec with (s := s) => {s} /= [x1 | [x1 y1] /= s] Hx0 Hx1 IH. exact: Rle_refl. move: IH ; case: (Rle_dec (SF_h s)) => /= Hx2. by []. by []. by apply Rlt_le, Rnot_le_lt, Hx1. rewrite /alpha3 /=. apply (Rmax_case_strong (fmax - fmin)) => H. apply Req_le ; field. apply Rgt_not_eq, Rlt_le_trans with 1 ; by intuition. rewrite Rdiv_1 -{2}(Rmult_1_l (eps/2/2)). apply Rmult_le_compat_r, H. apply Rlt_le, eps4. clear H IH. rewrite !Rmult_1_l {1 2}/Rminus Rplus_assoc -Ropp_plus_distr. apply (f_equal (Rminus _)) => /=. rewrite /ptd_l /ptd_l_behead /ptd_l_head /= /SF_cut_up' /= ; move: Hab0 ; rewrite -Ha -Hb /= ; case => [Hx0 Hlx1]. case: (Rle_dec (SF_h ptd)) => //= _. rewrite ?seq_cut_up_head' /SF_ly /= Riemann_sum_cons /=. move: Hx0 Hlx1 ; apply SF_cons_ind with (s := ptd) => [x0 | [x0 y0] s /= IH] /= Hx0 Hlx1. rewrite /Riemann_sum /= /plus /zero /scal /= /mult /= ; ring. case: (Rle_dec (SF_h s)) => //= Hx1. move: (IH Hx1 Hlx1) => /= {IH}. move: Hx1 Hlx1 ; apply SF_cons_dec with (s := s) => {s} [x1 | [x1 y1] s /=] /= Hx1 Hlx1 IH. rewrite /Riemann_sum /= /plus /zero /scal /= /mult /= ; ring. move: IH ; case: (Rle_dec (SF_h s)) => //= Hx2. move => <- ; apply Rminus_diag_uniq ; ring_simplify. move: Hx2 Hlx1 y1 ; apply SF_cons_ind with (s := s) => {s} [x2 | [x2 y2] s /= IH] /= Hx2 Hlx1 y1. ring. case: (Rle_dec (SF_h s)) => //= Hx3. by apply IH. ring. rewrite /Riemann_sum /= /plus /zero /scal /= /mult /=. ring_simplify. repeat apply f_equal. by elim: (SF_t s) (0) (y0). replace (fst (last (SF_h ptd, SF_h ptd) (SF_t ptd))) with (last (SF_h ptd) (unzip1 (SF_t ptd))). 2 : { pattern (SF_h ptd) at 1. replace (SF_h ptd) with (fst (SF_h ptd, SF_h ptd)) by auto. elim: (SF_t ptd) (SF_h ptd, SF_h ptd) => //=. } by rewrite Hb Ha. replace lx1 with (RList.pos_Rl (cons lx0 (cons lx1 lx)) 1) by reflexivity. move: (proj1 (proj2 Had)) (proj1 (proj2 (proj2 Had))) ; rewrite /Rmin /Rmax ; case: Rle_dec => // _ <- <-. rewrite !nth_compat size_compat. split. rewrite nth0. apply (sorted_head (lx0 :: lx1 :: lx) 1). apply sorted_compat; apply Had. simpl ; by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. simpl ; rewrite -last_nth. apply (sorted_last (lx0 :: lx1 :: lx) 1) with (x0 := 0). apply sorted_compat; apply Had. simpl ; by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. rewrite -Ha -Hb /SF_lx /= => i Hi. apply Nat.lt_succ_r in Hi ; rewrite -SF_size_lx /SF_lx in Hi. split. exact: (sorted_head (SF_h ptd :: unzip1 (SF_t ptd)) i (ptd_sort _ Hptd) Hi). exact: (sorted_last (SF_h ptd :: unzip1 (SF_t ptd)) i (ptd_sort _ Hptd) Hi). clear H IH. move => x Hx ; case: (sorted_dec ([:: lx0, lx1 & lx]) 0 x). apply sorted_compat ; rewrite /=; apply Had. move: (proj1 (proj2 Had)) (proj1 (proj2 (proj2 Had))) ; rewrite /Rmin /Rmax ; case: Rle_dec => // _. rewrite -nth0 -nth_last /= => -> Hb'. split. by apply Hx. elim: (lx) (lx1) Hb' => /= [ | h1 s IH] h0 Hb'. rewrite Hb' ; by apply Hx. by apply IH. case => i ; case ; case ; case => {} Hx Hx' Hi. rewrite (proj2 (proj2 (proj2 (proj2 Had))) i). suff H : fmin1 <= RList.pos_Rl (cons ly0 ly) i <= fmax1. split. apply Rle_trans with (1 := Rmin_l _ _), H. apply Rle_trans with (2 := RmaxLess1 _ _), H. rewrite nth_compat /= /fmin1 /fmax1 . have : (S i < size (ly0 :: ly))%nat. move: (proj1 (proj2 (proj2 (proj2 Had)))) Hi. rewrite /= ?size_compat /= => -> ; exact: (proj2 (Nat.succ_lt_mono _ _)). move: i {Hx Hx' Hi}. elim: (ly0 :: ly) => [ | h0 s IH] i Hi. by apply Nat.nlt_0_r in Hi. case: i Hi => /= [ | i] Hi. split ; [exact: Rmin_l | exact: RmaxLess1]. split ; [apply Rle_trans with (1 := Rmin_r _ _) | apply Rle_trans with (2 := RmaxLess2 _ _)] ; apply IH ; by apply Nat.succ_lt_mono. simpl in Hi |-* ; rewrite -size_compat in Hi ; by intuition. split. rewrite -nth_compat /= in Hx ; exact: Hx. rewrite -nth_compat /= in Hx' ; exact: Hx'. rewrite -Hx. suff H : fmin2 <= phi (nth 0 [:: lx0, lx1 & lx] i) <= fmax2. split. apply Rle_trans with (1 := Rmin_r _ _), H. apply Rle_trans with (2 := RmaxLess2 _ _), H. rewrite /fmin2 /fmax2 . move: i Hi {Hx Hx'}. elim: ([:: lx0, lx1 & lx]) => [ | h0 s IH] i Hi. by apply Nat.nlt_0_r in Hi. case: i Hi => /= [ | i] Hi. split ; [exact: Rmin_l | exact: RmaxLess1]. split ; [apply Rle_trans with (1 := Rmin_r _ _) | apply Rle_trans with (2 := RmaxLess2 _ _)] ; apply IH ; by apply Nat.succ_lt_mono. have : (((size [:: lx0, lx1 & lx] - 1)%nat) < size [:: lx0, lx1 & lx])%nat. by []. replace (size [:: lx0, lx1 & lx] - 1)%nat with (S (size [:: lx0, lx1 & lx] - 2)) by (simpl ; intuition). move: (size [:: lx0, lx1 & lx] - 2)%nat => i Hi. case ; case => {} Hx ; [ case => Hx' | move => _ ]. rewrite (proj2 (proj2 (proj2 (proj2 Had))) i). suff H : fmin1 <= RList.pos_Rl (cons ly0 ly) i <= fmax1. split. apply Rle_trans with (1 := Rmin_l _ _), H. apply Rle_trans with (2 := RmaxLess1 _ _), H. rewrite nth_compat /= /fmin1 /fmax1 . have : (i < size (ly0 :: ly))%nat. move: (proj1 (proj2 (proj2 (proj2 Had)))) Hi. rewrite /= ?size_compat /= => -> ; exact: (proj2 (Nat.succ_lt_mono _ _)). move: i {Hx Hx' Hi}. elim: (ly0 :: ly) => [ | h0 s IH] i Hi. by apply Nat.nlt_0_r in Hi. case: i Hi => /= [ | i] Hi. split ; [exact: Rmin_l | exact: RmaxLess1]. split ; [apply Rle_trans with (1 := Rmin_r _ _) | apply Rle_trans with (2 := RmaxLess2 _ _)] ; apply IH ; by apply Nat.succ_lt_mono. simpl in Hi |-* ; rewrite -size_compat in Hi ; by intuition. split. rewrite -nth_compat /= in Hx ; exact: Hx. rewrite -nth_compat /= in Hx' ; exact: Hx'. rewrite Hx'. suff H : fmin2 <= phi (nth 0 [:: lx0, lx1 & lx] (S i)) <= fmax2. split. apply Rle_trans with (1 := Rmin_r _ _), H. apply Rle_trans with (2 := RmaxLess2 _ _), H. rewrite /fmin2 /fmax2 . move: i Hi {Hx Hx'}. elim: ([:: lx0, lx1 & lx]) => [ | h0 s IH] i Hi. by apply Nat.nlt_0_r in Hi. case: s IH Hi => /= [ | h1 s] IH Hi. by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. case: i Hi => /= [ | i] Hi. split ; [ apply Rle_trans with (1 := Rmin_r _ _) ; exact: Rmin_l | apply Rle_trans with (2 := RmaxLess2 _ _) ; exact: RmaxLess1]. split ; [apply Rle_trans with (1 := Rmin_r _ _) | apply Rle_trans with (2 := RmaxLess2 _ _)] ; apply IH ; by apply Nat.succ_lt_mono. rewrite -Hx. suff H : fmin2 <= phi (nth 0 [:: lx0, lx1 & lx] i) <= fmax2. split. apply Rle_trans with (1 := Rmin_r _ _), H. apply Rle_trans with (2 := RmaxLess2 _ _), H. rewrite /fmin2 /fmax2 . move: i Hi {Hx}. elim: ([:: lx0, lx1 & lx]) => [ | h0 s IH] i Hi. by apply Nat.nlt_0_r in Hi. case: i Hi => /= [ | i] Hi. split ; [exact: Rmin_l | exact: RmaxLess1]. split ; [apply Rle_trans with (1 := Rmin_r _ _) | apply Rle_trans with (2 := RmaxLess2 _ _)] ; apply IH ; by apply Nat.succ_lt_mono. (* preuve de H *) clear eps eps2 IH eps4 alpha1. move: (proj1 (proj2 Had)) => /= ; rewrite /Rmin ; case: Rle_dec => //= _ <-. move: (proj1 Had O (Nat.lt_0_succ _)) => /= Hl0l1. move: (proj2 (proj2 (proj2 (proj2 Had))) O (Nat.lt_0_succ _)) => /= Hval. clear a b Hab Had lx ly. rename lx0 into a ; rename lx1 into b ; rename ly0 into c ; rename Hl0l1 into Hab. set fmin := Rmin (Rmin (phi a) (phi b)) c. set fmax := Rmax (Rmax (phi a) (phi b)) c. move => eps ; set eps2 := pos_div_2 eps. have Halpha : 0 < eps2 / (Rmax (fmax - fmin) 1). apply Rdiv_lt_0_compat. apply eps2. apply Rlt_le_trans with (2 := RmaxLess2 _ _), Rlt_0_1. set alpha := mkposreal _ Halpha. exists alpha => ptd. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | [x0 y0] ptd IH] Hptd Hstep Ha Hb ; simpl in Ha, Hb. rewrite -Ha -Hb /Riemann_sum /= ; rewrite Rminus_eq_0 Rmult_0_r Rminus_0_r Rabs_R0. by apply Rlt_le, eps. move: (fun Ha => IH (ptd_cons _ _ Hptd) (Rle_lt_trans _ _ _ (RmaxLess2 _ _) Hstep) Ha Hb) => {} IH. move: (proj1 (ptd_sort _ Hptd)) ; rewrite Ha in Hptd, Hstep |- * => {x0 Ha} ; case => /= Ha. rewrite Riemann_sum_cons /= /plus /zero /scal /= /mult /= => {IH}. replace (_-_) with ((c-phi y0) * (SF_h ptd - a) + (c * (b - SF_h ptd) - Riemann_sum phi ptd)) by ring. rewrite (double_var eps) ; apply Rle_trans with (1 := Rabs_triang _ _), Rplus_le_compat. apply Rle_trans with ((fmax - fmin) * alpha). rewrite Rabs_mult ; apply Rmult_le_compat ; try exact: Rabs_pos. suff : a <= y0 <= b. case ; case => Ha'. case => Hb'. rewrite Hval. rewrite Rminus_eq_0 Rabs_R0 -Rminus_le_0 /fmin /fmax. rewrite /Rmin /Rmax ; case: Rle_dec ; case: Rle_dec ; case: Rle_dec => // H0 H1 H2. by apply Rlt_le, Rnot_le_lt, H1. by apply Rle_refl. by apply Rlt_le, Rnot_le_lt, H0. by apply Rle_refl. by apply Rlt_le, Rnot_le_lt, H0. by split. rewrite Hb' ; apply Rabs_le_between ; rewrite Ropp_minus_distr' ; split ; apply Rplus_le_compat, Ropp_le_contravar. by apply Rmin_r. by apply Rle_trans with (2 := RmaxLess1 _ _), RmaxLess2. by apply RmaxLess2. by apply Rle_trans with (1 := Rmin_l _ _), Rmin_r. rewrite -Ha' => _ ; apply Rabs_le_between ; rewrite Ropp_minus_distr' ; split ; apply Rplus_le_compat, Ropp_le_contravar. by apply Rmin_r. by apply Rle_trans with (2 := RmaxLess1 _ _), RmaxLess1. by apply RmaxLess2. by apply Rle_trans with (1 := Rmin_l _ _), Rmin_l. split. apply (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (SF_h ptd). apply (Hptd O (Nat.lt_0_succ _)). rewrite -Hb ; apply (sorted_last (SF_lx ptd) 0 (proj2 (ptd_sort _ Hptd)) (Nat.lt_0_succ _)) with (x0 := 0). apply Rlt_le, Rle_lt_trans with (2 := Hstep) ; rewrite /seq_step /= ; apply RmaxLess1. rewrite /alpha /= ; apply (Rmax_case_strong (fmax-fmin)) => H. apply Req_le ; field. by apply Rgt_not_eq, Rlt_le_trans with (1 := Rlt_0_1), H. rewrite Rdiv_1 -{2}(Rmult_1_l (eps/2)) ; apply Rmult_le_compat_r. apply Rlt_le, eps2. apply H. move: (ptd_cons _ _ Hptd) (Rle_lt_trans _ _ _ (RmaxLess2 _ _) Hstep : seq_step (SF_lx ptd) < alpha) Ha Hb => {Hstep y0} Hptd Hstep Ha Hb. suff : SF_h ptd <= b. case => Hx0. move: Hptd Hstep Ha Hb Hx0. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | [x0 y0] ptd IH] Hptd Hstep /= Ha Hb Hx0. contradict Hb ; apply Rlt_not_eq, Hx0. move: (fun Hx1 => IH (ptd_cons _ _ Hptd) (Rle_lt_trans _ _ _ (RmaxLess2 _ _) Hstep) (Rlt_le_trans _ _ _ Ha (proj1 (ptd_sort _ Hptd))) Hb Hx1) => {} IH. rewrite Riemann_sum_cons /=. have : SF_h ptd <= b. rewrite -Hb ; apply (sorted_last ((SF_h ptd)::(unzip1 (SF_t ptd))) O) with (x0 := 0). apply ptd_sort, (ptd_cons (x0,y0)), Hptd. apply Nat.lt_0_succ. case => Hx1. rewrite Hval /plus /scal /= /mult /=. replace (_-_) with (c * (b - SF_h ptd) - Riemann_sum phi ptd) by ring. by apply IH. split. apply Rlt_le_trans with (1 := Ha), (Hptd O (Nat.lt_0_succ _)). apply Rle_lt_trans with (2 := Hx1), (Hptd O (Nat.lt_0_succ _)). rewrite Hx1 Riemann_sum_zero. change zero with 0. rewrite /plus /scal /= /mult /=. replace (_ - _) with ((c - phi y0) * (b - x0)) by ring. apply Rle_trans with ((fmax - fmin) * alpha). rewrite Rabs_mult ; apply Rmult_le_compat ; try exact: Rabs_pos. suff : a <= y0 <= b. case ; case => Ha'. case => Hb'. rewrite Hval. rewrite Rminus_eq_0 Rabs_R0 -Rminus_le_0 /fmin /fmax. rewrite /Rmin /Rmax ; case: Rle_dec ; case: Rle_dec ; case: Rle_dec => // H0 H1 H2. by apply Rlt_le, Rnot_le_lt, H1. by apply Rle_refl. by apply Rlt_le, Rnot_le_lt, H0. by apply Rle_refl. by apply Rlt_le, Rnot_le_lt, H0. by split. rewrite Hb' ; apply Rabs_le_between ; rewrite Ropp_minus_distr' ; split ; apply Rplus_le_compat, Ropp_le_contravar. by apply Rmin_r. by apply Rle_trans with (2 := RmaxLess1 _ _), RmaxLess2. by apply RmaxLess2. by apply Rle_trans with (1 := Rmin_l _ _), Rmin_r. rewrite -Ha' => _ ; apply Rabs_le_between ; rewrite Ropp_minus_distr' ; split ; apply Rplus_le_compat, Ropp_le_contravar. by apply Rmin_r. by apply Rle_trans with (2 := RmaxLess1 _ _), RmaxLess1. by apply RmaxLess2. by apply Rle_trans with (1 := Rmin_l _ _), Rmin_l. split. apply Rlt_le, Rlt_le_trans with (1 := Ha), (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (SF_h ptd). apply (Hptd O (Nat.lt_0_succ _)). by apply Req_le. apply Rlt_le, Rle_lt_trans with (2 := Hstep) ; rewrite /seq_step /= -Hx1 ; apply RmaxLess1. rewrite /alpha /= ; apply (Rmax_case_strong (fmax-fmin)) => H. apply Req_le ; field. by apply Rgt_not_eq, Rlt_le_trans with (1 := Rlt_0_1), H. rewrite Rdiv_1 -{2}(Rmult_1_l (eps/2)) ; apply Rmult_le_compat_r. apply Rlt_le, eps2. apply H. apply ptd_sort, (ptd_cons (x0,y0)), Hptd. by rewrite /SF_lx /= Hb. rewrite Hx0 Riemann_sum_zero. change zero with 0. replace (c * (b - b) - 0) with 0 by ring. rewrite Rabs_R0 ; apply Rlt_le, eps2. apply ptd_sort, Hptd. by rewrite /SF_lx /= Hb. rewrite -Hb ; apply (sorted_last ((SF_h ptd)::(unzip1 (SF_t ptd))) O) with (x0 := 0). apply ptd_sort, Hptd. apply Nat.lt_0_succ. rewrite Riemann_sum_cons /= -Ha. rewrite Rminus_eq_0 scal_zero_l plus_zero_l. by apply IH. Qed. Lemma ex_RInt_Reals_1 (f : R -> R) (a b : R) : Riemann_integrable f a b -> ex_RInt f a b. Proof. move => pr ; exists (RiemannInt pr). exact: ex_RInt_Reals_aux_1. Qed. Lemma ex_RInt_Reals_0 (f : R -> R) (a b : R) : ex_RInt f a b -> Riemann_integrable f a b. Proof. wlog: a b /(a < b) => [Hw | Hab ] Hex. case: (Rle_lt_dec a b) => Hab. case: (Rle_lt_or_eq_dec _ _ Hab) => {} Hab. by apply Hw. rewrite -Hab. by apply RiemannInt_P7. apply ex_RInt_swap in Hex ; apply RiemannInt_P1 ; by apply Hw. assert ({If : R | is_RInt f a b If}). exists (RInt f a b). exact: RInt_correct. case: H => If HIf. generalize (proj1 (filterlim_locally _ If) HIf). clear HIf. intros HIf. set (E := fun eps : posreal => (fun alpha => 0 < alpha <= b-a + 1 /\ forall ptd : SF_seq, pointed_subdiv ptd -> seq_step (SF_lx ptd) < alpha -> SF_h ptd = Rmin a b -> last (SF_h ptd) (SF_lx ptd) = Rmax a b -> Rabs (If - sign (b - a) * Riemann_sum f ptd) < eps)). have E_bnd : forall eps : posreal, bound (E eps). move => eps ; exists (b-a+1) => x [Hx _] ; by apply Hx. have E_ex : forall eps : posreal, exists x, (E eps x). move => eps ; case: (HIf eps) => {HIf} alpha HIf. exists (Rmin alpha (b-a + 1)) ; split. apply Rmin_case_strong => H. split. by apply alpha. exact: H. split. apply Rplus_le_lt_0_compat. by apply (Rminus_le_0 a b), Rlt_le. exact: Rlt_0_1. exact: Rle_refl. intros. rewrite Rabs_minus_sym. apply: HIf. move: H0 ; apply Rmin_case_strong. by []. move => Halp Hstep ; by apply Rlt_le_trans with (b-a+1). split. exact: H. split. exact: H1. exact: H2. set alpha := fun eps : posreal => proj1_sig (completeness (E eps) (E_bnd eps) (E_ex eps)). have Ealpha : forall eps : posreal, (E eps (alpha eps)). revert alpha ; move => /= eps. case: (E_ex eps) => alp H. case: completeness => alpha [ub lub] /= ; split. split. apply Rlt_le_trans with alp. by apply H. by apply ub. apply: lub => x [Hx _] ; by apply Hx. intros. apply Rnot_le_lt ; contradict H1. apply Rle_not_lt. apply: lub => x [Hx1 Hx2]. apply Rnot_lt_le ; contradict H1. by apply Rlt_not_le, Hx2. have Hn : forall eps : posreal, {n : nat | (b-a)/(INR n + 1) < alpha eps}. move => eps. have Hn : 0 <= (b-a)/(alpha eps). apply Rdiv_le_0_compat. by apply Rlt_le, Rgt_minus. by apply Ealpha. set n := (nfloor _ Hn). exists n. apply Rlt_div_l. by apply INRp1_pos. rewrite Rmult_comm ; apply Rlt_div_l. by apply Ealpha. rewrite /n /nfloor ; case: nfloor_ex => /= n' Hn'. by apply Hn'. rewrite /Riemann_integrable. suff H : forall eps : posreal, {phi : StepFun a b & {psi : StepFun a b | (forall t : R, Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ Rabs (RiemannInt_SF psi) <= eps}}. move => eps ; set eps2 := pos_div_2 eps. case: (H eps2) => {H} phi [psi [H H0]]. exists phi ; exists psi ; split. exact: H. apply Rle_lt_trans with (1 := H0). apply Rminus_gt ; simpl ; field_simplify ; rewrite ?Rdiv_1 ; by apply eps2. move => eps ; set eps2 := pos_div_2 eps. case: (Hn eps2) => {Hn} n Hn. case: (Ealpha eps2) => {HIf} Halpha HIf. (* Construire phi *) set phi := sf_SF_val_fun f a b n. exists phi. (* Construire psi *) set psi1 := SF_sup_r (fun t => Rabs (f t - phi t)) a b n. have Haux : forall x, {i : nat | x = nth 0 (unif_part a b n) i /\ (i < size (unif_part a b n))%nat} + {(forall i, (i < size (unif_part a b n))%nat -> x <> nth 0 (unif_part a b n) i)}. move => x. have : {n0 : nat | x = nth 0 (unif_part a b n) n0 /\ (n0 < size (unif_part a b n))%nat} + {(forall n0 : nat, ~ (x = nth 0 (unif_part a b n) n0 /\ (n0 < size (unif_part a b n))%nat))}. apply (LPO (fun i => x = nth 0 (unif_part a b n) i /\ (i < size (unif_part a b n))%nat)). move => i. case: (Req_EM_T x (nth 0 (unif_part a b n) i)) => Hx. case: (lt_dec i (size (unif_part a b n))) => Hi. left ; split ; by []. right ; contradict Hi ; by apply Hi. right ; contradict Hx ; by apply Hx. case => [[i Hi] | Hx]. left ; by exists i. right => i Hi ; move: (Hx i) => {} Hx ; contradict Hx ; by split. set psi2_aux := fun x => match Haux x with | inleft Hi => Rabs (f x - phi x) - psi1 x | inright _ => 0 end. set psi2_ly := (SF_ly (SF_seq_f1 (fun _ => 0) (unif_part a b n))). have psi2_ad : adapted_couple psi2_aux a b (unif_part a b n) psi2_ly. split. by apply sorted_compat, unif_part_sort, Rlt_le. split. rewrite /Rmin ; case: Rle_dec (Rlt_le _ _ Hab) => //= _ _ ; field ; apply Rgt_not_eq ; by intuition. split. rewrite size_compat size_mkseq nth_compat nth_mkseq ?S_INR /=. rewrite /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ ; field ; apply Rgt_not_eq ; by intuition. by []. split. rewrite !size_compat /psi2_ly. by rewrite (SF_ly_f1 (fun _ => 0)) size_belast' size_map. rewrite size_compat => i Hi. rewrite !nth_compat /psi2_ly (SF_ly_f1 (fun _ => 0)) => x Hx. rewrite /psi2_aux => {psi2_aux} ; case: Haux => [ [j [Hx' Hj]] | Hx' ]. rewrite Hx' in Hx |- * ; case: Hx => Hxi Hxj. case: (lt_dec i j) => Hij. contradict Hxj ; apply Rle_not_lt. apply sorted_incr. by apply unif_part_sort, Rlt_le. by []. by []. contradict Hxi ; apply Rle_not_lt. apply sorted_incr. by apply unif_part_sort, Rlt_le. by apply not_lt. by intuition. move: i Hi {Hx} ; elim: (unif_part a b n) => /= [ i Hi | x0]. by apply Nat.nlt_0_r in Hi. case => /= [ | x1 s] IH i Hi. by apply Nat.nlt_0_r in Hi. case: i Hi => /= [ | i] Hi. by []. by apply IH, Nat.succ_lt_mono. have psi2_is : IsStepFun psi2_aux a b. exists (unif_part a b n). exists psi2_ly. by []. set psi2 := mkStepFun psi2_is. set psi := mkStepFun (StepFun_P28 1 psi1 psi2). exists psi. have Hfin : forall i, (S i < size (unif_part a b n))%nat -> is_finite (Sup_fct (fun t0 : R => Rabs (f t0 - phi t0)) (nth 0 (unif_part a b n) i) (nth 0 (unif_part a b n) (S i))). case: (ex_RInt_ub f a b Hex) => M HM. case: (StepFun_bound phi) => M' HM'. have : exists m, forall x : R, Rmin a b <= x <= Rmax a b -> m <= phi x. case: (StepFun_bound (mkStepFun (StepFun_P28 (-1) (mkStepFun (StepFun_P4 a b 0)) phi))) => /= m' Hm'. exists (-m') => x Hx. replace (phi x) with (- (fct_cte 0 x + -1 * phi x)) by (rewrite /fct_cte /= ; ring). by apply Ropp_le_contravar, Hm'. case => m' Hm' i ; rewrite size_mkseq => Hi ; rewrite !nth_mkseq. rewrite /Sup_fct. have H : (a + INR i * (b - a) / (INR n + 1)) < (a + (INR (S i)) * (b - a) / (INR n + 1)). rewrite S_INR ; apply Rminus_gt ; field_simplify. rewrite ?Rdiv_1 Rplus_comm ; apply Rdiv_lt_0_compat. by apply Rgt_minus. by apply INRp1_pos. by apply Rgt_not_eq, INRp1_pos. move: (Rlt_not_eq _ _ H) ; case: Req_EM_T => // H0 _. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ H) => // _ _. rewrite /Lub_Rbar ; case: ex_lub_Rbar ; case => [l | | ] [ub lub] /=. by []. case: (lub (Finite (Rmax (M - m') (-(-M - M'))))) => //. move => _ [x [-> Hx]]. apply Rabs_le_between_Rmax. suff H2 : Rmin a b <= x <= Rmax a b. split ; apply Rplus_le_compat, Ropp_le_contravar. apply Ropp_le_cancel, Rle_trans with (Rabs (f x)). by apply Rabs_maj2. rewrite Ropp_involutive ; by apply HM. by apply HM'. apply Rle_trans with (Rabs (f x)). by apply Rle_abs. by apply HM. by apply Hm'. rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ ; split ; apply Rlt_le. replace a with (a + INR O * (b - a) / (INR n + 1)) by (simpl ; field ; apply Rgt_not_eq, INRp1_pos). apply Rle_lt_trans with (2 := proj1 Hx). apply Rplus_le_compat_l, Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat ; by intuition. apply Rmult_le_compat_r. by apply Rlt_le, Rgt_minus. apply le_INR ; by intuition. replace b with (a + INR (S n) * (b - a) / (INR n + 1)) by (rewrite S_INR ; field ; apply Rgt_not_eq, INRp1_pos). apply Rlt_le_trans with (1 := proj2 Hx). apply Rplus_le_compat_l, Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat ; by intuition. apply Rmult_le_compat_r. by apply Rlt_le, Rgt_minus. apply le_INR ; by intuition. move: (a + INR i * (b - a) / (INR n + 1)) (a + INR (S i) * (b - a) / (INR n + 1)) ub H. clear => a0 b0 ub H. specialize (ub (Rabs (f ((a0 + b0) / 2) - phi ((a0 + b0) / 2)))) ; simpl in ub. assert (exists x : R, Rabs (f ((a0 + b0) / 2) - phi ((a0 + b0) / 2)) = Rabs (f x - phi x) /\ a0 < x < b0). eexists ; split => //. lra. by []. apply SSR_leq ; by intuition. apply SSR_leq ; by intuition. have Hfin' : forall t, is_finite (SF_sup_fun (fun t : R => Rabs (f t - phi t)) a b n t). rewrite /SF_sup_fun ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. rewrite /SF_fun /SF_sup_seq. case: (unif_part a b n) Hfin => [ | x0 sx] /=. move => _ t ; by case: Rle_dec. case: sx => [ | x1 sx] /=. move => _ t ; by case: Rle_dec. move => H t. case: Rlt_dec => Hx0. by []. elim: sx x0 x1 H Hx0 => [ | x2 sx IH] x0 x1 /= H Hx0. case: Rle_dec => Hx1. apply (H O) ; by intuition. by []. case: Rlt_dec => Hx1. apply (H O) ; by intuition. apply IH. move => i Hi ; apply (H (S i) (proj1 (Nat.succ_lt_mono _ _) Hi)). exact: Hx1. split. (* Partie 1 *) move => t Ht_ab. move: Ht_ab ; rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ Ht_ab. rewrite /= /psi2_aux /= ; case: (Haux t) => [ [i Hi] | Hi ] ; ring_simplify. exact: Rle_refl. change (Rbar_le (Rabs (f t - phi t)) (real (SF_sup_fun (fun t0 : R => Rabs (f t0 - phi t0)) a b n t))). rewrite Hfin'. rewrite /SF_sup_fun ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. rewrite /SF_fun /SF_sup_seq. move: (unif_part_sort a b n (Rlt_le _ _ Hab)). move: Ht_ab. pattern b at 1 ; replace b with (last 0 (unif_part a b n)). pattern a at 1 ; replace a with (head 0 (unif_part a b n)). have : (0 < size (unif_part a b n))%nat. rewrite size_mkseq ; exact: Nat.lt_0_succ. case: (unif_part a b n) Hi => [ | x0 sx] Hi Hsx Ht_ab Hsort /=. by apply Nat.lt_irrefl in Hsx. clear Hsx. case: sx Hsort Hi Ht_ab => [ | x1 sx] Hsort /= Hi [Ht_a Ht_b]. move: (Rle_antisym _ _ Ht_b Ht_a) => Ht. contradict Ht ; apply (Hi O (Nat.lt_succ_diag_r _)). apply Rle_not_lt in Ht_a. case: Rlt_dec => // _. elim: sx x0 x1 Hsort Ht_a Ht_b Hi => [ | x2 sx IH] x0 x1 Hsort /= Ht_a Ht_b Hi. case: Rle_dec => // _. rewrite /Sup_fct /Lub_Rbar. have H : x0 < x1. apply Rlt_trans with t. apply Rnot_lt_le in Ht_a ; case: Ht_a => Ht_a. by []. contradict Ht_a ; apply sym_not_eq, (Hi O). by apply Nat.lt_0_succ. case: Ht_b => Ht_b. by []. contradict Ht_b ; apply (Hi 1%nat). by apply Nat.lt_succ_diag_r. move: (Rlt_not_eq _ _ H) ; case: Req_EM_T => // H0 _. case: ex_lub_Rbar => l lub /=. apply lub ; exists t ; split. by []. rewrite /Rmin /Rmax ; case: Rle_dec (proj1 Hsort) => // _ _ ; split. apply Rnot_lt_le in Ht_a ; case: Ht_a => Ht_a. by []. contradict Ht_a ; apply sym_not_eq, (Hi O). by apply Nat.lt_0_succ. case: Ht_b => Ht_b. by []. contradict Ht_b ; apply (Hi 1%nat). by apply Nat.lt_succ_diag_r. case: Rlt_dec => Hx1. rewrite /Sup_fct /Lub_Rbar. have H : x0 < x1. apply Rlt_trans with t. apply Rnot_lt_le in Ht_a ; case: Ht_a => Ht_a. by []. contradict Ht_a ; apply sym_not_eq, (Hi O). by apply Nat.lt_0_succ. by apply Hx1. move: (Rlt_not_eq _ _ H) ; case: Req_EM_T => // H0 _. case: ex_lub_Rbar => l lub /=. apply lub ; exists t ; split. by []. rewrite /Rmin /Rmax ; case: Rle_dec (proj1 Hsort) => // _ _ ; split. apply Rnot_lt_le in Ht_a ; case: Ht_a => Ht_a. by []. contradict Ht_a ; apply sym_not_eq, (Hi O). by apply Nat.lt_0_succ. by []. apply IH. exact: (proj2 Hsort). exact: Hx1. exact: Ht_b. move => j Hj ; apply (Hi (S j) (proj1 (Nat.succ_lt_mono _ _) Hj)). apply head_unif_part. apply last_unif_part. (* Partie 2 *) (* * SF_lx ptd = unif_part a b n *) assert (forall g : R -> R -> R, let ptd := SF_seq_f2 g (unif_part a b n) in pointed_subdiv ptd -> Rabs (If - sign (b-a) * Riemann_sum f ptd) < eps2). move => g ptd Hptd. apply HIf. exact: Hptd. rewrite SF_lx_f2. suff : forall i, (S i < size (unif_part a b n))%nat -> nth 0 (unif_part a b n) (S i) - nth 0 (unif_part a b n) i = (b-a)/(INR n + 1). elim: (unif_part a b n) => /= [ | h0 t IH]. move => _ ; by apply Ealpha. case: t IH => /= [ | h1 t] IH Hnth. by apply Ealpha. replace (seq_step _) with (Rmax (Rabs (h1 - h0)) (seq_step (h1::t))) by auto. apply (Rmax_case_strong (Rabs (h1 - h0))) => /= _. rewrite (Hnth O (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))). rewrite Rabs_right. exact: Hn. apply Rle_ge, Rdiv_le_0_compat. by apply Rlt_le, Rgt_minus. by intuition. apply IH => i Hi. by apply (Hnth (S i)); apply ->Nat.succ_lt_mono. move => i ; rewrite size_mkseq => Hi ; rewrite !nth_mkseq. rewrite S_INR ; field ; apply Rgt_not_eq ; by intuition. apply SSR_leq ; by intuition. apply SSR_leq ; by intuition. by apply Nat.lt_0_succ. rewrite -> Rmin_left by now apply Rlt_le. apply head_unif_part. rewrite -nth_last SF_lx_f2. change (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n). rewrite -> Rmax_right by now apply Rlt_le. rewrite size_mkseq nth_mkseq. simpl ssrnat.predn ; rewrite S_INR ; field ; apply Rgt_not_eq ; by intuition. simpl ; apply SSR_leq, Nat.le_refl. by apply Nat.lt_0_succ. move: H => {} HIf. assert (forall g1 g2 : R -> R -> R, let ptd1 := SF_seq_f2 g1 (unif_part a b n) in let ptd2 := SF_seq_f2 g2 (unif_part a b n) in pointed_subdiv ptd1 -> pointed_subdiv ptd2 -> Rabs (Riemann_sum f ptd1 - Riemann_sum f ptd2) < eps). move => g1 g2 ptd1 ptd2 H1 H2. replace (Riemann_sum f ptd1 - Riemann_sum f ptd2) with ((If - sign (b - a) * Riemann_sum f ptd2) - (If - sign (b - a) * Riemann_sum f ptd1)). apply Rle_lt_trans with (1 := Rabs_triang _ _). rewrite Rabs_Ropp (double_var eps) ; apply Rplus_lt_compat ; by apply HIf. rewrite -> sign_eq_1 by exact: Rlt_Rminus. ring. move: H => {} HIf. rewrite /Riemann_sum in HIf. (* * oublier If *) assert (forall g1 g2 : R -> R -> R, let ptd1 := SF_seq_f2 g1 (unif_part a b n) in let ptd2 := SF_seq_f2 g2 (unif_part a b n) in pointed_subdiv ptd1 -> pointed_subdiv ptd2 -> Rabs (Riemann_sum (fun x => x) (SF_seq_f2 (fun x y => f (g1 x y) - f (g2 x y)) (unif_part a b n))) < eps). move => g1 g2 ptd1 pdt2 H1 H2. replace (Riemann_sum _ _ : R) with (Riemann_sum f (SF_seq_f2 g1 (unif_part a b n)) - Riemann_sum f (SF_seq_f2 g2 (unif_part a b n))). apply HIf. exact: H1. exact: H2. elim: (unif_part a b n) => /= [ | h0]. rewrite /Riemann_sum /= /plus /zero /= ; ring. case => /= [ | h1 t] IH. rewrite /Riemann_sum /= /plus /zero /= ; ring. rewrite !(SF_cons_f2 _ h0) /= ; try by intuition. rewrite !Riemann_sum_cons /= -IH /plus /scal /= /mult /= ; ring. move:H => {} HIf. (* * faire rentrer Rabs dans l'intégrale *) assert (forall g1 g2 : R -> R -> R, let ptd1 := SF_seq_f2 g1 (unif_part a b n) in let ptd2 := SF_seq_f2 g2 (unif_part a b n) in pointed_subdiv ptd1 -> pointed_subdiv ptd2 -> Riemann_sum id (SF_seq_f2 (fun x y : R => Rabs (f (g1 x y) - f (g2 x y))) (unif_part a b n)) < eps). move => g1 g2 ptd1 ptd2 H1 H2. set h1 := fun x y => match Rle_dec (f (g1 x y)) (f (g2 x y)) with | left _ => g2 x y | right _ => g1 x y end. set h2 := fun x y => match Rle_dec (f (g1 x y)) (f (g2 x y)) with | left _ => g1 x y | right _ => g2 x y end. replace (Riemann_sum id (SF_seq_f2 (fun x y : R => Rabs (f (g1 x y) - f (g2 x y))) (unif_part a b n))) with (Riemann_sum id (SF_seq_f2 (fun x y : R => (f (h1 x y) - f (h2 x y))) (unif_part a b n))). apply Rle_lt_trans with (1 := Rle_abs _). apply HIf. revert ptd1 ptd2 H1 H2. elim: (unif_part a b n) (0) => [z /= _ _ | x0]. move => i ; rewrite /SF_size /= => Hi ; by apply Nat.nlt_0_r in Hi. case => [ | x1 t] /= IH z H1 H2. move => i ; rewrite /SF_size /= => Hi ; by apply Nat.nlt_0_r in Hi. move: H1 H2 ; rewrite !(SF_cons_f2 _ x0) /= ; try by intuition. move => H1 H2 ; case => [ | i] /= Hi. rewrite /h1 ; case: Rle_dec => //= _. apply (H2 O (Nat.lt_0_succ _)). apply (H1 O (Nat.lt_0_succ _)). apply (IH x0 (ptd_cons _ _ H1) (ptd_cons _ _ H2)). apply Nat.succ_lt_mono, Hi. revert ptd1 ptd2 H1 H2. elim: (unif_part a b n) (0) => [z /= _ _ | x0]. move => i ; rewrite /SF_size /= => Hi ; by apply Nat.nlt_0_r in Hi. case => [ | x1 t] /= IH z H1 H2. move => i ; rewrite /SF_size /= => Hi ; by apply Nat.nlt_0_r in Hi. move: H1 H2 ; rewrite !(SF_cons_f2 _ x0) /= ; try by intuition. move => H1 H2 ; case => [ | i] /= Hi. rewrite /h2 ; case: Rle_dec => //= _. apply (H1 O (Nat.lt_0_succ _)). apply (H2 O (Nat.lt_0_succ _)). apply (IH x0 (ptd_cons _ _ H1) (ptd_cons _ _ H2)). apply Nat.succ_lt_mono, Hi. elim: (unif_part a b n) (0) => [x0 | x0]. by rewrite /Riemann_sum /= . case => [ | x1 t] IH z. by rewrite /Riemann_sum /= . rewrite !(SF_cons_f2 _ x0) /= ; try by intuition. rewrite !Riemann_sum_cons /=. apply f_equal2. rewrite /h1 /h2 /id ; case: Rle_dec => H0. rewrite Rabs_left1. apply f_equal. simpl ; ring. by apply Rle_minus. rewrite Rabs_right. apply f_equal. simpl ; ring. by apply Rgt_ge, Rgt_minus, Rnot_le_lt. by apply IH. move: H => {} HIf. (* * phi (g x y) = f (h x y) *) assert (forall g : R -> R -> R, (forall i j, (S i < size (unif_part a b n))%nat -> (j < size (unif_part a b n))%nat -> g (nth 0 (unif_part a b n) i) (nth 0 (unif_part a b n) (S i)) <> nth 0 (unif_part a b n) j) -> let ptd := SF_seq_f2 g (unif_part a b n) in pointed_subdiv ptd -> Riemann_sum id (SF_seq_f2 (fun x y : R => Rabs (f (g x y) - phi (g x y))) (unif_part a b n)) < eps). move => g1 Hg1 ptd1 H1. rewrite /phi /sf_SF_val_fun ; case: Rle_dec (Rlt_le _ _ Hab) => //= _ _. move: (unif_part_nat a b n) => Hp. set h := fun t => match Rle_dec a t with | right _ => t | left Ha => match Rle_dec t b with | right _ => t | left Hb => match Hp t (conj Ha Hb) with | inleft H => (a + (INR (proj1_sig H) + /2) * (b - a) / (INR n + 1)) | inright _ => (a + (INR n + /2) * (b - a) / (INR n + 1)) end end end. set g2 := fun x y => h (g1 x y). set ptd2 := SF_seq_f2 g2 (unif_part a b n). have H2 : pointed_subdiv ptd2. move => i ; move: (H1 i) => {H1}. rewrite !SF_lx_f2 ; (try by apply Nat.lt_0_succ) ; rewrite !SF_ly_f2 !SF_size_f2 size_mkseq. move => H1 Hi ; move: (H1 Hi) => {H1}. simpl in Hi. rewrite !nth_behead !(nth_pairmap 0). replace (nth 0 (0 :: unif_part a b n) (S i)) with (nth 0 (unif_part a b n) i) by auto. rewrite /g2 /h => {h g2 ptd2 ptd1} H1. case: Rle_dec => Ha. case: Rle_dec => Hb. case: Hp => [ [j [Ht Hj]] | Ht] ; simpl proj1_sig. suff Hij : j = i. rewrite Hij in Ht, Hj |- * => {j Hij}. rewrite !nth_mkseq. rewrite S_INR. split ; simpl ; apply Rminus_le_0 ; field_simplify. rewrite ?Rdiv_1 ; apply Rdiv_le_0_compat. rewrite Rplus_comm -Rminus_le_0 ; exact: (Rlt_le _ _ Hab). generalize (pos_INR n) ; lra. apply Rgt_not_eq ; by intuition. rewrite ?Rdiv_1 ; apply Rdiv_le_0_compat. rewrite Rplus_comm -Rminus_le_0 ; exact: (Rlt_le _ _ Hab). generalize (pos_INR n) ; lra. apply Rgt_not_eq ; by intuition. apply SSR_leq ; rewrite size_mkseq in Hi, Hj ; by intuition. apply SSR_leq ; rewrite size_mkseq in Hi, Hj ; by intuition. apply Nat.le_antisymm ; apply not_lt. have Hij : nth 0 (unif_part a b n) j < nth 0 (unif_part a b n) (S i). apply Rle_lt_trans with (g1 (nth 0 (unif_part a b n) i) (nth 0 (unif_part a b n) (S i))). by apply Ht. case: (proj2 H1) => {} H1. exact: H1. contradict H1 ; apply (Hg1 i (S i)). rewrite size_mkseq ; by apply ->Nat.succ_lt_mono. rewrite size_mkseq ; by apply ->Nat.succ_lt_mono. contradict Hij. apply Rle_not_lt, sorted_incr. apply unif_part_sort, Rlt_le, Hab. by []. by intuition. move: (Rle_lt_trans _ _ _ (proj1 H1) (proj2 Ht)) => Hij. contradict Hij. apply Rle_not_lt, sorted_incr. apply unif_part_sort, Rlt_le, Hab. by []. rewrite size_mkseq ; by intuition. suff : i = n. move => ->. rewrite !nth_mkseq ?S_INR. split ; simpl ; apply Rminus_le_0 ; field_simplify. rewrite ?Rdiv_1 ; apply Rdiv_le_0_compat. rewrite Rplus_comm -Rminus_le_0 ; exact: (Rlt_le _ _ Hab). generalize (pos_INR n) ; lra. apply Rgt_not_eq ; by intuition. rewrite ?Rdiv_1 ; apply Rdiv_le_0_compat. rewrite Rplus_comm -Rminus_le_0 ; exact: (Rlt_le _ _ Hab). generalize (pos_INR n) ; lra. apply Rgt_not_eq ; by intuition. apply SSR_leq ; by intuition. apply SSR_leq ; by intuition. apply Nat.le_antisymm ; apply not_lt. have Hij : nth 0 (unif_part a b n) i < nth 0 (unif_part a b n) (S n). apply Rle_lt_trans with (g1 (nth 0 (unif_part a b n) i) (nth 0 (unif_part a b n) (S i))). by apply H1. case: (proj2 Ht) => {} Ht. exact: Ht. contradict Ht ; apply Hg1. rewrite size_mkseq ; by apply ->Nat.succ_lt_mono. rewrite size_mkseq ; by apply Nat.lt_succ_diag_r. contradict Hij. apply Rle_not_lt, sorted_incr. apply unif_part_sort, Rlt_le , Hab. by intuition. rewrite size_mkseq ; by intuition. have Hij : nth 0 (unif_part a b n) (n) < nth 0 (unif_part a b n) (S i). apply Rle_lt_trans with (g1 (nth 0 (unif_part a b n) i) (nth 0 (unif_part a b n) (S i))). by apply Ht. case: (proj2 H1) => {} H1. exact: H1. contradict H1 ; apply Hg1. rewrite size_mkseq ; by intuition. rewrite size_mkseq ; by intuition. contradict Hij. apply Rle_not_lt, sorted_incr. apply unif_part_sort, Rlt_le, Hab. by []. rewrite size_mkseq ; by intuition. exact: H1. exact: H1. apply SSR_leq ; rewrite size_mkseq ; by intuition. apply SSR_leq ; rewrite size_mkseq ; by intuition. move: (HIf g1 g2 H1 H2). replace (SF_seq_f2 (fun x y : R => Rabs (f (g1 x y) - SF_val_fun f a b n (g1 x y))) (unif_part a b n)) with (SF_seq_f2 (fun x y : R => Rabs (f (g1 x y) - f (g2 x y))) (unif_part a b n)). by []. have H0 : forall t, a <= t <= b -> SF_val_fun f a b n t = f (h t). move => t Ht. rewrite /h SF_val_fun_rw. case: Ht => Ha Hb. case: Rle_dec => // Ha'. case: Rle_dec => // Hb'. case: unif_part_nat => [ [i [Ht Hi]] | Ht] ; case: Hp {h g2 ptd2 H2} => [ [j [Ht' Hj]] | Ht'] ; simpl proj1_sig. apply (f_equal (fun i => f (a + (INR i + /2) * (b - a) / (INR n + 1)))). apply Nat.le_antisymm ; apply not_lt. move: (Rle_lt_trans _ _ _ (proj1 Ht) (proj2 Ht')) => Hij ; contradict Hij. apply Rle_not_lt, sorted_incr. apply unif_part_sort, Rlt_le, Hab. by []. by intuition. move: (Rle_lt_trans _ _ _ (proj1 Ht') (proj2 Ht)) => Hij ; contradict Hij. apply Rle_not_lt, sorted_incr. by apply unif_part_sort, Rlt_le. by []. by intuition. absurd (i < n)%nat. move: (Rle_lt_trans _ _ _ (proj1 Ht') (proj2 Ht)) => Hij ; contradict Hij. apply Rle_not_lt, sorted_incr. by apply unif_part_sort, Rlt_le. by []. rewrite size_mkseq ; by intuition. rewrite size_mkseq in Hi ; by intuition. absurd (j < n)%nat. move: (Rle_lt_trans _ _ _ (proj1 Ht) (proj2 Ht')) => Hij ; contradict Hij. apply Rle_not_lt, sorted_incr. by apply unif_part_sort, Rlt_le. by []. rewrite size_mkseq ; by intuition. rewrite size_mkseq in Hj ; by intuition. by []. rewrite /g2. have : forall i, (i < size (unif_part a b n))%nat -> a <= nth 0 (unif_part a b n) i <= b. move => i ; rewrite size_mkseq => Hi ; rewrite nth_mkseq. pattern b at 3 ; replace b with (a + (INR n + 1) * (b - a) / (INR n + 1)) by (field ; apply Rgt_not_eq ; intuition). pattern a at 1 ; replace a with (a + 0 * (b - a) / (INR n + 1)) by (field ; apply Rgt_not_eq ; intuition). apply Rgt_minus in Hab. split ; apply Rplus_le_compat_l ; repeat apply Rmult_le_compat_r ; try by intuition. rewrite -S_INR ; apply le_INR ; by intuition. by apply SSR_leq. revert ptd1 H1 ; elim: (unif_part a b n) => [ ptd1 H1 Hnth | x0 ]. by []. case => [ | x1 s] IH ptd1 H1 Hnth. by []. revert ptd1 H1 ; rewrite !(SF_cons_f2 _ x0) /= ; try by intuition. intro ; apply (f_equal2 (fun x y => SF_cons (x0, Rabs (f (g1 x0 x1) - x)) y)). apply sym_equal, H0. move: (H1 O (Nat.lt_0_succ _)) (Hnth O (Nat.lt_0_succ _)) (Hnth 1%nat (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))) => /= ; intuition. by apply Rle_trans with x0. by apply Rle_trans with x1. apply (IH (ptd_cons _ _ H1)). move => i Hi ; apply (Hnth (S i)) ; simpl in Hi |- * ; by apply ->Nat.succ_lt_mono. move: H => {} HIf. rewrite Rabs_right. (* * dernière étape :-) *) replace (RiemannInt_SF psi) with (Riemann_sum id (SF_seq_f2 (fun x y : R => real (Sup_fct (fun t => Rabs (f t - phi t)) x y)) (unif_part a b n))). set (F := fun s val => exists g : R -> R -> R, (forall (i j : nat), (S i < size s)%nat -> (j < size s)%nat -> g (nth 0 s i) (nth 0 s (S i)) <> nth 0 s j) /\ (let ptd := SF_seq_f2 g s in pointed_subdiv ptd) /\ Riemann_sum id (SF_seq_f2 (fun x y : R => Rabs (f (g x y) - phi (g x y))) s) = val). cut (is_lub (F (unif_part a b n)) (Riemann_sum id (SF_seq_f2 (fun x y : R => real (Sup_fct (fun t : R => Rabs (f t - phi t)) x y)) (unif_part a b n)))) => [ Hlub | ]. apply Hlub => val [g [Hnth [H0 Hval]]]. apply Rlt_le ; rewrite -Hval. apply HIf. exact: Hnth. exact: H0. 2: { rewrite StepFun_P30. replace (RiemannInt_SF psi2) with 0. rewrite Rmult_0_r Rplus_0_r /RiemannInt_SF SF_sup_subdiv SF_sup_subdiv_val ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. elim: (unif_part a b n) (unif_part_sort a b n (Rlt_le _ _ Hab)) => [ Hsort | x0 ]. by []. case => [ | x1 s] IH Hsort. by []. rewrite SF_cons_f2 /=. rewrite Riemann_sum_cons /=. rewrite Rmult_comm. by apply f_equal, IH, Hsort. exact: Nat.lt_0_succ. rewrite /RiemannInt_SF ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. rewrite (StepFun_P17 (StepFun_P1 psi2) psi2_ad). clear psi2_ad. revert psi2_ly ; elim: (unif_part a b n) => /= [ | x0]. by []. case => /= [ | x1 s] IH. by []. rewrite -IH ; ring. } 2: { rewrite StepFun_P30. replace (RiemannInt_SF psi2) with 0. rewrite Rmult_0_r Rplus_0_r ; rewrite /RiemannInt_SF SF_sup_subdiv SF_sup_subdiv_val ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. elim: (unif_part a b n) (unif_part_sort a b n (Rlt_le _ _ Hab)) => [ Hsort /= | x0]. by apply Rge_refl. case => [ | x1 s] IH Hsort /=. by apply Rge_refl. apply Rle_ge, Rplus_le_le_0_compat. apply Rmult_le_pos. rewrite /Sup_fct /Lub_Rbar. case: Req_EM_T => Hx0. by apply Rle_refl. case: ex_lub_Rbar ; case => [l | | ] [ub lub] /=. apply Rle_trans with (Rabs (f ((x0+x1)/2) - phi ((x0+x1)/2))). apply Rabs_pos. apply ub. exists ((x0+x1)/2) ; split. by []. rewrite /Rmin /Rmax ; case: Rle_dec (proj1 Hsort) => // _ _. pattern x1 at 3 ; replace x1 with ((x1 + x1)/2) by field. pattern x0 at 1 ; replace x0 with ((x0 + x0)/2) by field. split ; apply Rmult_lt_compat_r. by apply Rinv_0_lt_compat, Rlt_R0_R2. apply Rplus_lt_compat_l ; by case: (proj1 Hsort). by apply Rinv_0_lt_compat, Rlt_R0_R2. apply Rplus_lt_compat_r ; by case: (proj1 Hsort). apply Rle_refl. apply Rle_refl. apply -> Rminus_le_0 ; apply Hsort. apply Rge_le, IH, Hsort. rewrite /RiemannInt_SF ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _. rewrite (StepFun_P17 (StepFun_P1 psi2) psi2_ad). clear psi2_ad. revert psi2_ly ; elim: (unif_part a b n) => /= [ | x0]. by []. case => /= [ | x1 s] IH. by []. rewrite -IH ; ring. } (* ** c'est la bonne borne sup *) move: Hfin. have : sorted Rlt (unif_part a b n). apply sorted_nth => i. rewrite size_mkseq => Hi x0 ; rewrite !nth_mkseq. apply Rminus_gt ; rewrite S_INR ; field_simplify. rewrite ?Rdiv_1. apply Rdiv_lt_0_compat. rewrite Rplus_comm ; by apply Rgt_minus. by intuition. apply Rgt_not_eq ; by intuition. apply SSR_leq ; by intuition. apply SSR_leq ; by intuition. elim: (unif_part a b n) (unif_part_sort a b n (Rlt_le _ _ Hab)) => [ Hle Hlt Hfin | x1]. split ; rewrite /Riemann_sum /=. move => val [g [Hnth [Hptd Hval]]]. rewrite -Hval ; by apply Rle_refl. move => ub Hub ; apply: Hub. exists (fun _ _ => 0). split. move => i j Hi Hj ; by apply Nat.nlt_0_r in Hi. split. move => ptd i Hi ; by apply Nat.nlt_0_r in Hi. split. case => [ | x2 s] IH Hle Hlt Hfin. split ; rewrite /Riemann_sum /=. move => val [g [Hnth [Hptd Hval]]]. rewrite -Hval ; by apply Rle_refl. move => ub Hub ; apply: Hub. exists (fun _ _ => 0). split. move => i j Hi Hj. simpl in Hi ; by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. split. move => ptd i Hi ; by apply Nat.nlt_0_r in Hi. split. rewrite SF_cons_f2 /= ; last by apply Nat.lt_0_succ. rewrite Riemann_sum_cons /=. set F0 := fun x => exists t, x1 < t < x2 /\ x = Rabs (f t - phi t) * (x2 - x1). set set_plus := fun (F : R -> Prop) (G : R -> Prop) (x : R) => exists y, exists z, x = y + z /\ F y /\ G z. suff H0 : forall (x : R), F [:: x1, x2 & s] x <-> (set_plus (F0) (F (x2::s))) x. cut (is_lub (set_plus (F0) (F (x2::s))) (real (Sup_fct (fun t : R => Rabs (f t - phi t)) x1 x2) * (x2 - x1) + Riemann_sum id (SF_seq_f2 (fun x y : R => real (Sup_fct (fun t : R => Rabs (f t - phi t)) x y)) (x2 :: s)))) => [H1 | ]. split. move => x Hx. rewrite /plus /scal /= /mult /= Rmult_comm. by apply H1, H0. move => ub Hub. rewrite /plus /scal /= /mult /= Rmult_comm. apply H1 => x Hx ; by apply Hub, H0. suff H_F0 : is_lub (F0) (real (Sup_fct (fun t : R => Rabs (f t - phi t)) x1 x2) * (x2 - x1)). have Hfin0 : (forall i : nat, (S i < size (x2 :: s))%nat -> is_finite (Sup_fct (fun t0 : R => Rabs (f t0 - phi t0)) (nth 0 (x2 :: s) i) (nth 0 (x2 :: s) (S i)))). move => i /= Hi ; move: (Hfin (S i) (proj1 (Nat.succ_lt_mono _ _) Hi)) => /= {Hfin}. by []. move: H_F0 (IH (proj2 Hle) (proj2 Hlt) Hfin0). move: (F0 (pos_div_2 eps)) (F (x2::s) (pos_div_2 eps)) (real (Sup_fct (fun t : R => Rabs (f t - phi t)) x1 x2) * (x2 - x1)) (Riemann_sum id (SF_seq_f2 (fun x4 y : R => real (Sup_fct (fun t : R => Rabs (f t - phi t)) x4 y)) (x2 :: s))). move => F1 F2 l1 l2 Hl1 Hl2. split. move => _ [y [z [-> Hx]]]. apply Rplus_le_compat. by apply Hl1, Hx. by apply Hl2, Hx. move => ub Hub. replace ub with ((ub-l2) + l2) by ring. apply Rplus_le_compat_r. apply Hl1 => y Hy. replace y with (l2 + (y - l2)) by ring. replace (ub-l2) with ((ub - y) + (y - l2)) by ring. apply Rplus_le_compat_r. apply Hl2 => z Hz. replace z with ((y+z) - y) by ring. apply Rplus_le_compat_r. apply Hub. exists y ; exists z ; by intuition. move: (Hfin O (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))). rewrite /Sup_fct /=. move: (Rlt_not_eq _ _ (proj1 Hlt)). case: Req_EM_T => // Hx1 _. rewrite /Lub_Rbar ; case: ex_lub_Rbar ; case => [l | | ] [ub lub] ; simpl. split. move => _ [t [Ht ->]]. apply Rmult_le_compat_r. apply -> Rminus_le_0 ; apply Hle. apply ub ; exists t ; split. by []. rewrite /Rmin /Rmax ; case: Rle_dec (proj1 Hle) => // _ _ ; by intuition. move => b0 Hb0. move: (Rgt_minus _ _ (proj1 Hlt)) => H1. replace b0 with ((b0 / (x2 - x1)) * (x2 - x1)) by (field ; by apply Rgt_not_eq). apply Rmult_le_compat_r. by apply Rlt_le. change (Rbar_le l (b0 / (x2 - x1))). apply lub => _ [t [-> Ht]]. replace (Rabs (f t - phi t)) with ((Rabs (f t - phi t) * (x2 - x1)) / (x2 - x1)) by (field ; by apply Rgt_not_eq). apply Rmult_le_compat_r. by apply Rlt_le, Rinv_0_lt_compat. apply Hb0 ; exists t. split. move: Ht ; rewrite /Rmin /Rmax ; case: Rle_dec (proj1 Hle) => //. by []. by []. by []. move => val ; split => Hval. case: Hval => g [Hnth [Hptd <-]] {val}. rewrite SF_cons_f2 /=. rewrite Riemann_sum_cons /=. exists (Rabs (f (g x1 x2) - phi (g x1 x2)) * (x2 - x1)). exists (Riemann_sum id (SF_seq_f2 (fun x y : R => Rabs (f (g x y) - phi (g x y))) (x2 :: s))). split. rewrite Rmult_comm. by []. split. exists (g x1 x2) ; split. case: (Hptd O) => /=. rewrite SF_size_f2 /= ; exact: Nat.lt_0_succ. case => Hx1. case => Hx2. by split. contradict Hx2 ; apply (Hnth O 1%nat). simpl ; by intuition. simpl ; by intuition. contradict Hx1 ; apply sym_not_eq, (Hnth O O). simpl ; by intuition. simpl ; by intuition. by []. exists g. split. move => i j Hi Hj. apply (Hnth (S i) (S j)). simpl ; apply ->Nat.succ_lt_mono; apply Hi. simpl ; apply ->Nat.succ_lt_mono; apply Hj. split. move: Hptd => /=. rewrite SF_cons_f2 /=. apply ptd_cons. apply Nat.lt_0_succ. split. exact: Nat.lt_0_succ. case: Hval => /= y Hy. case: Hy => /= z [-> [F0y Fz]]. case: F0y => t [Ht ->]. case: Fz => g [Hnth [Hpdt <-]]. set g0 := fun x y => match Req_EM_T x x1 with | left _ => match Req_EM_T y x2 with | left _ => t | right _ => g x y end | right _ => g x y end. exists g0. split. move => {val y z} i j Hi Hj. rewrite /g0. case: Req_EM_T => Hx1'. case: Req_EM_T => Hx2'. case: j Hj => /= [ | j] Hj. by apply Rgt_not_eq, Ht. apply Nat.succ_lt_mono in Hj ; case: j Hj => /= [ | j] Hj. by apply Rlt_not_eq, Ht. move: (proj2 Hle : sorted Rle (x2 :: s)). apply Nat.succ_lt_mono in Hj ; move: (proj2 Ht) ; elim: j x2 s Hj {IH Hle Hlt Hfin Hnth Hpdt F0 Ht g0 Hx2' Hx1' i Hi} => [ | i IH] x0 ; case => {x1} [ | x1 s] Hi Ht Hle ; simpl. by apply Nat.lt_irrefl in Hi. apply Rlt_not_eq, Rlt_le_trans with (1 := Ht). by apply Hle. by apply Nat.nlt_0_r in Hi. apply (IH x1). by apply Nat.succ_lt_mono, Hi. apply Rlt_le_trans with (1 := Ht). by apply Hle. by apply Hle. case: i j Hi Hj Hx1' Hx2' => /= [ | i] j Hi Hj Hx1' Hx2'. by []. case: j Hj => /= [ | j] Hj. apply Rgt_not_eq, Rlt_le_trans with x2. apply Rlt_trans with t ; by intuition. apply Rle_trans with (nth 0 (x2 :: s) i). apply (sorted_incr (x2 :: s) O i). move: (ptd_sort _ Hpdt). rewrite /SF_sorted SF_lx_f2 // ; by apply Nat.lt_0_succ. by intuition. simpl ; by intuition. move: (Hpdt i). rewrite SF_size_f2 SF_lx_f2 ; (try by apply Nat.lt_0_succ) ; rewrite SF_ly_f2 (nth_pairmap 0) /=. move => H ; apply H. by intuition. apply SSR_leq ; by intuition. apply Hnth. by intuition. by intuition. simpl in Hi ; apply Nat.succ_lt_mono in Hi ; case: i Hi Hx1' => /= [ | i] Hi Hx1'. by []. case: j Hj => /= [ | j] Hj. apply Rgt_not_eq, Rlt_le_trans with x2. apply Rlt_trans with t ; by intuition. apply Rle_trans with (nth 0 (x2 :: s) i). apply (sorted_incr (x2 :: s) O i). move: (ptd_sort _ Hpdt). by rewrite /SF_sorted SF_lx_f2 // ; apply Nat.lt_0_succ. by intuition. simpl ; by intuition. move: (Hpdt i). rewrite SF_size_f2 SF_lx_f2 ; (try by apply Nat.lt_0_succ) ; rewrite SF_ly_f2 (nth_pairmap 0) /=. move => H ; apply H. by intuition. apply SSR_leq ; by intuition. apply Hnth. by intuition. by intuition. split. move => ptd i Hi. rewrite SF_size_f2 /= in Hi. rewrite SF_lx_f2 ; (try by apply Nat.lt_0_succ) ; rewrite SF_ly_f2 nth_behead (nth_pairmap 0) /=. case: i Hi => /= [ | i] Hi ; rewrite /g0. move: (refl_equal x1) ; case: Req_EM_T => // _ _. move: (refl_equal x2) ; case: Req_EM_T => // _ _. split ; apply Rlt_le ; by intuition. suff : (nth 0 (x2 :: s) i) <> x1. case: Req_EM_T => // _ _. move: (Hpdt i). rewrite SF_size_f2 SF_lx_f2 ; (try by apply Nat.lt_0_succ) ; rewrite SF_ly_f2 nth_behead (nth_pairmap 0) /=. move => H ; apply H ; by intuition. apply SSR_leq ; by intuition. apply Rgt_not_eq, Rlt_le_trans with x2. apply Rlt_trans with t ; by intuition. apply (sorted_incr (x2 :: s) O i). move: (ptd_sort _ Hpdt). by rewrite /SF_sorted SF_lx_f2 // ; apply Nat.lt_0_succ. by intuition. simpl ; by intuition. apply SSR_leq ; by intuition. rewrite SF_cons_f2 /=. rewrite Riemann_sum_cons /=. apply f_equal2. rewrite /g0 ; move: (refl_equal x1) ; case: Req_EM_T => // _ _. move: (refl_equal x2) ; case: Req_EM_T => // _ _. apply Rmult_comm. case: s Hlt {Hpdt IH Hle Hfin F0 Ht Hnth} => [ | x3 s] Hlt /=. apply refl_equal. rewrite !(SF_cons_f2 _ _ (x3 :: _)) /=. rewrite !Riemann_sum_cons /=. apply f_equal2. rewrite /g0 /id ; move: (Rgt_not_eq _ _ (proj1 Hlt)) ; by case: Req_EM_T. elim: s (x2) x3 Hlt => [ | x4 s IH] x2' x3 Hlt. exact: refl_equal. rewrite !(SF_cons_f2 _ _ (x4 :: _)) /=. rewrite !Riemann_sum_cons /=. apply f_equal2. rewrite /g0 ; move: (Rgt_not_eq _ _ (Rlt_trans _ _ _ (proj1 Hlt) (proj1 (proj2 Hlt)))) ; by case: Req_EM_T. apply (IH x3). split. apply Rlt_trans with x2' ; apply Hlt. apply Hlt. exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. Qed. Lemma RInt_Reals (f : R -> R) (a b : R) : forall pr, RInt f a b = @RiemannInt f a b pr. Proof. intros pr. apply is_RInt_unique. apply ex_RInt_Reals_aux_1. Qed. (** ** Theorems proved using standard library *) Lemma ex_RInt_norm : forall (f : R -> R) a b, ex_RInt f a b -> ex_RInt (fun x => norm (f x)) a b. Proof. intros f a b If. apply ex_RInt_Reals_1. apply RiemannInt_P16. now apply ex_RInt_Reals_0. Qed. Lemma abs_RInt_le : forall (f : R -> R) a b, a <= b -> ex_RInt f a b -> Rabs (RInt f a b) <= RInt (fun t => Rabs (f t)) a b. Proof. intros f a b H1 If. apply: (norm_RInt_le f (fun t : R => norm (f t)) a b). exact H1. move => x _ ; by apply Rle_refl. exact: RInt_correct. apply: RInt_correct. exact: ex_RInt_norm. Qed. coquelicot-coquelicot-3.4.1/theories/RInt_analysis.v000066400000000000000000001530751455143432500226440ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond #
# Copyright (C) 2016-2017 Thomas Sibut-Pinote This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect ssrbool. From mathcomp Require Import eqtype seq. Require Import Markov Rcomplements Rbar Lub Lim_seq Derive SF_seq. Require Import Continuity Hierarchy Seq_fct RInt PSeries. (** This file contains results about the integral as a function: continuity, differentiability, and composition. Theorems on parametric integrals are also provided. *) (** * Continuity *) Section Continuity. Context {V : NormedModule R_AbsRing}. Lemma continuous_RInt_0 : forall (f : R -> V) (a : R) If, locally a (fun x => is_RInt f a x (If x)) -> continuous If a. Proof. move => f a If [d1 /= CIf]. assert (forall eps : posreal, norm (If a) < eps). move => eps. generalize (fun Hy => proj1 (filterlim_locally_ball_norm _ _) (CIf a Hy) eps) => /= {} CIf. assert (Rabs (a + - a) < d1). rewrite -/(Rminus _ _) Rminus_eq_0 Rabs_R0. by apply d1. destruct (CIf H) as [d CIf']. assert (exists y : SF_seq, seq_step (SF_lx y) < d /\ pointed_subdiv y /\ SF_h y = Rmin a a /\ seq.last (SF_h y) (SF_lx y) = Rmax a a). apply filter_ex. exists d => y Hy Hy'. now split. case: H0 => {CIf H} ptd [Hstep Hptd]. specialize (CIf' ptd Hstep Hptd). rewrite Rminus_eq_0 sign_0 in CIf'. rewrite -norm_opp. replace (opp (If a)) with (minus (scal 0 (Riemann_sum f ptd)) (If a)). by apply CIf'. replace (scal 0 (Riemann_sum f ptd) : V) with (zero : V). by rewrite /minus plus_zero_l. apply sym_eq ; apply: scal_zero_l. apply filterlim_locally_ball_norm. cut (forall eps : posreal, locally a (fun x : R => norm (If x) < eps)). move => H0 eps. specialize (H (pos_div_2 eps)). specialize (H0 (pos_div_2 eps)). destruct H0 as [d Hd]. exists d => /= y Hy. apply Rle_lt_trans with (norm (If y) + norm (If a))%R. rewrite -(norm_opp (If a)). apply @norm_triangle. rewrite (double_var eps). apply Rplus_lt_compat. now apply Hd. by apply H. clear H. move => eps. destruct (ex_RInt_ub f (a - d1 / 2) (a + d1 / 2)) as [Mf HMf]. apply ex_RInt_Chasles with a. apply ex_RInt_swap ; eexists ; apply CIf. rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=. field_simplify (a - d1 / 2 + - a)%R. rewrite Rabs_left. apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. apply Ropp_lt_cancel ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. eexists ; apply CIf. rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=. field_simplify (a + d1 / 2 + - a)%R. rewrite Rabs_pos_eq. apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. apply Rlt_le ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. assert ((a - d1 / 2) <= (a + d1 / 2)). apply Rminus_le_0. replace (a + d1 / 2 - (a - d1 / 2))%R with (d1 : R) by field. by apply Rlt_le, d1. move: HMf ; rewrite /Rmin /Rmax ; case: Rle_dec => // _ HMf. assert (0 <= Mf). eapply Rle_trans. 2: apply (HMf (a - d1 / 2)%R) ; split => // ; by apply Rle_refl. by apply norm_ge_0. generalize (fun y Hy => proj1 (filterlim_locally_ball_norm _ _) (CIf y Hy) (pos_div_2 eps)) => /= {} CIf. assert (0 < Rmin (d1 / 2) (eps / (2 * (Mf + 1)))). apply Rmin_case. by apply is_pos_div_2. apply Rdiv_lt_0_compat. by apply eps. apply Rmult_lt_0_compat. by apply Rlt_0_2. apply Rplus_le_lt_0_compat. by []. by apply Rlt_0_1. set (d2 := mkposreal _ H1). exists d2 => x /= Hx. specialize (CIf x). destruct CIf as [d' CIf]. apply Rlt_trans with (1 := Hx). apply Rle_lt_trans with (1 := Rmin_l _ _). apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1 ; by apply is_pos_div_2. assert (exists y0, seq_step (SF_lx y0) < d' /\ pointed_subdiv y0 /\ SF_h y0 = Rmin a x /\ seq.last (SF_h y0) (SF_lx y0) = Rmax a x). apply filter_ex. exists d' => y Hy Hy'. now split. case: H2 => ptd [Hstep Hptd]. specialize (CIf ptd Hstep Hptd). rewrite -norm_opp. replace (opp (If x)) with (minus (minus (scal (sign (x - a)) (Riemann_sum f ptd)) (If x)) (scal (sign (x - a)) (Riemann_sum f ptd))). 2: rewrite /minus plus_comm plus_assoc plus_opp_l. 2: by apply plus_zero_l. apply Rle_lt_trans with (norm (minus (scal (sign (x - a)) (Riemann_sum f ptd)) (If x)) + norm (opp (scal (sign (x - a)) (Riemann_sum f ptd))))%R. rewrite /minus ; by apply @norm_triangle. rewrite norm_opp (double_var eps). apply Rplus_lt_le_compat. by []. apply Rle_trans with (1 := norm_scal (sign (x - a)) _). apply Rle_trans with (1 * norm (Riemann_sum f ptd)). apply Rmult_le_compat_r. apply norm_ge_0. rewrite /abs /= /sign ; case: total_order_T => [[H2|H2]|H2]. rewrite Rabs_R1. apply Rle_refl. rewrite Rabs_R0. apply Rle_0_1. rewrite Rabs_Ropp Rabs_R1. apply Rle_refl. rewrite Rmult_1_l. apply Rle_trans with (Riemann_sum (fun _ => Mf) ptd). apply Riemann_sum_norm. apply Hptd. move => t. rewrite (proj2 (proj2 Hptd)) (proj1 (proj2 Hptd)) => Ht. apply HMf ; split ; eapply Rle_trans ; try apply Ht. apply Rmin_case. apply Rlt_le, Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1 ; by apply is_pos_div_2. apply Rlt_le, Rabs_lt_between'. apply Rlt_le_trans with (1 := Hx). by apply Rmin_l. apply Rmax_case. apply Rlt_le, Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1 ; by apply is_pos_div_2. apply Rlt_le, Rabs_lt_between'. apply Rlt_le_trans with (1 := Hx). by apply Rmin_l. rewrite Riemann_sum_const. rewrite (proj2 (proj2 Hptd)) (proj1 (proj2 Hptd)) /=. apply Rle_trans with (Rabs (x + - a) * Mf)%R. apply Rmult_le_compat_r. by []. rewrite /Rmin /Rmax ; case: Rle_dec => _. apply Rle_abs. rewrite -Ropp_minus_distr. apply Rabs_maj2. apply Rle_trans with (Rabs (x + - a) * (Mf + 1))%R. apply Rmult_le_compat_l. by apply Rabs_pos. apply Rminus_le_0 ; ring_simplify ; by apply Rle_0_1. apply Rle_div_r. apply Rlt_le_trans with (1 := Rlt_0_1). apply Rminus_le_0 ; by ring_simplify. apply Rlt_le, Rlt_le_trans with (1 := Hx). apply Rle_trans with (1 := Rmin_r _ _). apply Req_le ; field. apply Rgt_not_eq, Rlt_le_trans with (1 := Rlt_0_1). apply Rminus_le_0 ; by ring_simplify. Qed. Lemma continuous_RInt_1 (f : R -> V) (a b : R) (If : R -> V) : locally b (fun z : R => is_RInt f a z (If z)) -> continuous If b. Proof. intros. generalize (locally_singleton _ _ H) => /= Hab. apply continuous_ext with (fun z => plus (If b) (minus (If z) (If b))) ; simpl. intros x. by rewrite plus_comm -plus_assoc plus_opp_l plus_zero_r. eapply filterlim_comp_2, filterlim_plus. apply filterlim_const. apply (continuous_RInt_0 f _ (fun x : R_UniformSpace => minus (If x) (If b))). apply: filter_imp H => x Hx. rewrite /minus plus_comm. eapply is_RInt_Chasles, Hx. by apply is_RInt_swap. Qed. Lemma continuous_RInt_2 (f : R -> V) (a b : R) (If : R -> V) : locally a (fun z : R => is_RInt f z b (If z)) -> continuous If a. Proof. intros. generalize (locally_singleton _ _ H) => /= Hab. apply continuous_ext with (fun z => opp (plus (opp (If a)) (minus (If a) (If z)))) ; simpl. intros x. by rewrite /minus plus_assoc plus_opp_l plus_zero_l opp_opp. apply continuous_opp. apply continuous_plus. apply filterlim_const. apply (continuous_RInt_0 f _ (fun x : R_UniformSpace => minus (If a) (If x))). apply: filter_imp H => x Hx. eapply is_RInt_Chasles. by apply Hab. by apply is_RInt_swap. Qed. Lemma continuous_RInt (f : R -> V) (a b : R) (If : R -> R -> V) : locally (a,b) (fun z : R * R => is_RInt f (fst z) (snd z) (If (fst z) (snd z))) -> continuous (fun z : R * R => If (fst z) (snd z)) (a,b). Proof. intros HIf. move: (locally_singleton _ _ HIf) => /= Hab. apply continuous_ext_loc with (fun z : R * R => plus (If (fst z) b) (plus (opp (If a b)) (If a (snd z)))) ; simpl. assert (Ha : locally (a,b) (fun z : R * R => is_RInt f a (snd z) (If a (snd z)))). case: HIf => /= d HIf. exists d => y /= Hy. apply (HIf (a,(snd y))) ; split => //=. by apply ball_center. by apply Hy. assert (Hb : locally (a,b) (fun z : R * R => is_RInt f (fst z) b (If (fst z) b))). case: HIf => /= d HIf. exists d => x /= Hx. apply (HIf (fst x,b)) ; split => //=. by apply Hx. by apply ball_center. generalize (filter_and _ _ HIf (filter_and _ _ Ha Hb)). apply filter_imp => {HIf Ha Hb} /= x [HIf [Ha Hb]]. apply eq_close. eapply filterlim_locally_close. eapply is_RInt_Chasles. by apply Hb. eapply is_RInt_Chasles. by apply is_RInt_swap, Hab. by apply Ha. by apply HIf. eapply filterlim_comp_2, filterlim_plus ; simpl. apply (continuous_comp (fun x => fst x) (fun x => If x b)) ; simpl. apply continuous_fst. eapply (continuous_RInt_2 f _ b). case: HIf => /= d HIf. exists d => x /= Hx. apply (HIf (x,b)). split => //=. by apply ball_center. eapply filterlim_comp_2, filterlim_plus ; simpl. apply filterlim_const. apply (continuous_comp (fun x => snd x) (fun x => If a x)) ; simpl. apply continuous_snd. eapply (continuous_RInt_1 f a b). case: HIf => /= d HIf. exists d => x /= Hx. apply (HIf (a,x)). split => //=. by apply ball_center. Qed. End Continuity. Lemma ex_RInt_locally {V : CompleteNormedModule R_AbsRing} (f : R -> V) (a b : R) : ex_RInt f a b -> (exists eps : posreal, ex_RInt f (a - eps) (a + eps)) -> (exists eps : posreal, ex_RInt f (b - eps) (b + eps)) -> locally (a,b) (fun z : R * R => ex_RInt f (fst z) (snd z)). Proof. intros Hf (ea,Hea) (eb,Heb). exists (mkposreal _ (Rmin_stable_in_posreal ea eb)) => [[a' b'] [Ha' Hb']] ; simpl in *. apply ex_RInt_Chasles with (a - ea). eapply ex_RInt_swap, ex_RInt_Chasles_1 ; try eassumption. apply Rabs_le_between'. eapply Rlt_le, Rlt_le_trans, Rmin_l. by apply Ha'. apply ex_RInt_Chasles with a. eapply ex_RInt_Chasles_1 ; try eassumption. apply Rabs_le_between'. rewrite Rminus_eq_0 Rabs_R0. by apply Rlt_le, ea. apply ex_RInt_Chasles with b => //. apply ex_RInt_Chasles with (b - eb). eapply ex_RInt_swap, ex_RInt_Chasles_1; try eassumption. apply Rabs_le_between'. rewrite Rminus_eq_0 Rabs_R0. by apply Rlt_le, eb. eapply ex_RInt_Chasles_1 ; try eassumption. apply Rabs_le_between'. eapply Rlt_le, Rlt_le_trans, Rmin_r. by apply Hb'. Qed. (** * Riemann integral and differentiability *) Section Derive. Context {V : NormedModule R_AbsRing}. Lemma is_derive_RInt_0 (f If : R -> V) (a : R) : locally a (fun b : R => is_RInt f a b (If b)) -> continuous f a -> is_derive If a (f a). Proof. intros HIf Hf. split ; simpl. apply is_linear_scal_l. intros y Hy. apply @is_filter_lim_locally_unique in Hy. rewrite -Hy {y Hy}. intros eps. generalize (proj1 (filterlim_locally _ _) Hf) => {} Hf. eapply filter_imp. simpl ; intros y Hy. replace (If a) with (@zero V). rewrite @minus_zero_r. rewrite Rmult_comm ; eapply norm_RInt_le_const_abs ; last first. apply is_RInt_minus. instantiate (1 := f). eapply (proj1 Hy). apply is_RInt_const. simpl. apply (proj2 Hy). apply locally_singleton in HIf. assert (HIf_0 := is_RInt_point f a). apply (filterlim_locally_unique _ _ _ HIf_0 HIf). apply filter_and. by apply HIf. assert (0 < eps / @norm_factor _ V). apply Rdiv_lt_0_compat. by apply eps. by apply norm_factor_gt_0. case: (Hf (mkposreal _ H)) => {Hf} delta Hf. exists delta ; intros y Hy z Hz. eapply Rle_trans. apply Rlt_le, norm_compat2. apply Hf. apply Rabs_lt_between'. move/Rabs_lt_between': Hy => Hy. rewrite /Rmin /Rmax in Hz ; destruct (Rle_dec a y) as [Hxy | Hxy]. split. eapply Rlt_le_trans, Hz. apply Rminus_lt_0 ; ring_simplify. by apply delta. eapply Rle_lt_trans, Hy. by apply Hz. split. eapply Rlt_le_trans, Hz. by apply Hy. eapply Rle_lt_trans. apply Hz. apply Rminus_lt_0 ; ring_simplify. by apply delta. simpl ; apply Req_le. field. apply Rgt_not_eq, norm_factor_gt_0. Qed. Lemma is_derive_RInt (f If : R -> V) (a b : R) : locally b (fun b => is_RInt f a b (If b)) -> continuous f b -> is_derive If b (f b). Proof. intros HIf Hf. apply is_derive_ext with (fun y => (plus (minus (If y) (If b)) (If b))). simpl ; intros. rewrite /minus -plus_assoc plus_opp_l. by apply plus_zero_r. evar_last. apply is_derive_plus. apply is_derive_RInt_0. 2: apply Hf. eapply filter_imp. intros y Hy. evar_last. apply is_RInt_Chasles with a. apply is_RInt_swap. 3: by apply plus_comm. by apply locally_singleton in HIf. by apply Hy. by apply HIf. apply is_derive_const. by apply plus_zero_r. Qed. Lemma is_derive_RInt' (f If : R -> V) (a b : R) : locally a (fun a => is_RInt f a b (If a)) -> continuous f a -> is_derive If a (opp (f a)). Proof. intros. apply is_derive_ext with (fun x => opp (opp (If x))). intros ; by rewrite opp_opp. apply is_derive_opp. apply is_derive_RInt with b => //. move: H ; apply filter_imp. intros x Hx. by apply is_RInt_swap. Qed. Lemma filterdiff_RInt (f : R -> V) (If : R -> R -> V) (a b : R) : locally (a,b) (fun u : R * R => is_RInt f (fst u) (snd u) (If (fst u) (snd u))) -> continuous f a -> continuous f b -> filterdiff (fun u : R * R => If (fst u) (snd u)) (locally (a,b)) (fun u : R * R => minus (scal (snd u) (f b)) (scal (fst u) (f a))). Proof. intros Hf Cfa Cfb. assert (Ha : locally a (fun a : R => is_RInt f a b (If a b))). case: Hf => /= e He. exists e => x Hx. apply (He (x,b)). split => //. by apply ball_center. assert (Hb : locally b (fun b : R => is_RInt f a b (If a b))). case: Hf => /= e He. exists e => x Hx. apply (He (a,x)). split => //. by apply ball_center. eapply filterdiff_ext_lin. apply (filterdiff_ext_loc (FF := @filter_filter _ _ (locally_filter _)) (fun u : R * R => plus (If (fst u) b) (minus (If a (snd u)) (If a b)))) ; last first. apply filterdiff_plus_fct. apply (filterdiff_comp' (fun u : R * R => fst u) (fun a : R => If a b)). by apply filterdiff_linear, is_linear_fst. eapply is_derive_RInt', Cfa. by apply Ha. apply filterdiff_plus_fct. apply (filterdiff_comp' (fun u : R * R => snd u) (fun b : R => If a b)). by apply filterdiff_linear, is_linear_snd. eapply is_derive_RInt, Cfb. by apply Hb. apply filterdiff_const. move => /= x Hx. apply @is_filter_lim_locally_unique in Hx. by rewrite -Hx /= minus_eq_zero plus_zero_r. simpl. have : (locally (a,b) (fun u : R * R => is_RInt f (fst u) b (If (fst u) b))) => [ | {} Ha]. case: Ha => /= e He. exists e => y Hy. apply He, Hy. have : (locally (a,b) (fun u : R * R => is_RInt f a (snd u) (If a (snd u)))) => [ | {} Hb]. case: Hb => /= e He. exists e => y Hy. apply He, Hy. move: (locally_singleton _ _ Hf) => /= Hab. generalize (filter_and _ _ Hf (filter_and _ _ Ha Hb)). apply filter_imp => {Hf Ha Hb} /= u [Hf [Ha Hb]]. apply sym_eq, (filterlim_locally_unique _ _ _ Hf). apply is_RInt_Chasles with b => //. rewrite /minus plus_comm. apply is_RInt_Chasles with a => //. by apply is_RInt_swap. simpl => y. rewrite scal_opp_r plus_zero_r. apply plus_comm. Qed. End Derive. Lemma Derive_RInt (f : R -> R) (a b : R) : locally b (ex_RInt f a) -> continuous f b -> Derive (RInt f a) b = f b. Proof. intros If Cf. apply is_derive_unique, (is_derive_RInt _ _ a) => //. move: If ; apply filter_imp => y. exact: RInt_correct. Qed. Lemma Derive_RInt' (f : R -> R) (a b : R) : locally a (fun a => ex_RInt f a b) -> continuous f a -> Derive (fun a => RInt f a b) a = - f a. Proof. intros If Cf. eapply is_derive_unique, (is_derive_RInt' (V := R_NormedModule) _ _ a b) => //. move: If ; apply filter_imp => y. exact: RInt_correct. Qed. Section Derive'. Context {V : CompleteNormedModule R_AbsRing}. Lemma is_RInt_derive (f df : R -> V) (a b : R) : (forall x : R, Rmin a b <= x <= Rmax a b -> is_derive f x (df x)) -> (forall x : R, Rmin a b <= x <= Rmax a b -> continuous df x) -> is_RInt df a b (minus (f b) (f a)). Proof. intros Hf Hdf. wlog Hab: a b Hf Hdf / (a < b). intros H. destruct (Rlt_or_le a b) as [Hab|Hab]. exact: H. destruct Hab as [Hab|Hab]. + rewrite -(opp_opp (minus _ _)). apply: is_RInt_swap. rewrite opp_minus. apply H. by rewrite Rmin_comm Rmax_comm. by rewrite Rmin_comm Rmax_comm. easy. + rewrite Hab. rewrite /minus plus_opp_r. by apply: is_RInt_point. rewrite Rmin_left in Hf; last by lra. rewrite Rmax_right in Hf; last by lra. rewrite Rmin_left in Hdf; last by lra. rewrite Rmax_right in Hdf; last by lra. have Hminab : Rmin a b = a by rewrite Rmin_left; lra. have Hmaxab : Rmax a b = b by rewrite Rmax_right; lra. evar_last. apply RInt_correct. apply (ex_RInt_continuous df) => t Ht. rewrite Hminab Hmaxab in Ht. exact:Hdf. apply (plus_reg_r (opp (f b))). rewrite /minus -plus_assoc (plus_comm (opp _)) plus_assoc plus_opp_r. rewrite -(RInt_point a df). apply: sym_eq. have Hext : forall x : R, Rmin a b < x < Rmax a b -> extension_C0 df a b x = df x. move => x; rewrite Hminab Hmaxab => Hx. by rewrite extension_C0_ext //=; lra. rewrite -(RInt_ext _ _ _ _ Hext). rewrite RInt_point -(RInt_point a (extension_C0 df a b)). rewrite -!(extension_C1_ext f df a b) /=; try lra. apply: (eq_is_derive (fun t => minus (RInt _ a t) (_ t))) => // t Ht. have -> : zero = minus (extension_C0 df a b t) (extension_C0 df a b t) by rewrite minus_eq_zero. apply: is_derive_minus; last first. apply: extension_C1_is_derive => /=; first by lra. by move => x Hax Hxb; apply: Hf; lra. apply: (is_derive_RInt _ _ a). apply: filter_forall. move => x; apply: RInt_correct. apply: ex_RInt_continuous. move => z Hz; apply: extension_C0_continuous => /=; try lra. by move => x0 Hax0 Hx0b; apply: Hdf; lra. apply: extension_C0_continuous => /=; try lra. move => x0 Hax0 Hx0b; apply: Hdf; lra. Qed. End Derive'. Lemma RInt_Derive (f : R -> R) (a b : R): (forall x, Rmin a b <= x <= Rmax a b -> ex_derive f x) -> (forall x, Rmin a b <= x <= Rmax a b -> continuous (Derive f) x) -> RInt (Derive f) a b = f b - f a. Proof. intros Df Cdf. apply is_RInt_unique. apply: is_RInt_derive => //. intros ; by apply Derive_correct, Df. Qed. (** ** Composition *) Section Comp. Context {V : CompleteNormedModule R_AbsRing}. (* Notation consistent version of the lemmas used in is_RInt_comp *) Lemma IVT_gen_consistent (f : R -> R) (a b y : R) : (forall x, continuous f x) -> Rmin (f a) (f b) <= y <= Rmax (f a) (f b) -> { x : R | Rmin a b <= x <= Rmax a b /\ f x = y }. Proof. move => Hf. apply: IVT_gen. move => x. apply continuity_pt_filterlim. exact: Hf. Qed. Lemma continuous_ab_maj_consistent : forall (f : R -> R) (a b : R), a <= b -> (forall c : R, a <= c <= b -> continuous f c) -> exists Mx : R, (forall c : R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b. Proof. move => f a b Hab Hc. apply: continuity_ab_maj => // . by move => c Hc1; apply continuity_pt_filterlim; exact: Hc. Qed. Lemma continuous_ab_min_consistent : forall (f : R -> R) (a b : R), a <= b -> (forall c : R, a <= c <= b -> continuous f c) -> exists mx : R, (forall c : R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b. Proof. move => f a b Hab Hc. apply: continuity_ab_min => // . by move => c Hc1; apply continuity_pt_filterlim; exact: Hc. Qed. Lemma is_RInt_comp (f : R -> V) (g dg : R -> R) (a b : R) : (forall x, Rmin a b <= x <= Rmax a b -> continuous f (g x)) -> (forall x, Rmin a b <= x <= Rmax a b -> is_derive g x (dg x) /\ continuous dg x) -> is_RInt (fun y => scal (dg y) (f (g y))) a b (RInt f (g a) (g b)). Proof. wlog: a b / (a < b) => [Hw|Hab]. case: (total_order_T a b) => [[Hab'|Hab']|Hab'] Hf Hg. - exact: Hw. - rewrite Hab'. by rewrite RInt_point; apply: is_RInt_point. - rewrite <- (opp_opp (RInt f _ _)). apply: is_RInt_swap. rewrite opp_RInt_swap. apply Hw => // . by rewrite Rmin_comm Rmax_comm. by rewrite Rmin_comm Rmax_comm. apply: ex_RInt_continuous => z Hz. case: (IVT_gen_consistent (extension_C0 g b a) b a z). + apply: extension_C0_continuous => /=; try lra. move => x Hbx Hxa; apply: ex_derive_continuous. by exists (dg x); apply Hg; rewrite Rmin_right ?Rmax_left; try lra. + rewrite !(extension_C0_ext) /=; try lra. by rewrite Rmin_comm Rmax_comm. + move => x [Hx1 Hx2]. rewrite -Hx2. rewrite Rmin_left ?Rmax_right in Hx1; try lra. rewrite (extension_C0_ext) /=; try lra. apply: Hf. by move: Hx1; rewrite Rmin_right ?Rmax_left; lra. rewrite -> Rmin_left by now apply Rlt_le. rewrite -> Rmax_right by now apply Rlt_le. wlog: g dg / (forall x : R, is_derive g x (dg x) /\ continuous dg x) => [Hw Hf Hg | Hg Hf _]. rewrite -?(extension_C1_ext g dg a b) ; try by [left | right]. set g0 := extension_C1 g dg a b. set dg0 := extension_C0 dg a b. apply is_RInt_ext with (fun y : R => scal (dg0 y) (f (g0 y))). + rewrite /Rmin /Rmax /g0 ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ x Hx. apply f_equal2. by apply extension_C0_ext ; by apply Rlt_le, Hx. by apply f_equal, extension_C1_ext ; by apply Rlt_le, Hx. + apply Hw. * intros x ; split. apply extension_C1_is_derive. by apply Rlt_le. by intros ; apply Hg ; by split. * apply @extension_C0_continuous. by apply Rlt_le. intros ; apply Hg ; by split. * intros ; rewrite /g0 extension_C1_ext. by apply Hf. by apply H. by apply H. intros ; split. apply extension_C1_is_derive. by apply Rlt_le. intros ; apply Hg ; by split. apply @extension_C0_continuous. by apply Rlt_le. by intros ; apply Hg ; by split. have cg : forall x, continuous g x. move => t Ht; apply: ex_derive_continuous. by exists (dg t); apply Hg. wlog: f Hf / (forall x, continuous f x) => [Hw | {} Hf]. case: (continuous_ab_maj_consistent g a b (Rlt_le _ _ Hab)) => [ | M HM]. move => x Hx; apply: ex_derive_continuous. by exists (dg x); apply Hg. case: (continuous_ab_min_consistent g a b (Rlt_le _ _ Hab)) => [ | m Hm]. move => x Hx; apply: ex_derive_continuous. by exists (dg x) ; apply Hg. have H : g m <= g M. by apply Hm ; intuition. case: (C0_extension_le f (g m) (g M)) => [ y Hy | f0 Hf0]. + case: (IVT_gen_consistent g m M y) => // . rewrite /Rmin /Rmax ; case: Rle_dec => // . move => x [Hx <-]. apply Hf ; split. apply Rle_trans with (2 := proj1 Hx). by apply Rmin_case ; intuition. apply Rle_trans with (1 := proj2 Hx). apply Rmax_case ; intuition. apply is_RInt_ext with (fun y : R => scal (dg y) (f0 (g y))). rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ x Hc. apply f_equal. apply Hf0 ; split. by apply Hm ; split ; apply Rlt_le ; apply Hc. by apply HM ; split ; apply Rlt_le ; apply Hc. rewrite -(RInt_ext f0). + apply Hw. by move => x Hx ; apply Hf0. by move => x ; apply Hf0. + move => x Hx. case: (IVT_gen_consistent g a b x cg) => // . by lra. rewrite Rmin_left ?Rmax_right; try lra. move => x0 Hx0. case: Hx0 => Hx0 Hgx0x; rewrite -Hgx0x. apply Hf0; split. by apply Hm. by apply HM. evar_last. + apply (is_RInt_derive (fun x => RInt f (g a) (g x))). move => x Hx. evar_last. apply is_derive_comp. apply is_derive_RInt with (g a). apply filter_forall => y. apply RInt_correct, @ex_RInt_continuous. by intros ; apply Hf. by apply Hf. by apply Hg. reflexivity. intros x Hx. apply: @continuous_scal. by apply Hg. apply continuous_comp. apply @ex_derive_continuous. by eexists ; apply Hg. by apply Hf. + by rewrite RInt_point minus_zero_r. Qed. Lemma RInt_comp (f : R -> V) (g dg : R -> R) (a b : R) : (forall x, Rmin a b <= x <= Rmax a b -> continuous f (g x)) -> (forall x, Rmin a b <= x <= Rmax a b -> is_derive g x (dg x) /\ continuous dg x) -> RInt (fun y => scal (dg y) (f (g y))) a b = RInt f (g a) (g b). Proof. move => Hfg Hg. have H := (is_RInt_comp _ _ _ _ _ Hfg Hg). exact: is_RInt_unique. Qed. End Comp. Lemma RInt_Chasles_bound_comp_l_loc (f : R -> R -> R) (a : R -> R) (b x : R) : locally x (fun y => ex_RInt (f y) (a x) b) -> (exists eps : posreal, locally x (fun y => ex_RInt (f y) (a x - eps) (a x + eps))) -> continuous a x -> locally x (fun x' => RInt (f x') (a x') (a x) + RInt (f x') (a x) b = RInt (f x') (a x') b). Proof. intros Hab (eps,Hae) Ca. generalize (proj1 (filterlim_locally _ _) Ca) => {} Ca. generalize (filter_and _ _ (Ca eps) (filter_and _ _ Hab Hae)). apply filter_imp => {Ca Hae Hab} y [Hy [Hab Hae]]. apply RInt_Chasles with (2 := Hab). apply ex_RInt_inside with (1 := Hae). now apply Rlt_le. rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rlt_le, cond_pos. Qed. Lemma RInt_Chasles_bound_comp_loc (f : R -> R -> R) (a b : R -> R) (x : R) : locally x (fun y => ex_RInt (f y) (a x) (b x)) -> (exists eps : posreal, locally x (fun y => ex_RInt (f y) (a x - eps) (a x + eps))) -> (exists eps : posreal, locally x (fun y => ex_RInt (f y) (b x - eps) (b x + eps))) -> continuous a x -> continuous b x -> locally x (fun x' => RInt (f x') (a x') (a x) + RInt (f x') (a x) (b x') = RInt (f x') (a x') (b x')). Proof. intros Hab (ea,Hae) (eb,Hbe) Ca Cb. generalize (proj1 (filterlim_locally _ _) Ca) => {} Ca. generalize (proj1 (filterlim_locally _ _) Cb) => {} Cb. set (e := mkposreal _ (Rmin_stable_in_posreal ea eb)). generalize (filter_and _ _ (filter_and _ _ (Ca e) (Cb e)) (filter_and _ _ Hab (filter_and _ _ Hae Hbe))). apply filter_imp => {Ca Cb Hab Hae Hbe} y [[Hay Hby] [Hab [Hae Hbe]]]. apply: RInt_Chasles. apply ex_RInt_inside with (1 := Hae). apply Rlt_le. apply Rlt_le_trans with (1 := Hay). exact: Rmin_l. rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rlt_le, cond_pos. apply ex_RInt_Chasles with (1 := Hab). apply ex_RInt_inside with (1 := Hbe). rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rlt_le, cond_pos. apply Rlt_le. apply Rlt_le_trans with (1 := Hby). exact: Rmin_r. Qed. Section RInt_comp. Context {V : NormedModule R_AbsRing}. Lemma is_derive_RInt_bound_comp (f : R -> V) (If : R -> R -> V) (a b : R -> R) (da db x : R) : locally (a x, b x) (fun u : R * R => is_RInt f (fst u) (snd u) (If (fst u) (snd u))) -> continuous f (a x) -> continuous f (b x) -> is_derive a x da -> is_derive b x db -> is_derive (fun x => If (a x) (b x)) x (minus (scal db (f (b x))) (scal da (f (a x)))). Proof. intros Iab Ca Cb Da Db. unfold is_derive. eapply filterdiff_ext_lin. apply @filterdiff_comp'_2. apply Da. apply Db. eapply filterdiff_ext_lin. apply (filterdiff_RInt f If (a x) (b x)). exact Iab. exact Ca. exact Cb. by case => y z /=. simpl => y. by rewrite -!scal_assoc scal_minus_distr_l. Qed. End RInt_comp. (** * Parametric integrals *) Lemma is_derive_RInt_param_aux : forall (f : R -> R -> R) (a b x : R), locally x (fun x : R => forall t, Rmin a b <= t <= Rmax a b -> ex_derive (fun u : R => f u t) x) -> (forall t, Rmin a b <= t <= Rmax a b -> continuity_2d_pt (fun u v => Derive (fun z => f z v) u) x t) -> locally x (fun y : R => ex_RInt (fun t => f y t) a b) -> ex_RInt (fun t => Derive (fun u => f u t) x) a b -> is_derive (fun x : R => RInt (fun t => f x t) a b) x (RInt (fun t => Derive (fun u => f u t) x) a b). Proof. intros f a b x. wlog: a b / a < b => H. (* *) destruct (total_order_T a b) as [[Hab|Hab]|Hab]. now apply H. intros _ _ _ _. rewrite Hab. rewrite RInt_point. apply is_derive_ext with (fun _ => 0). simpl => t. apply sym_eq. apply: RInt_point. apply: is_derive_const. simpl => H1 H2 H3 H4. apply is_derive_ext_loc with (fun u => - RInt (fun t => f u t) b a). apply: filter_imp H3 => t Ht. apply: opp_RInt_swap. exact: ex_RInt_swap. eapply filterdiff_ext_lin. apply @filterdiff_opp_fct ; try by apply locally_filter. apply H. exact Hab. now rewrite Rmin_comm Rmax_comm. now rewrite Rmin_comm Rmax_comm. move: H3 ; apply filter_imp => y H3. now apply ex_RInt_swap. now apply ex_RInt_swap. rewrite -opp_RInt_swap //=. intros y. by rewrite -scal_opp_r opp_opp. (* *) rewrite Rmin_left. 2: now apply Rlt_le. rewrite Rmax_right. 2: now apply Rlt_le. intros Df Cdf If IDf. split => [ | y Hy]. by apply @is_linear_scal_l. rewrite -(is_filter_lim_locally_unique _ _ Hy) => {y Hy}. assert (Cdf'' : forall t : R, a <= t <= b -> continuity_2d_pt (fun u v : R => Derive (fun z : R => f z u) v) t x). intros t Ht eps. specialize (Cdf t Ht eps). simpl in Cdf. destruct Cdf as (d,Cdf). exists d. intros v u Hv Hu. now apply Cdf. assert (Cdf' := uniform_continuity_2d_1d (fun u v => Derive (fun z => f z u) v) a b x Cdf''). intros eps. (* 8.4/8.5 compatibility: *) try clearbody Cdf'. clear Cdf. assert (H': 0 < eps / Rabs (b - a)). apply Rmult_lt_0_compat. apply cond_pos. apply Rinv_0_lt_compat. apply Rabs_pos_lt. apply Rgt_not_eq. now apply Rgt_minus. move: (Cdf' (mkposreal _ H')) => {Cdf'} [d1 Cdf]. generalize (filter_and _ _ Df If). move => {Df If} [d2 DIf]. exists (mkposreal _ (Rmin_stable_in_posreal d1 (pos_div_2 d2))) => /= y Hy. assert (D1: ex_RInt (fun t => f y t) a b). apply DIf. apply Rlt_le_trans with (1 := Hy). apply Rle_trans with (1 := Rmin_r _ _). apply Rlt_le. apply Rlt_eps2_eps. apply cond_pos. assert (D2: ex_RInt (fun t => f x t) a b). apply DIf. apply ball_center. rewrite -RInt_minus // -RInt_scal //. assert (D3: ex_RInt (fun t => f y t - f x t) a b). apply @ex_RInt_minus. by apply D1. by apply D2. assert (D4: ex_RInt (fun t => (y - x) * Derive (fun u => f u t) x) a b) by now apply @ex_RInt_scal. rewrite -RInt_minus //. assert (D5: ex_RInt (fun t => f y t - f x t - (y - x) * Derive (fun u => f u t) x) a b) by now apply @ex_RInt_minus. rewrite (RInt_Reals _ _ _ (ex_RInt_Reals_0 _ _ _ D5)). assert (D6: ex_RInt (fun t => Rabs (f y t - f x t - (y - x) * Derive (fun u => f u t) x)) a b) by now apply ex_RInt_norm. apply Rle_trans with (1 := RiemannInt_P17 _ (ex_RInt_Reals_0 _ _ _ D6) (Rlt_le _ _ H)). refine (Rle_trans _ _ _ (RiemannInt_P19 _ (RiemannInt_P14 a b (eps / Rabs (b - a) * Rabs (y - x))) (Rlt_le _ _ H) _) _). intros u Hu. destruct (MVT_cor4 (fun t => f t u) (Derive (fun t => f t u)) x) with (eps := pos_div_2 d2) (b := y) as (z,Hz). intros z Hz. apply Derive_correct, DIf. apply Rle_lt_trans with (1 := Hz). apply: Rlt_eps2_eps. apply cond_pos. split ; now apply Rlt_le. apply Rlt_le. apply Rlt_le_trans with (1 := Hy). apply Rmin_r. rewrite (proj1 Hz). rewrite Rmult_comm. rewrite -Rmult_minus_distr_l Rabs_mult. rewrite Rmult_comm. apply Rmult_le_compat_r. apply Rabs_pos. apply Rlt_le. apply Cdf. split ; now apply Rlt_le. apply Rabs_le_between'. rewrite /Rminus Rplus_opp_r Rabs_R0. apply Rlt_le. apply cond_pos. split ; now apply Rlt_le. apply Rabs_le_between'. apply Rle_trans with (1 := proj2 Hz). apply Rlt_le. apply Rlt_le_trans with (1 := Hy). apply Rmin_l. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. rewrite RiemannInt_P15. rewrite Rabs_pos_eq. right. change (norm (minus y x)) with (Rabs (y - x)). field. apply Rgt_not_eq. now apply Rgt_minus. apply Rge_le. apply Rge_minus. now apply Rgt_ge. Qed. Lemma is_derive_RInt_param : forall f a b x, locally x (fun x => forall t, Rmin a b <= t <= Rmax a b -> ex_derive (fun u => f u t) x) -> (forall t, Rmin a b <= t <= Rmax a b -> continuity_2d_pt (fun u v => Derive (fun z => f z v) u) x t) -> locally x (fun y => ex_RInt (fun t => f y t) a b) -> is_derive (fun x => RInt (fun t => f x t) a b) x (RInt (fun t => Derive (fun u => f u t) x) a b). Proof. intros f a b x H1 H2 H3. apply is_derive_RInt_param_aux; try easy. apply ex_RInt_Reals_1. clear H1 H3. wlog: a b H2 / a < b => H. case (total_order_T a b). intro Y; case Y. now apply H. intros Heq; rewrite Heq. apply RiemannInt_P7. intros Y. apply RiemannInt_P1. apply H. intros; apply H2. rewrite Rmin_comm Rmax_comm. exact H0. exact Y. rewrite Rmin_left in H2. 2: now left. rewrite Rmax_right in H2. 2: now left. apply continuity_implies_RiemannInt. now left. intros y Hy eps Heps. destruct (H2 _ Hy (mkposreal eps Heps)) as (d,Hd). simpl in Hd. exists d; split. apply cond_pos. unfold dist; simpl; unfold R_dist; simpl. intros z (_,Hz). apply Hd. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. exact Hz. Qed. Lemma is_derive_RInt_param_bound_comp_aux1 : forall (f : R -> R -> R) (a : R -> R) (x : R), (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (a x - eps) (a x + eps))) -> (exists eps:posreal, locally x (fun x0 : R => forall t : R, a x-eps <= t <= a x+eps -> ex_derive (fun u : R => f u t) x0)) -> (locally_2d (fun x' t => continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (a x)) -> continuity_2d_pt (fun u v : R => Derive (fun z : R => RInt (fun t : R => f z t) v (a x)) u) x (a x). Proof. intros f a x (d1,(d2,Ia)) (d3,(d4,Df)) Cdf e. assert (J1:(continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x (a x))) by now apply locally_2d_singleton in Cdf. destruct Cdf as (d5,Cdf). destruct (J1 (mkposreal _ Rlt_0_1)) as (d6,Df1); simpl in Df1. assert (J2: 0 < e / (Rabs (Derive (fun z : R => f z (a x)) x)+1)). apply Rdiv_lt_0_compat. apply cond_pos. apply Rlt_le_trans with (0+1). rewrite Rplus_0_l; apply Rlt_0_1. apply Rplus_le_compat_r; apply Rabs_pos. exists (mkposreal _ (Rmin_stable_in_posreal (mkposreal _ (Rmin_stable_in_posreal d1 (mkposreal _ (Rmin_stable_in_posreal (pos_div_2 d2) d3)))) (mkposreal _ (Rmin_stable_in_posreal (mkposreal _ (Rmin_stable_in_posreal (pos_div_2 d4) d5)) (mkposreal _ (Rmin_stable_in_posreal d6 (mkposreal _ J2))))))). simpl; intros u v Hu Hv. rewrite (Derive_ext (fun z : R => RInt (fun t : R => f z t) (a x) (a x)) (fun z => 0)). 2: intros t; exact: RInt_point. replace (Derive (fun _ : R => 0) x) with 0%R. 2: apply sym_eq, Derive_const. rewrite Rminus_0_r. replace (Derive (fun z : R => RInt (fun t : R => f z t) v (a x)) u) with (RInt (fun z => Derive (fun u => f u z) u) v (a x)). (* *) apply Rle_lt_trans with (Rabs (a x -v) * (Rabs (Derive (fun z : R => f z (a x)) x) +1)). apply (norm_RInt_le_const_abs (fun z : R => Derive (fun u0 : R => f u0 z) u) v (a x)). intros t Ht. apply Rplus_le_reg_r with (-Rabs (Derive (fun z : R => f z (a x)) x)). apply Rle_trans with (1:=Rabs_triang_inv _ _). ring_simplify. left; apply Df1. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_l. apply Rle_lt_trans with (Rabs (v - a x)). now apply Rabs_le_between_min_max. apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_l. apply: RInt_correct. apply: ex_RInt_continuous. intros y Hy ; apply continuity_pt_filterlim. intros eps Heps. assert (Y1:(Rabs (u - x) < d5)). apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_r. assert (Y2:(Rabs (y - a x) < d5)). apply Rle_lt_trans with (Rabs (v-a x)). now apply Rabs_le_between_min_max. apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_r. destruct (Cdf u y Y1 Y2 (mkposreal eps Heps)) as (d,Hd); simpl in Hd. exists d; split. apply cond_pos. unfold dist; simpl; unfold R_dist. intros z (_,Hz). apply Hd. rewrite /Rminus Rplus_opp_r Rabs_R0. apply cond_pos. exact Hz. replace (a x -v) with (-(v - a x)) by ring; rewrite Rabs_Ropp. apply Rlt_le_trans with ((e / (Rabs (Derive (fun z : R => f z (a x)) x) + 1)) * (Rabs (Derive (fun z : R => f z (a x)) x) + 1)). apply Rmult_lt_compat_r. apply Rlt_le_trans with (0+1). rewrite Rplus_0_l; apply Rlt_0_1. apply Rplus_le_compat_r; apply Rabs_pos. apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_r. right; field. apply sym_not_eq, Rlt_not_eq. apply Rlt_le_trans with (0+1). rewrite Rplus_0_l; apply Rlt_0_1. apply Rplus_le_compat_r; apply Rabs_pos. (* *) apply sym_eq, is_derive_unique. apply is_derive_RInt_param. exists (pos_div_2 d4). intros y Hy t Ht. apply Df. rewrite (double_var d4). apply ball_triangle with u. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_l. by apply Hy. apply (proj1 (Rabs_le_between' t (a x) d3)). apply Rle_trans with (Rabs (v - a x)). now apply Rabs_le_between_min_max. left; apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_l _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_r. intros t Ht. apply Cdf. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_r. apply Rle_lt_trans with (Rabs (v - a x)). now apply Rabs_le_between_min_max. apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_r. exists (pos_div_2 d2). intros y Hy. apply (ex_RInt_inside (f y)) with (a x) d1. apply Ia. rewrite (double_var d2). apply ball_triangle with u. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_l _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_l. apply Hy. left; apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_l. rewrite /Rminus Rplus_opp_r Rabs_R0. left; apply cond_pos. Qed. Lemma is_derive_RInt_param_bound_comp_aux2 : forall (f : R -> R -> R) (a : R -> R) (b x da : R), (locally x (fun y : R => ex_RInt (fun t => f y t) (a x) b)) -> (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (a x - eps) (a x + eps))) -> is_derive a x da -> (exists eps:posreal, locally x (fun x0 : R => forall t : R, Rmin (a x-eps) b <= t <= Rmax (a x+eps) b -> ex_derive (fun u : R => f u t) x0)) -> (forall t : R, Rmin (a x) b <= t <= Rmax (a x) b -> continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x t) -> (locally_2d (fun x' t => continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (a x)) -> continuity_pt (fun t => f x t) (a x) -> is_derive (fun x : R => RInt (fun t => f x t) (a x) b) x (RInt (fun t : R => Derive (fun u => f u t) x) (a x) b+(-f x (a x))*da). Proof. intros f a b x da Hi [d0 Ia] Da [d1 Df] Cdf1 Cdf2 Cfa. rewrite Rplus_comm. apply is_derive_ext_loc with (fun x0 => plus (RInt (fun t : R => f x0 t) (a x0) (a x)) (RInt (fun t : R => f x0 t) (a x) b)). apply RInt_Chasles_bound_comp_l_loc. exact Hi. now exists d0. apply: filterdiff_continuous. eexists. apply Da. apply: is_derive_plus. (* *) eapply filterdiff_ext_lin. apply @filterdiff_comp'_2 with (h := fun x0 y => RInt (fun t : R => f x0 t) y (a x)). apply filterdiff_id. apply Da. eapply filterdiff_ext_lin. apply (is_derive_filterdiff (fun u v => RInt (fun t0 : R => f u t0) v (a x)) x (a x) (fun u v => Derive (fun z => RInt (fun t => f z t) v (a x)) u)). (* . *) destruct Df as (d2,Df). destruct Cdf2 as (d3,Cdf2). destruct Ia as (d4,Ia). exists (mkposreal _ (Rmin_stable_in_posreal (mkposreal _ (Rmin_stable_in_posreal d1 (pos_div_2 d2))) (mkposreal _ (Rmin_stable_in_posreal d3 (mkposreal _ (Rmin_stable_in_posreal d0 (pos_div_2 d4))))))). intros [u v] [Hu Hv] ; simpl in *. apply: Derive_correct. eexists ; apply is_derive_RInt_param. exists (pos_div_2 d2). intros y Hy t Ht. apply Df. rewrite (double_var d2). apply: ball_triangle Hy. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_r. split. apply Rle_trans with (2:=proj1 Ht). apply Rle_trans with (1 := Rmin_l _ _). apply Rmin_glb. apply Rabs_le_between'. left; apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_l. apply Rplus_le_reg_l with (- a x + d1); ring_simplify. left; apply cond_pos. apply Rle_trans with (1:=proj2 Ht). apply Rle_trans with (a x + d1). apply Rmax_lub. apply Rabs_le_between'. left; apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_l _ _). apply Rmin_l. apply Rplus_le_reg_l with (- a x); ring_simplify. left; apply cond_pos. apply Rmax_l. intros t Ht. apply Cdf2. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_l. apply Rle_lt_trans with (Rabs (v - a x)). now apply Rabs_le_between_min_max. apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_l. exists (pos_div_2 d4). intros y Hy. apply (ex_RInt_inside (f y)) with (a x) d0. apply Ia. rewrite (double_var d4). apply: ball_triangle Hy. apply Rlt_le_trans with (1:=Hu). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_r. left; apply Rlt_le_trans with (1:=Hv). apply Rle_trans with (1:=Rmin_r _ _). apply Rle_trans with (1:=Rmin_r _ _). apply Rmin_l. rewrite /Rminus Rplus_opp_r Rabs_R0. left; apply cond_pos. (* . *) apply is_derive_RInt' with (a x). apply locally_singleton in Ia. exists d0 => /= y Hy. apply: RInt_correct. generalize (proj1 (Rabs_lt_between' _ _ _) Hy) => {} Hy. eapply ex_RInt_Chasles. eapply ex_RInt_Chasles, Ia. apply ex_RInt_swap. eapply @ex_RInt_Chasles_1, Ia. split ; apply Rlt_le, Hy. apply ex_RInt_swap. eapply @ex_RInt_Chasles_2, Ia. apply Rabs_le_between'. rewrite /Rminus Rplus_opp_r Rabs_R0. left; apply cond_pos. by apply continuity_pt_filterlim, Cfa. (* . *) apply (continuity_2d_pt_filterlim (fun u v => Derive (fun z : R => RInt (fun t0 : R => f z t0) v (a x)) u)). simpl. apply is_derive_RInt_param_bound_comp_aux1; try easy. exists d0; exact Ia. exists d1. move: Df ; apply filter_imp. intros y H t Ht. apply H. split. apply Rle_trans with (2:=proj1 Ht). apply Rmin_l. apply Rle_trans with (1:=proj2 Ht). apply Rmax_l. case => /= u v. erewrite Derive_ext. 2: intros ; by rewrite RInt_point. by rewrite Derive_const scal_zero_r plus_zero_l. move => /= y ; apply Rminus_diag_uniq. rewrite /plus /scal /opp /= /mult /=. ring. (* *) apply is_derive_RInt_param with (2 := Cdf1) (3 := Hi). move: Df ; apply filter_imp. intros y Hy t Ht; apply Hy. split. apply Rle_trans with (2:=proj1 Ht). apply Rle_min_compat_r. apply Rplus_le_reg_l with (-a x+d1); ring_simplify. left; apply cond_pos. apply Rle_trans with (1:=proj2 Ht). apply Rle_max_compat_r. apply Rplus_le_reg_l with (-a x); ring_simplify. left; apply cond_pos. Qed. Lemma is_derive_RInt_param_bound_comp_aux3 : forall (f : R -> R -> R) a (b : R -> R) (x db : R), (locally x (fun y : R => ex_RInt (fun t => f y t) a (b x))) -> (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (b x - eps) (b x + eps))) -> is_derive b x db -> (exists eps:posreal, locally x (fun x0 : R => forall t : R, Rmin a (b x-eps) <= t <= Rmax a (b x+eps) -> ex_derive (fun u : R => f u t) x0)) -> (forall t : R, Rmin a (b x) <= t <= Rmax a (b x) -> continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x t) -> (locally_2d (fun x' t => continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (b x)) -> continuity_pt (fun t => f x t) (b x) -> is_derive (fun x : R => RInt (fun t => f x t) a (b x)) x (RInt (fun t : R => Derive (fun u => f u t) x) a (b x) +f x (b x)*db). Proof. intros f a b x db If Ib Db Df Cf1 Cf2 Cfb. apply is_derive_ext_loc with (fun x0 => - RInt (fun t : R => f x0 t) (b x0) a). destruct Ib as [eps Ib]. cut (locally x (fun t : R => ex_RInt (fun u => f t u) a (b t))). apply: filter_imp. intros y H. apply: opp_RInt_swap. exact: ex_RInt_swap. assert (locally x (fun t : R => Rabs (b t - b x) <= eps)). generalize (ex_derive_continuous b _ (ex_intro _ _ Db)). move /filterlim_locally /(_ eps). apply: filter_imp => t. exact: Rlt_le. generalize (filter_and _ _ If (filter_and _ _ Ib H)). apply: filter_imp => t [Ht1 [Ht2 Ht3]]. apply ex_RInt_Chasles with (1 := Ht1). apply: ex_RInt_inside Ht2 _ Ht3. rewrite Rminus_eq_0 Rabs_R0. apply Rlt_le, cond_pos. evar_last. apply: is_derive_opp. apply: is_derive_RInt_param_bound_comp_aux2 Ib Db _ _ Cf2 Cfb. apply: filter_imp If => y H. now apply ex_RInt_swap. destruct Df as (e,H). exists e. move: H ; apply filter_imp. intros y H' t Ht. apply H'. now rewrite Rmin_comm Rmax_comm. intros t Ht. apply Cf1. now rewrite Rmin_comm Rmax_comm. rewrite -(opp_RInt_swap _ _ a). rewrite /opp /=. ring. apply ex_RInt_swap. apply ex_RInt_continuous. intros z Hz. specialize (Cf1 z Hz). apply continuity_2d_pt_filterlim in Cf1. intros c Hc. destruct (Cf1 c Hc) as [e He]. exists e. intros d Hd. apply (He (x,d)). split. apply ball_center. apply Hd. Qed. Lemma is_derive_RInt_param_bound_comp : forall (f : R -> R -> R) (a b : R -> R) (x da db : R), (locally x (fun y : R => ex_RInt (fun t => f y t) (a x) (b x))) -> (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (a x - eps) (a x + eps))) -> (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (b x - eps) (b x + eps))) -> is_derive a x da -> is_derive b x db -> (exists eps:posreal, locally x (fun x0 : R => forall t : R, Rmin (a x-eps) (b x -eps) <= t <= Rmax (a x+eps) (b x+eps) -> ex_derive (fun u : R => f u t) x0)) -> (forall t : R, Rmin (a x) (b x) <= t <= Rmax (a x) (b x) -> continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x t) -> (locally_2d (fun x' t => continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (a x)) -> (locally_2d (fun x' t => continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (b x)) -> continuity_pt (fun t => f x t) (a x) -> continuity_pt (fun t => f x t) (b x) -> is_derive (fun x : R => RInt (fun t => f x t) (a x) (b x)) x (RInt (fun t : R => Derive (fun u => f u t) x) (a x) (b x)+(-f x (a x))*da+(f x (b x))*db). Proof. intros f a b x da db If Ifa Ifb Da Db Df Cf Cfa Cfb Ca Cb. apply is_derive_ext_loc with (fun x0 : R => RInt (fun t : R => f x0 t) (a x0) (a x) + RInt (fun t : R => f x0 t) (a x) (b x0)). apply RInt_Chasles_bound_comp_loc ; trivial. apply @filterdiff_continuous. eexists. apply Da. apply @filterdiff_continuous. eexists. apply Db. eapply filterdiff_ext_lin. apply @filterdiff_plus_fct. by apply locally_filter. (* *) apply is_derive_RInt_param_bound_comp_aux2; try easy. exists (mkposreal _ Rlt_0_1). intros y Hy. apply ex_RInt_point. by apply Da. destruct Df as (e,H). exists e. move: H ; apply filter_imp. intros y H' t Ht. apply H'. split. apply Rle_trans with (2:=proj1 Ht). apply Rle_trans with (1:=Rmin_l _ _). right; apply sym_eq, Rmin_left. apply Rplus_le_reg_l with (-a x + e); ring_simplify. left; apply cond_pos. apply Rle_trans with (1:=proj2 Ht). apply Rle_trans with (2:=Rmax_l _ _). right; apply Rmax_left. apply Rplus_le_reg_l with (-a x); ring_simplify. left; apply cond_pos. intros t Ht. apply Cf. split. apply Rle_trans with (2:=proj1 Ht). apply Rle_trans with (1:=Rmin_l _ _). right; apply sym_eq, Rmin_left. now right. apply Rle_trans with (1:=proj2 Ht). apply Rle_trans with (2:=Rmax_l _ _). right; apply Rmax_left. now right. (* *) apply is_derive_RInt_param_bound_comp_aux3; try easy. by apply Db. destruct Df as (e,H). exists e. move: H ; apply filter_imp. intros y H' t Ht. apply H'. split. apply Rle_trans with (2:=proj1 Ht). apply Rle_min_compat_r. apply Rplus_le_reg_l with (-a x + e); ring_simplify. left; apply cond_pos. apply Rle_trans with (1:=proj2 Ht). apply Rle_max_compat_r. apply Rplus_le_reg_l with (-a x); ring_simplify. left; apply cond_pos. rewrite RInt_point. simpl => y. rewrite /plus /scal /zero /= /mult /=. ring. Qed. (** * Power series *) Definition PS_Int (a : nat -> R) (n : nat) : R := match n with | O => 0 | S n => a n / INR (S n) end. Lemma CV_radius_Int (a : nat -> R) : CV_radius (PS_Int a) = CV_radius a. Proof. rewrite -CV_radius_derive. apply CV_radius_ext. rewrite /PS_derive /PS_Int => n ; rewrite S_INR. field. apply Rgt_not_eq, INRp1_pos. Qed. Lemma is_RInt_PSeries (a : nat -> R) (x : R) : Rbar_lt (Rabs x) (CV_radius a) -> is_RInt (PSeries a) 0 x (PSeries (PS_Int a) x). Proof. move => Hx. have H : forall y, Rmin 0 x <= y <= Rmax 0 x -> Rbar_lt (Rabs y) (CV_radius a). move => y Hy. apply: Rbar_le_lt_trans Hx. apply Rabs_le_between. split. apply Rle_trans with (2 := proj1 Hy). rewrite /Rabs /Rmin. case: Rcase_abs ; case: Rle_dec => // Hx Hx' ; rewrite ?Ropp_involutive. by apply Rlt_le. by apply Req_le. apply Ropp_le_cancel ; by rewrite Ropp_involutive Ropp_0. by apply Rge_le in Hx'. apply Rle_trans with (1 := proj2 Hy). rewrite /Rabs /Rmax. case: Rcase_abs ; case: Rle_dec => // Hx Hx'. by apply Rlt_not_le in Hx'. apply Ropp_le_cancel, Rlt_le ; by rewrite Ropp_involutive Ropp_0. by apply Req_le. by apply Rge_le in Hx'. apply is_RInt_ext with (Derive (PSeries (PS_Int a))). move => y Hy. rewrite Derive_PSeries. apply PSeries_ext ; rewrite /PS_derive /PS_Int => n ; rewrite S_INR. field. apply Rgt_not_eq, INRp1_pos. rewrite CV_radius_Int. by apply H ; split ; apply Rlt_le ; apply Hy. evar_last. apply: is_RInt_derive. move => y Hy. apply Derive_correct, ex_derive_PSeries. rewrite CV_radius_Int. by apply H. move => y Hy. apply continuous_ext_loc with (PSeries a). apply locally_interval with (Rbar_opp (CV_radius a)) (CV_radius a). apply Rbar_opp_lt ; rewrite Rbar_opp_involutive. apply: Rbar_le_lt_trans (H _ Hy). apply Rabs_maj2. apply: Rbar_le_lt_trans (H _ Hy). apply Rle_abs. move => z Hz Hz'. rewrite Derive_PSeries. apply PSeries_ext ; rewrite /PS_derive /PS_Int => n ; rewrite S_INR. field. apply Rgt_not_eq, INRp1_pos. rewrite CV_radius_Int. apply (Rbar_abs_lt_between z) ; by split. apply continuity_pt_filterlim, PSeries_continuity. by apply H. rewrite PSeries_0 /(PS_Int _ 0) ; by rewrite minus_zero_r. Qed. Lemma ex_RInt_PSeries (a : nat -> R) (x : R) : Rbar_lt (Rabs x) (CV_radius a) -> ex_RInt (PSeries a) 0 x. Proof. move => Hx. exists (PSeries (PS_Int a) x). by apply is_RInt_PSeries. Qed. Lemma RInt_PSeries (a : nat -> R) (x : R) : Rbar_lt (Rabs x) (CV_radius a) -> RInt (PSeries a) 0 x = PSeries (PS_Int a) x. Proof. move => Hx. apply is_RInt_unique. by apply is_RInt_PSeries. Qed. Lemma is_pseries_RInt (a : nat -> R) : forall x, Rbar_lt (Rabs x) (CV_radius a) -> is_pseries (PS_Int a) x (RInt (PSeries a) 0 x). Proof. move => x Hx. erewrite is_RInt_unique. apply PSeries_correct. apply CV_radius_inside. by rewrite CV_radius_Int. exact: is_RInt_PSeries. Qed. (** * Integration by parts *) Section ByParts. Context {V : CompleteNormedModule R_AbsRing}. Lemma is_RInt_scal_derive : forall (f : R -> R) (g : R -> V) (f' : R -> R) (g' : R -> V) (a b : R), (forall t, Rmin a b <= t <= Rmax a b -> is_derive f t (f' t)) -> (forall t, Rmin a b <= t <= Rmax a b -> is_derive g t (g' t)) -> (forall t, Rmin a b <= t <= Rmax a b -> continuous f' t) -> (forall t, Rmin a b <= t <= Rmax a b -> continuous g' t) -> is_RInt (fun t => plus (scal (f' t) (g t)) (scal (f t) (g' t))) a b (minus (scal (f b) (g b)) (scal (f a) (g a))). Proof. intros f g f' g' a b Df Dg Cf' Cg' If'g. apply (is_RInt_derive (fun t => scal (f t) (g t))). intros t Ht. refine (_ (filterdiff_scal_fct t f g _ _ _ (Df _ Ht) (Dg _ Ht))). intros H. apply: filterdiff_ext_lin H _ => u. by rewrite scal_distr_l !scal_assoc /mult /= Rmult_comm. exact Rmult_comm. intros t Ht. apply: continuous_plus. apply: continuous_scal. now apply Cf'. apply ex_derive_continuous. eexists. now apply Dg. apply: continuous_scal. apply: ex_derive_continuous. eexists. now apply Df. now apply Cg'. Qed. Lemma is_RInt_scal_derive_r : forall (f : R -> R) (g : R -> V) (f' : R -> R) (g' : R -> V) (a b : R) (l : V), (forall t, Rmin a b <= t <= Rmax a b -> is_derive f t (f' t)) -> (forall t, Rmin a b <= t <= Rmax a b -> is_derive g t (g' t)) -> (forall t, Rmin a b <= t <= Rmax a b -> continuous f' t) -> (forall t, Rmin a b <= t <= Rmax a b -> continuous g' t) -> is_RInt (fun t => scal (f' t) (g t)) a b l -> is_RInt (fun t => scal (f t) (g' t)) a b (minus (minus (scal (f b) (g b)) (scal (f a) (g a))) l). Proof. intros f g f' g' a b l Df Dg Cf' Cg' If'g. apply (is_RInt_ext (fun t => minus (plus (scal (f' t) (g t)) (scal (f t) (g' t))) (scal (f' t) (g t)))). intros x H. by rewrite /minus (plus_comm (scal (f' x) _)) -plus_assoc plus_opp_r plus_zero_r. apply is_RInt_minus with (2 := If'g). exact: is_RInt_scal_derive. Qed. Lemma is_RInt_scal_derive_l : forall (f : R -> R) (g : R -> V) (f' : R -> R) (g' : R -> V) (a b : R) (l : V), (forall t, Rmin a b <= t <= Rmax a b -> is_derive f t (f' t)) -> (forall t, Rmin a b <= t <= Rmax a b -> is_derive g t (g' t)) -> (forall t, Rmin a b <= t <= Rmax a b -> continuous f' t) -> (forall t, Rmin a b <= t <= Rmax a b -> continuous g' t) -> is_RInt (fun t => scal (f t) (g' t)) a b l -> is_RInt (fun t => scal (f' t) (g t)) a b (minus (minus (scal (f b) (g b)) (scal (f a) (g a))) l). Proof. intros f g f' g' a b l Df Dg Cf' Cg' If'g. apply (is_RInt_ext (fun t => minus (plus (scal (f' t) (g t)) (scal (f t) (g' t))) (scal (f t) (g' t)))). intros x H. by rewrite /minus -plus_assoc plus_opp_r plus_zero_r. apply is_RInt_minus with (2 := If'g). exact: is_RInt_scal_derive. Qed. End ByParts. coquelicot-coquelicot-3.4.1/theories/RInt_gen.v000066400000000000000000000311071455143432500215610ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2020 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect. Require Import Rbar Hierarchy RInt Lim_seq Continuity Derive Rcomplements RInt_analysis. (** This file describes improper integrals, such as integrals with an infinity endpoint or integrals of a function with a singularity. A few properties are given: Chasles, operations, composition, derivation.*) Open Scope R_scope. (** * Improper Riemann integral *) Section is_RInt_gen. Context {V : NormedModule R_AbsRing}. Definition is_RInt_gen (f : R -> V) (Fa Fb : (R -> Prop) -> Prop) (l : V) := filterlimi (fun ab => is_RInt f (fst ab) (snd ab)) (filter_prod Fa Fb) (locally l). Definition ex_RInt_gen (f : R -> V) (Fa Fb : (R -> Prop) -> Prop) := exists l : V, is_RInt_gen f Fa Fb l. Definition is_RInt_gen_at_point f a b l : is_RInt_gen f (at_point a) (at_point b) l <-> is_RInt f a b l. Proof. split. - intros H P HP. apply locally_locally in HP. specialize (H _ HP). destruct H as [Q R Qa Rb H]. destruct (H a b Qa Rb) as [y [Hy1 Hy2]]. now apply Hy1. - intros Hl P HP. exists (fun x => x = a) (fun x => x = b) ; try easy. intros x y -> ->. exists l. apply (conj Hl). exact: locally_singleton. Qed. (** * Basic properties of integrals *) Lemma is_RInt_gen_ext {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f g : R -> V) (l : V) : filter_prod Fa Fb (fun ab => forall x, Rmin (fst ab) (snd ab) < x < Rmax (fst ab) (snd ab) -> f x = g x) -> is_RInt_gen f Fa Fb l -> is_RInt_gen g Fa Fb l. Proof. intros Heq. apply: filterlimi_ext_loc. apply: filter_imp Heq. intros [a b] Heq y. split. now apply is_RInt_ext. apply is_RInt_ext. intros x Hx. now apply sym_eq, Heq. Qed. Lemma ex_RInt_gen_ext {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f g : R -> V) : filter_prod Fa Fb (fun ab => forall x, Rmin (fst ab) (snd ab) < x < Rmax (fst ab) (snd ab) -> f x = g x) -> ex_RInt_gen f Fa Fb -> ex_RInt_gen g Fa Fb. Proof. move => Heq. case => I HI. exists I. exact: (is_RInt_gen_ext f g). Qed. Lemma ex_RInt_gen_ext_eq {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f g : R -> V) : (forall x, f x = g x) -> ex_RInt_gen f Fa Fb -> ex_RInt_gen g Fa Fb. Proof. move => Heq. apply: ex_RInt_gen_ext. exact: filter_forall => bds x _. Qed. Lemma is_RInt_gen_point (f : R -> V) (a : R) : is_RInt_gen f (at_point a) (at_point a) zero. Proof. apply is_RInt_gen_at_point. exact: is_RInt_point. Qed. Lemma is_RInt_gen_swap {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f : R -> V) (l : V) : is_RInt_gen f Fb Fa l -> is_RInt_gen f Fa Fb (opp l). Proof. intros Hf P HP. specialize (Hf (fun y => P (opp y))). destruct Hf as [Q R HQ HR H]. exact: filterlim_opp. apply: Filter_prod HR HQ _ => a b Ha Hb. specialize (H b a Hb Ha). destruct H as [y [Hy1 Hy2]]. exists (opp y). split. exact: is_RInt_swap. exact Hy2. Qed. Lemma is_RInt_gen_Chasles {Fa Fc : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFc : Filter Fc} (f : R -> V) (b : R) (l1 l2 : V) : is_RInt_gen f Fa (at_point b) l1 -> is_RInt_gen f (at_point b) Fc l2 -> is_RInt_gen f Fa Fc (plus l1 l2). Proof. intros Hab Hbc P HP. specialize (filterlim_plus _ _ P HP). intros [Q R HQ HR H]. specialize (Hab Q HQ). specialize (Hbc R HR). destruct Hab as [Qa Ra HQa HRa Hab]. destruct Hbc as [Qc Rc HQc HRc Hbc]. apply: Filter_prod HQa HRc _. intros a c Ha Hc. specialize (Hab _ _ Ha HRa). specialize (Hbc _ _ HQc Hc). destruct Hab as [ya [Hya1 Hya2]]. destruct Hbc as [yc [Hyc1 Hyc2]]. exists (plus ya yc). split. apply: is_RInt_Chasles Hya1 Hyc1. now apply H. Qed. Lemma ex_RInt_gen_Chasles : forall {Fa Fc : (R -> Prop) -> Prop}, forall {FFa : Filter Fa} {FFc : Filter Fc}, forall (f : R -> V) (b : R), ex_RInt_gen f Fa (at_point b) -> ex_RInt_gen f (at_point b) Fc -> ex_RInt_gen f Fa Fc. Proof. intros Fa Fc FFa FFc f b [Iab Hab] [Ibc Hbc]. exists (plus Iab Ibc). now apply is_RInt_gen_Chasles with b. Qed. (** * Composition *) (* Lemma is_RInt_gen_comp_opp {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f : R -> V) (l : V) : is_RInt_gen f (filtermap opp Fa) (filtermap opp Fb) l -> is_RInt_gen (fun y => opp (f (- y))) Fa Fb l. Proof. intros H. apply: filterlimi_ext. unfold is_RInt_gen. apply: filterlimi_comp_2. apply filterlim_fst. apply filterlim_snd. SearchAbout fst filter_prod. case => If [Hf Hl]. exists (fun x => If (opp x)) ; split. case: Hf => P Q ; unfold filtermap => Pa Qb H. eexists ; try eassumption. move => /= a b Ha Hb. by apply is_RInt_comp_opp, H. eapply filterlim_comp, Hl. intros P [Q1 Q2 Q1a Q2b H]. eexists ; try eassumption. move => /= a b Ha Hb. by apply H. Qed. Lemma is_RInt_gen_comp_lin {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f : R -> V) (u v : R) (l : V) : is_RInt_gen f (filtermap (fun a => u * a + v) Fa) (filtermap (fun b => u * b + v) Fb) l -> is_RInt_gen (fun y => scal u (f (u * y + v))) Fa Fb l. Proof. case => If [Hf Hl]. exists (fun x => If (plus (scal u x) (v,v))) ; split. case: Hf => P Q ; unfold filtermap => Pa Qb H. eexists ; try eassumption. move => /= a b Ha Hb. by apply is_RInt_comp_lin, H. eapply filterlim_comp, Hl. intros P [Q1 Q2 Q1a Q2b H]. eexists ; try eassumption. move => /= a b Ha Hb. by apply H. Qed. *) (** * Operations *) Lemma is_RInt_gen_scal {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f : R -> V) (k : R) (l : V) : is_RInt_gen f Fa Fb l -> is_RInt_gen (fun y => scal k (f y)) Fa Fb (scal k l). Proof. intros H P HP. move /filterlim_scal_r in HP. specialize (H _ HP). unfold filtermapi in H |- *. apply: filter_imp H. move => [a b] /= [y [Hy1 Hy2]]. exists (scal k y). apply: conj Hy2. exact: is_RInt_scal. Qed. Lemma is_RInt_gen_opp {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f : R -> V) (l : V) : is_RInt_gen f Fa Fb l -> is_RInt_gen (fun y => opp (f y)) Fa Fb (opp l). Proof. intros H P HP. move /filterlim_opp in HP. specialize (H _ HP). unfold filtermapi in H |- *. apply: filter_imp H. move => [a b] /= [y [Hy1 Hy2]]. exists (opp y). apply: conj Hy2. exact: is_RInt_opp. Qed. Lemma is_RInt_gen_plus {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f g : R -> V) (lf lg : V) : is_RInt_gen f Fa Fb lf -> is_RInt_gen g Fa Fb lg -> is_RInt_gen (fun y => plus (f y) (g y)) Fa Fb (plus lf lg). Proof. intros Hf Hg P HP. move /filterlim_plus in HP. destruct HP as [Q R HQ HR H]. specialize (Hf _ HQ). specialize (Hg _ HR). unfold filtermapi in Hf, Hg |- *. apply: filter_imp (filter_and _ _ Hf Hg). move => [a b] /= [[If [HIf1 HIf2]] [Ig [HIg1 HIg2]]]. exists (plus If Ig). apply: conj (H _ _ HIf2 HIg2). exact: is_RInt_plus. Qed. Lemma is_RInt_gen_minus {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f g : R -> V) (lf lg : V) : is_RInt_gen f Fa Fb lf -> is_RInt_gen g Fa Fb lg -> is_RInt_gen (fun y => minus (f y) (g y)) Fa Fb (minus lf lg). Proof. intros Hf Hg. apply: is_RInt_gen_plus Hf _. exact: is_RInt_gen_opp. Qed. End is_RInt_gen. Section RInt_gen. Context {V : CompleteNormedModule R_AbsRing}. Definition RInt_gen (f : R -> V) (a b : (R -> Prop) -> Prop) := iota (is_RInt_gen f a b). Lemma is_RInt_gen_unique {Fa Fb : (R -> Prop) -> Prop} {FFa : ProperFilter' Fa} {FFb : ProperFilter' Fb} (f : R -> V) (l : V) : is_RInt_gen f Fa Fb l -> RInt_gen f Fa Fb = l. Proof. apply iota_filterlimi_locally. apply filter_forall. intros [a b] y1 u2 H1 H2. rewrite -(is_RInt_unique _ _ _ _ H1). now apply is_RInt_unique. Qed. Lemma RInt_gen_correct {Fa Fb : (R -> Prop) -> Prop} {FFa : ProperFilter' Fa} {FFb : ProperFilter' Fb} (f : R -> V) : ex_RInt_gen f Fa Fb -> is_RInt_gen f Fa Fb (RInt_gen f Fa Fb). Proof. intros [If HIf]. erewrite is_RInt_gen_unique ; exact HIf. Qed. Lemma RInt_gen_norm {Fa Fb : (R -> Prop) -> Prop} {FFa : ProperFilter Fa} {FFb : ProperFilter Fb} (f : R -> V) (g : R -> R) (lf : V) (lg : R) : filter_prod Fa Fb (fun ab => fst ab <= snd ab) -> filter_prod Fa Fb (fun ab => forall x, fst ab <= x <= snd ab -> norm (f x) <= g x) -> is_RInt_gen f Fa Fb lf -> is_RInt_gen g Fa Fb lg -> norm lf <= lg. Proof. intros Hab Hle Hf Hg. apply (filterlim_le (F := filter_prod Fa Fb) (fun ab => norm (RInt f (fst ab) (snd ab))) (fun ab => RInt g (fst ab) (snd ab)) (norm lf) lg). - specialize (Hf _ (locally_ball lf (mkposreal _ Rlt_0_1))). specialize (Hg _ (locally_ball lg (mkposreal _ Rlt_0_1))). unfold filtermapi in Hf, Hg. apply: filter_imp (filter_and _ _ (filter_and _ _ Hf Hg) (filter_and _ _ Hab Hle)) => {Hf Hg Hab Hle}. move => [a b] /= [[[If [Hf1 Hf2]] [Ig [Hg1 Hg2]]] [H H']]. apply: norm_RInt_le H H' _ _. apply: RInt_correct. now exists If. apply: RInt_correct. now exists Ig. - eapply filterlim_comp, filterlim_norm. intros P HP. specialize (Hf P HP). unfold filtermapi, filtermap in Hf |- *. apply: filter_imp Hf. move => [a b] /= [y [Hy1 Hy2]]. now rewrite (is_RInt_unique _ a b y Hy1). - intros P HP. specialize (Hg P HP). unfold filtermapi, filtermap in Hg |- *. apply: filter_imp Hg. move => [a b] /= [y [Hy1 Hy2]]. now rewrite (is_RInt_unique _ a b y Hy1). Qed. Lemma RInt_gen_ext {Fa Fb : (R -> Prop) -> Prop} {FFa : ProperFilter Fa} {FFb : ProperFilter Fb} (f g : R -> V) : filter_prod Fa Fb (fun ab => forall x, Rmin (fst ab) (snd ab) < x < Rmax (fst ab) (snd ab) -> f x = g x) -> ex_RInt_gen f Fa Fb -> RInt_gen f Fa Fb = RInt_gen g Fa Fb. Proof. move => Heq [I HI]. rewrite (is_RInt_gen_unique f I HI); symmetry. apply is_RInt_gen_unique. (* 'apply:' does not work *) by apply: is_RInt_gen_ext; first exact: Heq. Qed. Lemma RInt_gen_ext_eq {Fa Fb : (R -> Prop) -> Prop} {FFa : ProperFilter Fa} {FFb : ProperFilter Fb} (f g : R -> V): (forall x, f x = g x) -> ex_RInt_gen f Fa Fb -> RInt_gen f Fa Fb = RInt_gen g Fa Fb. Proof. move => Heq. apply: (RInt_gen_ext f g). exact: filter_forall => bnds x _. Qed. Lemma RInt_gen_Chasles : forall {Fa Fc : (R -> Prop) -> Prop}, forall {FFa : ProperFilter' Fa} {FFc : ProperFilter' Fc}, forall (f : R -> V) (b : R), ex_RInt_gen f Fa (at_point b) -> ex_RInt_gen f (at_point b) Fc -> plus (RInt_gen f Fa (at_point b)) (RInt_gen f (at_point b) Fc) = RInt_gen f Fa Fc. Proof. intros Fa Fc FFa FFc f b Hab Hbc. apply eq_sym, is_RInt_gen_unique. apply: is_RInt_gen_Chasles. now apply RInt_gen_correct. now apply RInt_gen_correct. Qed. End RInt_gen. Lemma is_RInt_gen_Derive {Fa Fb : (R -> Prop) -> Prop} {FFa : Filter Fa} {FFb : Filter Fb} (f : R -> R) (la lb : R) : filter_prod Fa Fb (fun ab => forall x : R, Rmin (fst ab) (snd ab) <= x <= Rmax (fst ab) (snd ab) -> ex_derive f x) -> filter_prod Fa Fb (fun ab => forall x : R, Rmin (fst ab) (snd ab) <= x <= Rmax (fst ab) (snd ab) -> continuous (Derive f) x) -> filterlim f Fa (locally la) -> filterlim f Fb (locally lb) -> is_RInt_gen (Derive f) Fa Fb (lb - la). Proof. intros Df Cf Lfa Lfb P HP. assert (HP': filter_prod Fa Fb (fun ab => P (f (snd ab) - f (fst ab)))). unfold Rminus. eapply filterlim_comp_2. eapply filterlim_comp, Lfb. by apply filterlim_snd. eapply filterlim_comp, @filterlim_opp. eapply filterlim_comp, Lfa. by apply filterlim_fst. exact: (filterlim_plus lb (- la)). exact HP. apply: filter_imp (filter_and _ _ (filter_and _ _ Df Cf) HP'). move => [a b] /= {Df Cf HP HP'} [[Df Cf] HP]. eexists. apply: conj HP. apply: is_RInt_derive => x Hx. now apply Derive_correct, Df. exact: Cf. Qed. Section Complements_RInt_gen. Context {V : CompleteNormedModule R_AbsRing}. Lemma ex_RInt_gen_at_point f a b : @ex_RInt_gen V f (at_point a) (at_point b) <-> ex_RInt f a b. Proof. split; case => I. rewrite is_RInt_gen_at_point => HI. by exists I. rewrite -is_RInt_gen_at_point => HI. by exists I. Qed. Lemma RInt_gen_at_point f a b : ex_RInt f a b -> @RInt_gen V f (at_point a) (at_point b) = RInt f a b. Proof. move => Hfint. apply is_RInt_gen_unique. apply is_RInt_gen_at_point. exact: RInt_correct. Qed. End Complements_RInt_gen. coquelicot-coquelicot-3.4.1/theories/Rbar.v000066400000000000000000000636611455143432500207540ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals ssreflect. Require Import Rcomplements. Local Tactic Notation "intuition" := (intuition auto with real). (** This file contains the definition and properties of the set [R] # ∪ {+ ∞} ∪ {- ∞} # denoted by [Rbar]. We have defined: - coercions from [R] to [Rbar] and vice versa ([Finite] gives [R0] at infinity points) - an order [Rbar_lt] and [Rbar_le] - total operations: [Rbar_opp], [Rbar_plus], [Rbar_minus], [Rbar_inv], [Rbar_min] and [Rbar_abs] - lemmas about the decidability of the order and properties of the operations (such as [Rbar_plus_comm] or [Rbar_plus_lt_compat]) *) Open Scope R_scope. (** * Definitions *) Inductive Rbar := | Finite : R -> Rbar | p_infty : Rbar | m_infty : Rbar. Definition real (x : Rbar) := match x with | Finite x => x | _ => 0 end. Coercion Finite : R >-> Rbar. Coercion real : Rbar >-> R. Definition is_finite (x : Rbar) := Finite (real x) = x. Lemma is_finite_correct (x : Rbar) : is_finite x <-> exists y : R, x = Finite y. Proof. rewrite /is_finite ; case: x => /= ; split => // H. by exists r. by case: H. by case: H. Qed. (** ** Order *) Definition Rbar_lt (x y : Rbar) : Prop := match x,y with | p_infty, _ | _, m_infty => False | m_infty, _ | _, p_infty => True | Finite x, Finite y => Rlt x y end. Definition Rbar_le (x y : Rbar) : Prop := match x,y with | m_infty, _ | _, p_infty => True | p_infty, _ | _, m_infty => False | Finite x, Finite y => Rle x y end. (** ** Operations *) (** *** Additive operators *) Definition Rbar_opp (x : Rbar) := match x with | Finite x => Finite (-x) | p_infty => m_infty | m_infty => p_infty end. Definition Rbar_plus' (x y : Rbar) := match x,y with | p_infty, m_infty | m_infty, p_infty => None | p_infty, _ | _, p_infty => Some p_infty | m_infty, _ | _, m_infty => Some m_infty | Finite x', Finite y' => Some (Finite (x' + y')) end. Definition Rbar_plus (x y : Rbar) := match Rbar_plus' x y with Some z => z | None => Finite 0 end. Arguments Rbar_plus !x !y /. Definition is_Rbar_plus (x y z : Rbar) : Prop := Rbar_plus' x y = Some z. Definition ex_Rbar_plus (x y : Rbar) : Prop := match Rbar_plus' x y with Some _ => True | None => False end. Arguments ex_Rbar_plus !x !y /. Lemma is_Rbar_plus_unique (x y z : Rbar) : is_Rbar_plus x y z -> Rbar_plus x y = z. Proof. unfold is_Rbar_plus, ex_Rbar_plus, Rbar_plus. case: Rbar_plus' => // a Ha. by inversion Ha. Qed. Lemma Rbar_plus_correct (x y : Rbar) : ex_Rbar_plus x y -> is_Rbar_plus x y (Rbar_plus x y). Proof. unfold is_Rbar_plus, ex_Rbar_plus, Rbar_plus. by case: Rbar_plus'. Qed. Definition Rbar_minus (x y : Rbar) := Rbar_plus x (Rbar_opp y). Arguments Rbar_minus !x !y /. Definition is_Rbar_minus (x y z : Rbar) : Prop := is_Rbar_plus x (Rbar_opp y) z. Definition ex_Rbar_minus (x y : Rbar) : Prop := ex_Rbar_plus x (Rbar_opp y). Arguments ex_Rbar_minus !x !y /. (** *** Multiplicative operators *) Definition Rbar_inv (x : Rbar) : Rbar := match x with | Finite x => Finite (/x) | _ => Finite 0 end. Definition Rbar_mult' (x y : Rbar) := match x with | Finite x => match y with | Finite y => Some (Finite (x * y)) | p_infty => match (Rle_dec 0 x) with | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some p_infty | right _ => None end | right _ => Some m_infty end | m_infty => match (Rle_dec 0 x) with | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some m_infty | right _ => None end | right _ => Some p_infty end end | p_infty => match y with | Finite y => match (Rle_dec 0 y) with | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some p_infty | right _ => None end | right _ => Some m_infty end | p_infty => Some p_infty | m_infty => Some m_infty end | m_infty => match y with | Finite y => match (Rle_dec 0 y) with | left H => match Rle_lt_or_eq_dec _ _ H with left _ => Some m_infty | right _ => None end | right _ => Some p_infty end | p_infty => Some m_infty | m_infty => Some p_infty end end. Definition Rbar_mult (x y : Rbar) := match Rbar_mult' x y with Some z => z | None => Finite 0 end. Arguments Rbar_mult !x !y /. Definition is_Rbar_mult (x y z : Rbar) : Prop := Rbar_mult' x y = Some z. Definition ex_Rbar_mult (x y : Rbar) : Prop := match x with | Finite x => match y with | Finite y => True | p_infty => x <> 0 | m_infty => x <> 0 end | p_infty => match y with | Finite y => y <> 0 | p_infty => True | m_infty => True end | m_infty => match y with | Finite y => y <> 0 | p_infty => True | m_infty => True end end. Arguments ex_Rbar_mult !x !y /. Definition Rbar_mult_pos (x : Rbar) (y : posreal) := match x with | Finite x => Finite (x*y) | _ => x end. Lemma is_Rbar_mult_unique (x y z : Rbar) : is_Rbar_mult x y z -> Rbar_mult x y = z. Proof. unfold is_Rbar_mult ; case: x => [x | | ] ; case: y => [y | | ] ; case: z => [z | | ] //= H ; inversion H => // ; case: Rle_dec H => // H0 ; case: Rle_lt_or_eq_dec => //. Qed. Lemma Rbar_mult_correct (x y : Rbar) : ex_Rbar_mult x y -> is_Rbar_mult x y (Rbar_mult x y). Proof. case: x => [x | | ] ; case: y => [y | | ] //= H ; apply sym_not_eq in H ; unfold is_Rbar_mult ; simpl ; case: Rle_dec => // H0 ; case: Rle_lt_or_eq_dec => //. Qed. Lemma Rbar_mult_correct' (x y z : Rbar) : is_Rbar_mult x y z -> ex_Rbar_mult x y. Proof. unfold is_Rbar_mult ; case: x => [x | | ] ; case: y => [y | | ] //= ; case: Rle_dec => //= H ; try (case: Rle_lt_or_eq_dec => //=) ; intros. by apply Rgt_not_eq. by apply Rlt_not_eq, Rnot_le_lt. by apply Rgt_not_eq. by apply Rlt_not_eq, Rnot_le_lt. by apply Rgt_not_eq. by apply Rlt_not_eq, Rnot_le_lt. by apply Rgt_not_eq. by apply Rlt_not_eq, Rnot_le_lt. Qed. Definition Rbar_div (x y : Rbar) : Rbar := Rbar_mult x (Rbar_inv y). Arguments Rbar_div !x !y /. Definition is_Rbar_div (x y z : Rbar) : Prop := is_Rbar_mult x (Rbar_inv y) z. Definition ex_Rbar_div (x y : Rbar) : Prop := ex_Rbar_mult x (Rbar_inv y). Arguments ex_Rbar_div !x !y /. Definition Rbar_div_pos (x : Rbar) (y : posreal) := match x with | Finite x => Finite (x/y) | _ => x end. (** * Compatibility with real numbers *) (** For equality and order. The compatibility of addition and multiplication is proved in Rbar_seq *) Lemma Rbar_finite_eq (x y : R) : Finite x = Finite y <-> x = y. Proof. split ; intros. apply Rle_antisym ; apply Rnot_lt_le ; intro. assert (Rbar_lt (Finite y) (Finite x)). simpl ; apply H0. rewrite H in H1 ; simpl in H1 ; by apply Rlt_irrefl in H1. assert (Rbar_lt (Finite x) (Finite y)). simpl ; apply H0. rewrite H in H1 ; simpl in H1 ; by apply Rlt_irrefl in H1. rewrite H ; reflexivity. Qed. Lemma Rbar_finite_neq (x y : R) : Finite x <> Finite y <-> x <> y. Proof. split => H ; contradict H ; by apply Rbar_finite_eq. Qed. (** * Properties of order *) (** ** Relations between inequalities *) Lemma Rbar_lt_not_eq (x y : Rbar) : Rbar_lt x y -> x<>y. Proof. destruct x ; destruct y ; simpl ; try easy. intros H H0. apply Rbar_finite_eq in H0 ; revert H0 ; apply Rlt_not_eq, H. Qed. Lemma Rbar_not_le_lt (x y : Rbar) : ~ Rbar_le x y -> Rbar_lt y x. Proof. destruct x ; destruct y ; simpl ; intuition. Qed. Lemma Rbar_lt_not_le (x y : Rbar) : Rbar_lt y x -> ~ Rbar_le x y. Proof. destruct x ; destruct y ; simpl ; intuition. apply (Rlt_irrefl r0). now apply Rlt_le_trans with (1 := H). Qed. Lemma Rbar_not_lt_le (x y : Rbar) : ~ Rbar_lt x y -> Rbar_le y x. Proof. destruct x ; destruct y ; simpl ; intuition. now apply Rnot_lt_le. Qed. Lemma Rbar_le_not_lt (x y : Rbar) : Rbar_le y x -> ~ Rbar_lt x y. Proof. destruct x ; destruct y ; simpl ; intuition ; contradict H0. now apply Rle_not_lt. Qed. Lemma Rbar_le_refl : forall x : Rbar, Rbar_le x x. Proof. intros [x| |] ; try easy. apply Rle_refl. Qed. Lemma Rbar_lt_le : forall x y : Rbar, Rbar_lt x y -> Rbar_le x y. Proof. intros [x| |] [y| |] ; try easy. apply Rlt_le. Qed. (** ** Decidability *) Lemma Rbar_total_order (x y : Rbar) : {Rbar_lt x y} + {x = y} + {Rbar_lt y x}. Proof. destruct x ; destruct y ; simpl ; intuition. destruct (total_order_T r r0) ; intuition. Qed. Lemma Rbar_eq_dec (x y : Rbar) : {x = y} + {x <> y}. Proof. intros ; destruct (Rbar_total_order x y) as [[H|H]|H]. right ; revert H ; destruct x as [x| |] ; destruct y as [y| |] ; simpl ; intros H ; try easy. contradict H. apply Rbar_finite_eq in H ; try apply Rle_not_lt, Req_le ; auto. left ; apply H. right ; revert H ; destruct x as [x| |] ; destruct y as [y| |] ; simpl ; intros H ; try easy. contradict H. apply Rbar_finite_eq in H ; apply Rle_not_lt, Req_le ; auto. Qed. Lemma Rbar_lt_dec (x y : Rbar) : {Rbar_lt x y} + {~Rbar_lt x y}. Proof. destruct (Rbar_total_order x y) as [H|H] ; [ destruct H as [H|H]|]. now left. right ; rewrite H ; clear H ; destruct y ; auto ; apply Rlt_irrefl ; auto. right ; revert H ; destruct x as [x | | ] ; destruct y as [y | | ] ; intros H ; auto ; apply Rle_not_lt, Rlt_le ; auto. Qed. Lemma Rbar_lt_le_dec (x y : Rbar) : {Rbar_lt x y} + {Rbar_le y x}. Proof. destruct (Rbar_total_order x y) as [[H|H]|H]. now left. right. rewrite H. apply Rbar_le_refl. right. now apply Rbar_lt_le. Qed. Lemma Rbar_le_dec (x y : Rbar) : {Rbar_le x y} + {~Rbar_le x y}. Proof. destruct (Rbar_total_order x y) as [[H|H]|H]. left. now apply Rbar_lt_le. left. rewrite H. apply Rbar_le_refl. right. now apply Rbar_lt_not_le. Qed. Lemma Rbar_le_lt_dec (x y : Rbar) : {Rbar_le x y} + {Rbar_lt y x}. Proof. destruct (Rbar_total_order x y) as [[H|H]|H]. left. now apply Rbar_lt_le. left. rewrite H. apply Rbar_le_refl. now right. Qed. Lemma Rbar_le_lt_or_eq_dec (x y : Rbar) : Rbar_le x y -> { Rbar_lt x y } + { x = y }. Proof. destruct (Rbar_total_order x y) as [[H|H]|H]. now left. now right. intros K. now elim (Rbar_le_not_lt _ _ K). Qed. (** ** Transitivity *) Lemma Rbar_lt_trans (x y z : Rbar) : Rbar_lt x y -> Rbar_lt y z -> Rbar_lt x z. Proof. destruct x ; destruct y ; destruct z ; simpl ; intuition. now apply Rlt_trans with r0. Qed. Lemma Rbar_lt_le_trans (x y z : Rbar) : Rbar_lt x y -> Rbar_le y z -> Rbar_lt x z. Proof. destruct x ; destruct y ; destruct z ; simpl ; intuition. now apply Rlt_le_trans with r0. Qed. Lemma Rbar_le_lt_trans (x y z : Rbar) : Rbar_le x y -> Rbar_lt y z -> Rbar_lt x z. Proof. destruct x ; destruct y ; destruct z ; simpl ; intuition. now apply Rle_lt_trans with r0. Qed. Lemma Rbar_le_trans (x y z : Rbar) : Rbar_le x y -> Rbar_le y z -> Rbar_le x z. Proof. destruct x ; destruct y ; destruct z ; simpl ; intuition. now apply Rle_trans with r0. Qed. Lemma Rbar_le_antisym (x y : Rbar) : Rbar_le x y -> Rbar_le y x -> x = y. Proof. destruct x ; destruct y ; simpl ; intuition. Qed. (** * Properties of operations *) (** ** Additive operators *) (** *** Rbar_opp *) Lemma Rbar_opp_involutive (x : Rbar) : (Rbar_opp (Rbar_opp x)) = x. Proof. destruct x as [x| | ] ; auto ; simpl ; rewrite Ropp_involutive ; auto. Qed. Lemma Rbar_opp_lt (x y : Rbar) : Rbar_lt (Rbar_opp x) (Rbar_opp y) <-> Rbar_lt y x. Proof. destruct x as [x | | ] ; destruct y as [y | | ] ; split ; auto ; intro H ; simpl ; try left. apply Ropp_lt_cancel ; auto. apply Ropp_lt_contravar ; auto. Qed. Lemma Rbar_opp_le (x y : Rbar) : Rbar_le (Rbar_opp x) (Rbar_opp y) <-> Rbar_le y x. Proof. destruct x as [x| |] ; destruct y as [y| |] ; simpl ; intuition. Qed. Lemma Rbar_opp_eq (x y : Rbar) : (Rbar_opp x) = (Rbar_opp y) <-> x = y. Proof. split ; intros H. rewrite <- (Rbar_opp_involutive x), H, Rbar_opp_involutive ; reflexivity. rewrite H ; reflexivity. Qed. Lemma Rbar_opp_real (x : Rbar) : real (Rbar_opp x) = - real x. Proof. destruct x as [x | | ] ; simpl ; intuition. Qed. (** *** Rbar_plus *) Lemma Rbar_plus'_comm : forall x y, Rbar_plus' x y = Rbar_plus' y x. Proof. intros [x| |] [y| |] ; try reflexivity. apply (f_equal (fun x => Some (Finite x))), Rplus_comm. Qed. Lemma ex_Rbar_plus_comm : forall x y, ex_Rbar_plus x y -> ex_Rbar_plus y x. Proof. now intros [x| |] [y| |]. Qed. Lemma ex_Rbar_plus_opp (x y : Rbar) : ex_Rbar_plus x y -> ex_Rbar_plus (Rbar_opp x) (Rbar_opp y). Proof. case: x => [x | | ] ; case: y => [y | | ] => //. Qed. Lemma Rbar_plus_0_r (x : Rbar) : Rbar_plus x (Finite 0) = x. Proof. case: x => //= ; intuition. Qed. Lemma Rbar_plus_0_l (x : Rbar) : Rbar_plus (Finite 0) x = x. Proof. case: x => //= ; intuition. Qed. Lemma Rbar_plus_comm (x y : Rbar) : Rbar_plus x y = Rbar_plus y x. Proof. case x ; case y ; intuition. simpl. apply f_equal, Rplus_comm. Qed. Lemma Rbar_plus_lt_compat (a b c d : Rbar) : Rbar_lt a b -> Rbar_lt c d -> Rbar_lt (Rbar_plus a c) (Rbar_plus b d). Proof. case: a => [a | | ] // ; case: b => [b | | ] // ; case: c => [c | | ] // ; case: d => [d | | ] // ; apply Rplus_lt_compat. Qed. Lemma Rbar_plus_le_compat (a b c d : Rbar) : Rbar_le a b -> Rbar_le c d -> Rbar_le (Rbar_plus a c) (Rbar_plus b d). Proof. case: a => [a | | ] // ; case: b => [b | | ] // ; case: c => [c | | ] // ; case: d => [d | | ] //. apply Rplus_le_compat. intros _ _. apply Rle_refl. intros _ _. apply Rle_refl. Qed. Lemma Rbar_plus_opp (x y : Rbar) : Rbar_plus (Rbar_opp x) (Rbar_opp y) = Rbar_opp (Rbar_plus x y). Proof. case: x => [x | | ] ; case: y => [y | | ] //= ; apply f_equal ; ring. Qed. (** *** Rbar_minus *) Lemma Rbar_minus_eq_0 (x : Rbar) : Rbar_minus x x = 0. Proof. case: x => //= x ; by apply f_equal, Rcomplements.Rminus_eq_0. Qed. Lemma Rbar_opp_minus (x y : Rbar) : Rbar_opp (Rbar_minus x y) = Rbar_minus y x. Proof. case: x => [x | | ] ; case: y => [y | | ] //=. by rewrite Ropp_minus_distr'. by rewrite Ropp_0. by rewrite Ropp_0. Qed. (** ** Multiplicative *) (** *** Rbar_inv *) Lemma Rbar_inv_opp (x : Rbar) : x <> 0 -> Rbar_inv (Rbar_opp x) = Rbar_opp (Rbar_inv x). Proof. case: x => [x | | ] /= Hx. rewrite Ropp_inv_permute => //. contradict Hx. by rewrite Hx. by rewrite Ropp_0. by rewrite Ropp_0. Qed. (** *** Rbar_mult *) Lemma Rbar_mult'_comm (x y : Rbar) : Rbar_mult' x y = Rbar_mult' y x. Proof. case: x => [x | | ] ; case: y => [y | | ] //=. by rewrite Rmult_comm. Qed. Lemma Rbar_mult'_opp_r (x y : Rbar) : Rbar_mult' x (Rbar_opp y) = match Rbar_mult' x y with Some z => Some (Rbar_opp z) | None => None end. Proof. case: x => [x | | ] ; case: y => [y | | ] //= ; (try case: Rle_dec => Hx //=) ; (try case: Rle_lt_or_eq_dec => //= Hx0). by rewrite Ropp_mult_distr_r_reverse. rewrite -Ropp_0 in Hx0. apply Ropp_lt_cancel in Hx0. case Rle_dec => Hy //=. now elim Rle_not_lt with (1 := Hy). case Rle_dec => Hy //=. case Rle_lt_or_eq_dec => Hy0 //=. elim Rlt_not_le with (1 := Hy0). apply Ropp_le_cancel. by rewrite Ropp_0. elim Hy. apply Ropp_le_cancel. rewrite -Hx0 Ropp_0. apply Rle_refl. case Rle_dec => Hy //=. case Rle_lt_or_eq_dec => Hy0 //=. elim Hx. rewrite -Hy0 Ropp_0. apply Rle_refl. elim Hx. rewrite -Ropp_0. apply Ropp_le_contravar. apply Rlt_le. now apply Rnot_le_lt. case Rle_dec => Hy //=. elim Rlt_not_le with (1 := Hx0). rewrite -Ropp_0. now apply Ropp_le_contravar. case Rle_dec => Hy //=. case Rle_lt_or_eq_dec => Hy0 //=. elim Rlt_not_le with (1 := Hy0). apply Ropp_le_cancel. rewrite -Hx0 Ropp_0. apply Rle_refl. elim Hy. apply Ropp_le_cancel. rewrite -Hx0 Ropp_0. apply Rle_refl. case Rle_dec => Hy //=. case Rle_lt_or_eq_dec => Hy0 //=. elim Hx. rewrite -Hy0 Ropp_0. apply Rle_refl. elim Hx. rewrite -Ropp_0. apply Ropp_le_contravar. apply Rlt_le. now apply Rnot_le_lt. Qed. Lemma Rbar_mult_comm (x y : Rbar) : Rbar_mult x y = Rbar_mult y x. Proof. unfold Rbar_mult. by rewrite Rbar_mult'_comm. Qed. Lemma Rbar_mult_opp_r (x y : Rbar) : Rbar_mult x (Rbar_opp y) = (Rbar_opp (Rbar_mult x y)). Proof. unfold Rbar_mult. rewrite Rbar_mult'_opp_r. case Rbar_mult' => //=. apply f_equal, eq_sym, Ropp_0. Qed. Lemma Rbar_mult_opp_l (x y : Rbar) : Rbar_mult (Rbar_opp x) y = Rbar_opp (Rbar_mult x y). Proof. rewrite ?(Rbar_mult_comm _ y). by apply Rbar_mult_opp_r. Qed. Lemma Rbar_mult_opp (x y : Rbar) : Rbar_mult (Rbar_opp x) (Rbar_opp y) = Rbar_mult x y. Proof. by rewrite Rbar_mult_opp_l -Rbar_mult_opp_r Rbar_opp_involutive. Qed. Lemma Rbar_mult_0_l (x : Rbar) : Rbar_mult 0 x = 0. Proof. case: x => [x | | ] //=. by rewrite Rmult_0_l. case: Rle_dec (Rle_refl 0) => // H _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => // _ _. case: Rle_dec (Rle_refl 0) => // H _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => // _ _. Qed. Lemma Rbar_mult_0_r (x : Rbar) : Rbar_mult x 0 = 0. Proof. rewrite Rbar_mult_comm ; by apply Rbar_mult_0_l. Qed. Lemma Rbar_mult_eq_0 (y x : Rbar) : Rbar_mult x y = 0 -> x = 0 \/ y = 0. Proof. case: x => [x | | ] //= ; case: y => [y | | ] //= ; (try case: Rle_dec => //= H) ; (try case: Rle_lt_or_eq_dec => //=) ; (try (left ; by apply f_equal)) ; (try (right ; by apply f_equal)). intros H. apply (f_equal real) in H. simpl in H. apply Rmult_integral in H ; case: H => ->. by left. by right. Qed. Lemma ex_Rbar_mult_sym (x y : Rbar) : ex_Rbar_mult x y -> ex_Rbar_mult y x. Proof. case: x => [x | | ] ; case: y => [y | | ] //. Qed. Lemma ex_Rbar_mult_opp_l (x y : Rbar) : ex_Rbar_mult x y -> ex_Rbar_mult (Rbar_opp x) y. Proof. case: x => [x | | ] ; case: y => [y | | ] //= Hx ; by apply Ropp_neq_0_compat. Qed. Lemma ex_Rbar_mult_opp_r (x y : Rbar) : ex_Rbar_mult x y -> ex_Rbar_mult x (Rbar_opp y). Proof. case: x => [x | | ] ; case: y => [y | | ] //= Hx ; by apply Ropp_neq_0_compat. Qed. Lemma is_Rbar_mult_sym (x y z : Rbar) : is_Rbar_mult x y z -> is_Rbar_mult y x z. Proof. case: x => [x | | ] ; case: y => [y | | ] ; case: z => [z | | ] //= ; unfold is_Rbar_mult, Rbar_mult' ; try (case: Rle_dec => // H) ; try (case: Rle_lt_or_eq_dec => // H0) ; try (case => <-) ; try (move => _). by rewrite Rmult_comm. Qed. Lemma is_Rbar_mult_opp_l (x y z : Rbar) : is_Rbar_mult x y z -> is_Rbar_mult (Rbar_opp x) y (Rbar_opp z). Proof. case: x => [x | | ] ; case: y => [y | | ] ; case: z => [z | | ] //= ; unfold is_Rbar_mult, Rbar_mult' ; try (case: Rle_dec => // H) ; try (case: Rle_lt_or_eq_dec => // H0) ; try (case => <-) ; try (move => _). apply (f_equal (@Some _)), f_equal ; ring. apply Ropp_lt_contravar in H0 ; rewrite Ropp_0 in H0 ; now move/Rlt_not_le: H0 ; case: Rle_dec. apply Rnot_le_lt, Ropp_lt_contravar in H ; rewrite Ropp_0 in H ; move/Rlt_le: (H) ; case: Rle_dec => // H0 _ ; now move/Rlt_not_eq: H ; case: Rle_lt_or_eq_dec. apply Rnot_le_lt, Ropp_lt_contravar in H ; rewrite Ropp_0 in H ; move/Rlt_le: (H) ; case: Rle_dec => // H0 _ ; now move/Rlt_not_eq: H ; case: Rle_lt_or_eq_dec. apply Ropp_lt_contravar in H0 ; rewrite Ropp_0 in H0 ; now move/Rlt_not_le: H0 ; case: Rle_dec. Qed. Lemma is_Rbar_mult_opp_r (x y z : Rbar) : is_Rbar_mult x y z -> is_Rbar_mult x (Rbar_opp y) (Rbar_opp z). Proof. move/is_Rbar_mult_sym => H. now apply is_Rbar_mult_sym, is_Rbar_mult_opp_l. Qed. Lemma is_Rbar_mult_p_infty_pos (x : Rbar) : Rbar_lt 0 x -> is_Rbar_mult p_infty x p_infty. Proof. case: x => [x | | ] // Hx. unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec (Rlt_le _ _ Hx) => // Hx' _. now case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Hx). Qed. Lemma is_Rbar_mult_p_infty_neg (x : Rbar) : Rbar_lt x 0 -> is_Rbar_mult p_infty x m_infty. Proof. case: x => [x | | ] // Hx. unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec (Rlt_not_le _ _ Hx) => // Hx' _. Qed. Lemma is_Rbar_mult_m_infty_pos (x : Rbar) : Rbar_lt 0 x -> is_Rbar_mult m_infty x m_infty. Proof. case: x => [x | | ] // Hx. unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec (Rlt_le _ _ Hx) => // Hx' _. now case: Rle_lt_or_eq_dec (Rlt_not_eq _ _ Hx). Qed. Lemma is_Rbar_mult_m_infty_neg (x : Rbar) : Rbar_lt x 0 -> is_Rbar_mult m_infty x p_infty. Proof. case: x => [x | | ] // Hx. unfold is_Rbar_mult, Rbar_mult'. case: Rle_dec (Rlt_not_le _ _ Hx) => // Hx' _. Qed. (** Rbar_div *) Lemma is_Rbar_div_p_infty (x : R) : is_Rbar_div x p_infty 0. Proof. apply (f_equal (@Some _)). by rewrite Rmult_0_r. Qed. Lemma is_Rbar_div_m_infty (x : R) : is_Rbar_div x m_infty 0. Proof. apply (f_equal (@Some _)). by rewrite Rmult_0_r. Qed. (** Rbar_mult_pos *) Lemma Rbar_mult_pos_eq (x y : Rbar) (z : posreal) : x = y <-> (Rbar_mult_pos x z) = (Rbar_mult_pos y z). Proof. case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ; split => //= H ; apply Rbar_finite_eq in H. by rewrite H. apply Rbar_finite_eq, (Rmult_eq_reg_r (z)) => // ; by apply Rgt_not_eq. Qed. Lemma Rbar_mult_pos_lt (x y : Rbar) (z : posreal) : Rbar_lt x y <-> Rbar_lt (Rbar_mult_pos x z) (Rbar_mult_pos y z). Proof. case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ; split => //= H. apply (Rmult_lt_compat_r (z)) => //. apply (Rmult_lt_reg_r (z)) => //. Qed. Lemma Rbar_mult_pos_le (x y : Rbar) (z : posreal) : Rbar_le x y <-> Rbar_le (Rbar_mult_pos x z) (Rbar_mult_pos y z). Proof. case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ; split => //= H. apply Rmult_le_compat_r with (2 := H). now apply Rlt_le. now apply Rmult_le_reg_r with (2 := H). Qed. (** Rbar_div_pos *) Lemma Rbar_div_pos_eq (x y : Rbar) (z : posreal) : x = y <-> (Rbar_div_pos x z) = (Rbar_div_pos y z). Proof. case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ; split => //= H ; apply Rbar_finite_eq in H. by rewrite H. apply Rbar_finite_eq, (Rmult_eq_reg_r (/z)) => // ; by apply Rgt_not_eq, Rinv_0_lt_compat. Qed. Lemma Rbar_div_pos_lt (x y : Rbar) (z : posreal) : Rbar_lt x y <-> Rbar_lt (Rbar_div_pos x z) (Rbar_div_pos y z). Proof. case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ; split => //= H. apply (Rmult_lt_compat_r (/z)) => // ; by apply Rinv_0_lt_compat. apply (Rmult_lt_reg_r (/z)) => // ; by apply Rinv_0_lt_compat. Qed. Lemma Rbar_div_pos_le (x y : Rbar) (z : posreal) : Rbar_le x y <-> Rbar_le (Rbar_div_pos x z) (Rbar_div_pos y z). Proof. case: z => z Hz ; case: x => [x | | ] ; case: y => [y | | ] ; split => //= H. apply Rmult_le_compat_r with (2 := H). now apply Rlt_le, Rinv_0_lt_compat. apply Rmult_le_reg_r with (2 := H). now apply Rinv_0_lt_compat. Qed. (** * Rbar_min *) Definition Rbar_min (x y : Rbar) : Rbar := match x, y with | z, p_infty | p_infty, z => z | _ , m_infty | m_infty, _ => m_infty | Finite x, Finite y => Rmin x y end. Lemma Rbar_lt_locally (a b : Rbar) (x : R) : Rbar_lt a x -> Rbar_lt x b -> exists delta : posreal, forall y, Rabs (y - x) < delta -> Rbar_lt a y /\ Rbar_lt y b. Proof. case: a => [ a /= Ha | | _ ] //= ; (try apply Rminus_lt_0 in Ha) ; case: b => [ b Hb | _ | ] //= ; (try apply Rminus_lt_0 in Hb). assert (0 < Rmin (x - a) (b - x)). by apply Rmin_case. exists (mkposreal _ H) => y /= Hy ; split. apply Rplus_lt_reg_r with (-x). replace (a+-x) with (-(x-a)) by ring. apply (Rabs_lt_between (y - x)). apply Rlt_le_trans with (1 := Hy). by apply Rmin_l. apply Rplus_lt_reg_r with (-x). apply (Rabs_lt_between (y - x)). apply Rlt_le_trans with (1 := Hy). by apply Rmin_r. exists (mkposreal _ Ha) => y /= Hy ; split => //. apply Rplus_lt_reg_r with (-x). replace (a+-x) with (-(x-a)) by ring. by apply (Rabs_lt_between (y - x)). exists (mkposreal _ Hb) => y /= Hy ; split => //. apply Rplus_lt_reg_r with (-x). by apply (Rabs_lt_between (y - x)). exists (mkposreal _ Rlt_0_1) ; by split. Qed. Lemma Rbar_min_comm (x y : Rbar) : Rbar_min x y = Rbar_min y x. Proof. case: x => [x | | ] //= ; case: y => [y | | ] //=. by rewrite Rmin_comm. Qed. Lemma Rbar_min_r (x y : Rbar) : Rbar_le (Rbar_min x y) y. Proof. case: x => [x | | ] //= ; case: y => [y | | ] //=. by apply Rmin_r. by apply Rle_refl. Qed. Lemma Rbar_min_l (x y : Rbar) : Rbar_le (Rbar_min x y) x. Proof. rewrite Rbar_min_comm. by apply Rbar_min_r. Qed. Lemma Rbar_min_case (x y : Rbar) (P : Rbar -> Type) : P x -> P y -> P (Rbar_min x y). Proof. case: x => [x | | ] //= ; case: y => [y | | ] //=. by apply Rmin_case. Qed. Lemma Rbar_min_case_strong (r1 r2 : Rbar) (P : Rbar -> Type) : (Rbar_le r1 r2 -> P r1) -> (Rbar_le r2 r1 -> P r2) -> P (Rbar_min r1 r2). Proof. case: r1 => [x | | ] //= ; case: r2 => [y | | ] //= Hx Hy ; (try by apply Hx) ; (try by apply Hy). by apply Rmin_case_strong. Qed. (** * Rbar_abs *) Definition Rbar_abs (x : Rbar) := match x with | Finite x => Finite (Rabs x) | _ => p_infty end. Lemma Rbar_abs_lt_between (x y : Rbar) : Rbar_lt (Rbar_abs x) y <-> (Rbar_lt (Rbar_opp y) x /\ Rbar_lt x y). Proof. case: x => [x | | ] ; case: y => [y | | ] /= ; try by intuition. by apply Rabs_lt_between. Qed. Lemma Rbar_abs_opp (x : Rbar) : Rbar_abs (Rbar_opp x) = Rbar_abs x. Proof. case: x => [x | | ] //=. by rewrite Rabs_Ropp. Qed. Lemma Rbar_abs_pos (x : Rbar) : Rbar_le 0 x -> Rbar_abs x = x. Proof. case: x => [x | | ] //= Hx. by apply f_equal, Rabs_pos_eq. Qed. Lemma Rbar_abs_neg (x : Rbar) : Rbar_le x 0 -> Rbar_abs x = Rbar_opp x. Proof. case: x => [x | | ] //= Hx. rewrite -Rabs_Ropp. apply f_equal, Rabs_pos_eq. now rewrite -Ropp_0 ; apply Ropp_le_contravar. Qed. coquelicot-coquelicot-3.4.1/theories/Rcomplements.v000066400000000000000000001450071455143432500225310ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) (** * This file describes basic missing facts about the standard library of reals and a few concerning ssreflect.seq. It also contains a definition of the [sign] function. *) (** Tactic for changing the last argument of a property to an evar, in order to apply theorems modulo equality. *) Ltac evar_last := match goal with | |- ?f ?x => let tx := type of x in let tx := eval simpl in tx in let tmp := fresh "tmp" in evar (tmp : tx) ; refine (@eq_ind tx tmp f _ x _) ; unfold tmp ; clear tmp end. From Coq Require Import Reals Psatz ssreflect. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). Module MyNat. Lemma neq_succ_0 (n : nat) : S n <> 0. Proof. move=> contrad. exact: (Nat.nle_succ_0 n). Qed. Lemma sub_succ (n m : nat) : S n - S m = n - m. Proof. done. Qed. Lemma sub_succ_l (n m : nat) : n <= m -> S m - n = S (m - n). Proof. move=> h. by rewrite <-Nat.sub_succ_l. Qed. Lemma lt_neq (n m : nat) : n < m -> n <> m. Proof. intros H ->. exact (Nat.lt_irrefl m H). Qed. Lemma minus_0_le (n m : nat) : n <= m -> n - m = 0. Proof. intros H%Nat.sub_0_le. exact H. Qed. Lemma sub_succ_r (n m : nat) : n - S m = pred (n - m). Proof. now apply Nat.sub_succ_r. Qed. Lemma sub_add (n m : nat) : n <= m -> m - n + n = m. Proof. now apply Nat.sub_add. Qed. Lemma le_pred_le_succ (n m : nat) : pred n <= m <-> n <= S m. Proof. now apply Nat.le_pred_le_succ. Qed. Lemma add_sub_add_l : forall n m p : nat, (n - m) = (p + n - (p + m)). Proof. intros n m p; induction p as [| p IH]. - by rewrite 2!Nat.add_0_l. - by rewrite 2!Nat.add_succ_l Nat.sub_succ IH. Qed. Lemma ind_0_1_SS : forall P: nat -> Prop, P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n. Proof. intros P H0 H1 H2. fix IH 1. intros [|[|n]] ; try assumption. apply H2, IH. Qed. (* NOTE: needed because MyNat.le_add_l was only introduced in Coq 8.17 (see * Coq.Numbers.Natural.Abstract.NAddOrder). This can go away and be replaced * by Nat.le_add_r once the minimal Coq supported version is >= 8.17. *) Lemma le_add_l : forall n m : nat, n <= m + n. Proof. intros n m; rewrite -{1}(Nat.add_0_l n); apply Nat.add_le_mono. - exact (Nat.le_0_l m). - exact (Nat.le_refl n). Qed. (* NOTE: When the minimal supported Coq version is >= 8.16, remove it and rename MyNat.Even_double into Nat.Even_double *) Lemma Even_double : forall n : nat, Nat.Even n -> n = Nat.double (Nat.div2 n). Proof. now intros n [k ->]; rewrite Nat.double_twice Nat.div2_double. Qed. (* NOTE: When the minimal supported Coq version is >= 8.16, remove it and rename MyNat.Odd_double into Nat.Odd_double *) Lemma Odd_double : forall n : nat, Nat.Odd n -> n = S (Nat.double (Nat.div2 n)). Proof. intros n [k ->]. now rewrite Nat.add_1_r Nat.div2_succ_double Nat.double_twice. Qed. (* NOTE: When the minimal supported Coq version is >= 8.16, remove it and rename MyNat.Odd_double into Nat.Odd_double *) Lemma Even_div2 : forall n : nat, Nat.Even n -> Nat.div2 n = Nat.div2 (S n). Proof. now intros n [k ->]; rewrite Nat.div2_double Nat.div2_succ_double. Qed. (* NOTE: When the minimal supported Coq version is >= 8.16, remove it and rename MyNat.Odd_div2 into Nat.Odd_div2 *) Lemma Odd_div2 : forall n : nat, Nat.Odd n -> S (Nat.div2 n) = Nat.div2 (S n). Proof. intros n [k ->]; rewrite Nat.add_1_r Nat.div2_succ_double. rewrite -(Nat.add_1_r (S (2 * k))) (Nat.add_succ_comm (2 * k)). rewrite -{2}(Nat.mul_1_r 2) -(Nat.mul_add_distr_l 2) Nat.add_succ_r. now rewrite Nat.add_0_r Nat.div2_double. Qed. (* NOTE: When the minimal supported Coq version is >= 8.16, remove it and rename MyNat.double_S into Nat.double_S *) Lemma double_S : forall n : nat, Nat.double (S n) = S (S (Nat.double n)). Proof. now intros n; unfold Nat.double; rewrite Nat.add_succ_r Nat.add_succ_l. Qed. End MyNat. From Coq Require Import ssrbool. From mathcomp Require Import seq. Open Scope R_scope. (** * Integers *) (** Integer part in Z *) Lemma floor_ex : forall x : R, {n : Z | IZR n <= x < IZR n + 1}. Proof. intros. exists (up (x-1)) ; split. assert (Rw : x = 1 + (x-1)) ; [ring | rewrite {2}Rw => {Rw}]. assert (Rw :IZR (up (x - 1)) = (IZR (up (x - 1)) - (x - 1)) + (x-1)) ; [ring | rewrite Rw ; clear Rw]. apply Rplus_le_compat_r, (proj2 (archimed _)). assert (Rw : x = (x-1) + 1) ; [ring | rewrite {1}Rw ; clear Rw]. apply Rplus_lt_compat_r, (proj1 (archimed _)). Qed. Definition floor x := proj1_sig (floor_ex x). Lemma floor1_ex : forall x : R, {n : Z | IZR n < x <= IZR n + 1}. Proof. intros. destruct (floor_ex x) as (n,(Hn1,Hn2)). destruct (Rle_lt_or_eq_dec (IZR n) x Hn1). exists n ; split. apply r. apply Rlt_le, Hn2. exists (Z.pred n) ; rewrite <- e ; split. apply IZR_lt, Zlt_pred. rewrite <- (succ_IZR), <-Zsucc_pred ; apply Rle_refl. Qed. Definition floor1 x := proj1_sig (floor1_ex x). (** Interger part in nat *) Lemma nfloor_ex : forall x : R, 0 <= x -> {n : nat | INR n <= x < INR n + 1}. Proof. intros. destruct (floor_ex x) as (m,Hm). destruct (Z_lt_le_dec m 0) as [z|z]. apply Zlt_le_succ in z. contradict z. apply Zlt_not_le. apply lt_IZR. apply Rle_lt_trans with (1 := H). rewrite succ_IZR ; apply Hm. destruct m. exists O ; apply Hm. exists (nat_of_P p). rewrite INR_IZR_INZ. rewrite <- Zpos_eq_Z_of_nat_o_nat_of_P. apply Hm. contradict z. apply Zlt_not_le. apply Zlt_neg_0. Qed. Definition nfloor x pr := proj1_sig (nfloor_ex x pr). Lemma nfloor1_ex : forall x : R, 0 < x -> {n : nat | INR n < x <= INR n + 1}. Proof. intros. destruct (nfloor_ex x (Rlt_le _ _ H)) as (n,(Hn1,Hn2)). destruct (Rle_lt_or_eq_dec (INR n) x Hn1). exists n ; split. apply r. apply Rlt_le, Hn2. destruct n. contradict H. rewrite <- e ; simpl ; apply Rlt_irrefl. exists n ; rewrite <- e ; split. apply lt_INR, Nat.lt_succ_diag_r. rewrite <- (S_INR) ; apply Rle_refl. Qed. Definition nfloor1 x pr := proj1_sig (nfloor1_ex x pr). (** More theorems about INR *) Lemma INRp1_pos : forall n, 0 < INR n + 1. Proof. intros N. rewrite <- S_INR. apply lt_0_INR. apply Nat.lt_0_succ. Qed. Lemma Rlt_nat (x : R) : (exists n : nat, x = INR (S n)) -> 0 < x. Proof. intro H ; destruct H. rewrite H S_INR. apply INRp1_pos. Qed. Lemma Rle_pow_lin (a : R) (n : nat) : 0 <= a -> 1 + INR n * a <= (1 + a) ^ n. Proof. intro Ha. induction n. apply Req_le ; simpl ; ring. rewrite S_INR. replace (1 + (INR n + 1) * a) with ((1 + INR n * a) + a) by ring. apply Rle_trans with ((1 + a) ^ n + a). apply Rplus_le_compat_r. exact IHn. replace ((1+a)^(S n)) with ((1+a)^n + a * (1+a)^n) by (simpl ; ring). apply Rplus_le_compat_l. pattern a at 1. rewrite <- (Rmult_1_r a). apply Rmult_le_compat_l. exact Ha. clear IHn. apply pow_R1_Rle. pattern 1 at 1. rewrite <- (Rplus_0_r 1). apply Rplus_le_compat_l. exact Ha. Qed. Lemma C_n_n: forall n, C n n = 1. Proof. intros n; unfold C. rewrite Nat.sub_diag. simpl. field. apply INR_fact_neq_0. Qed. Lemma C_n_0: forall n, C n 0 = 1. Proof. intros n; unfold C. rewrite Nat.sub_0_r. simpl. field. apply INR_fact_neq_0. Qed. Fixpoint pow2 (n : nat) : nat := match n with | O => 1%nat | S n => (2 * pow2 n)%nat end. Lemma pow2_INR (n : nat) : INR (pow2 n) = 2^n. Proof. elim: n => //= n IH ; rewrite ?plus_INR ?IH /= ; field. Qed. Lemma pow2_pos (n : nat) : (0 < pow2 n)%nat. Proof. apply INR_lt ; rewrite pow2_INR. apply pow_lt, Rlt_0_2. Qed. (** * Rinv *) Lemma Rinv_le_contravar : forall x y, 0 < x -> x <= y -> / y <= / x. Proof. intros x y H1 [H2|H2]. apply Rlt_le. apply Rinv_lt_contravar with (2 := H2). apply Rmult_lt_0_compat with (1 := H1). now apply Rlt_trans with x. rewrite H2. apply Rle_refl. Qed. Lemma Rinv_lt_cancel (x y : R) : 0 < y -> / y < / x -> x < y. Proof. intro Hy ; move/Rlt_not_le => Hxy. apply Rnot_le_lt ; contradict Hxy. by apply Rinv_le_contravar. Qed. (** * Rdiv *) (** Rewritings *) Lemma Rdiv_1 : forall x : R, x / 1 = x. Proof. intros. unfold Rdiv ; rewrite Rinv_1 Rmult_1_r. reflexivity. Qed. Lemma Rdiv_plus : forall a b c d : R, b <> 0 -> d <> 0 -> a / b + c / d = (a * d + c * b) / (b * d). Proof. intros. field. split. apply H0. apply H. Qed. Lemma Rdiv_minus : forall a b c d : R, b <> 0 -> d <> 0 -> a / b - c / d = (a * d - c * b) / (b * d). Proof. intros. field. split. apply H0. apply H. Qed. (** Order *) Lemma Rplus_lt_reg_l (x y z : R) : x + y < x + z -> y < z. Proof. first [ (* 8.4 *) exact: Rplus_lt_reg_r | (* 8.5 *) exact: Rplus_lt_reg_l ]. Qed. Lemma Rplus_lt_reg_r (x y z : R) : y + x < z + x -> y < z. Proof. first [ (* 8.4 *) intro H ; apply Rplus_lt_reg_r with x ; now rewrite 2!(Rplus_comm x) | (* 8.5 *) exact: Rplus_lt_reg_r ]. Qed. Lemma Rle_div_l : forall a b c, c > 0 -> (a / c <= b <-> a <= b * c). Proof. split ; intros. replace a with ((a/c) * c) by (field ; apply Rgt_not_eq, H). apply Rmult_le_compat_r. apply Rlt_le, H. apply H0. replace b with ((b*c)/c) by (field ; apply Rgt_not_eq, H). apply Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat, H. apply H0. Qed. Lemma Rle_div_r : forall a b c, c > 0 -> (a * c <= b <-> a <= b / c). Proof. split ; intros. replace a with ((a * c) / c) by (field ; apply Rgt_not_eq, H). apply Rmult_le_compat_r. apply Rlt_le, Rinv_0_lt_compat, H. apply H0. replace b with ((b / c) * c) by (field ; apply Rgt_not_eq, H). apply Rmult_le_compat_r. apply Rlt_le, H. apply H0. Qed. Lemma Rlt_div_l : forall a b c, c > 0 -> (a / c < b <-> a < b*c). Proof. split ; intros. replace a with ((a/c) * c) by (field ; apply Rgt_not_eq, H). apply Rmult_lt_compat_r. apply H. apply H0. replace b with ((b*c)/c) by (field ; apply Rgt_not_eq, H). apply Rmult_lt_compat_r. apply Rinv_0_lt_compat, H. apply H0. Qed. Lemma Rlt_div_r : forall a b c, c > 0 -> (a * c < b <-> a < b / c). Proof. split ; intros. replace a with ((a * c) / c) by (field ; apply Rgt_not_eq, H). apply Rmult_lt_compat_r. apply Rinv_0_lt_compat, H. apply H0. replace b with ((b / c) * c) by (field ; apply Rgt_not_eq, H). apply Rmult_lt_compat_r. apply H. apply H0. Qed. Lemma Rdiv_lt_0_compat : forall r1 r2 : R, 0 < r1 -> 0 < r2 -> 0 < r1 / r2. Proof. intros r1 r2 H1 H2. apply Rlt_div_r. apply H2. rewrite Rmult_0_l. apply H1. Qed. Lemma Rdiv_le_0_compat : forall r1 r2 : R, 0 <= r1 -> 0 < r2 -> 0 <= r1 / r2. Proof. intros. apply Rle_div_r. apply H0. rewrite Rmult_0_l. apply H. Qed. Lemma Rdiv_lt_1 : forall r1 r2, 0 < r2 -> (r1 < r2 <-> r1 / r2 < 1). Proof. intros. pattern r2 at 1. rewrite <- (Rmult_1_l r2). split ; apply Rlt_div_l ; apply H. Qed. Lemma Rdiv_le_1 : forall r1 r2, 0 < r2 -> (r1 <= r2 <-> r1/r2 <= 1). Proof. intros. pattern r2 at 1. rewrite <- (Rmult_1_l r2). split ; apply Rle_div_l ; apply H. Qed. (** * Rmult *) Lemma Rle_mult_Rlt : forall c a b : R, 0 < b -> c < 1 -> a <= b*c -> a < b. Proof. intros. apply Rle_lt_trans with (1 := H1). pattern b at 2 ; rewrite <-(Rmult_1_r b). apply Rmult_lt_compat_l ; auto. Qed. Lemma Rmult_le_0_r : forall a b, a <= 0 -> 0 <= b -> a * b <= 0. Proof. intros ; rewrite <-(Rmult_0_r a) ; apply (Rmult_le_compat_neg_l a 0 b) with (1 := H) ; auto. Qed. Lemma Rmult_le_0_l : forall a b, 0 <= a -> b <= 0 -> a * b <= 0. Proof. intros ; rewrite Rmult_comm ; apply Rmult_le_0_r ; auto. Qed. Lemma pow2_gt_0 (x : R) : x <> 0 -> 0 < x ^ 2. Proof. destruct (pow2_ge_0 x) => // Hx. contradict Hx. apply sym_eq, Rmult_integral in H ; case: H => // H. apply Rmult_integral in H ; case: H => // H. contradict H ; apply Rgt_not_eq, Rlt_0_1. Qed. (** * Rminus *) (** Rewritings *) Lemma Rminus_eq_0 : forall r : R, r - r = 0. Proof. intros. ring. Qed. Lemma Rdiv_minus_distr : forall a b c, b <> 0 -> a / b - c = (a - b * c) / b. Proof. intros. field. apply H. Qed. Lemma Rmult_minus_distr_r: forall r1 r2 r3 : R, (r1 - r2) * r3 = r1 * r3 - r2 * r3. Proof. intros. unfold Rminus. rewrite <- Ropp_mult_distr_l_reverse. apply Rmult_plus_distr_r. Qed. Lemma Rminus_eq_compat_l : forall r r1 r2 : R, r1 = r2 <-> r - r1 = r - r2. Proof. split ; intros. apply Rplus_eq_compat_l. rewrite H. reflexivity. replace r1 with (r-(r-r1)) by ring. replace r2 with (r-(r-r2)) by ring. apply Rplus_eq_compat_l. rewrite H. reflexivity. Qed. Lemma Ropp_plus_minus_distr : forall r1 r2 : R, - (r1 + r2) = - r1 - r2. Proof. intros. unfold Rminus. apply Ropp_plus_distr. Qed. (** Order *) Lemma Rle_minus_l : forall a b c,(a - c <= b <-> a <= b + c). Proof. split ; intros. replace a with ((a-c)+c) by ring. apply Rplus_le_compat_r. apply H. replace b with ((b+c)-c) by ring. apply Rplus_le_compat_r. apply H. Qed. Lemma Rlt_minus_r : forall a b c,(a < b - c <-> a + c < b). Proof. split ; intros. replace b with ((b-c)+c) by ring. apply Rplus_lt_compat_r. apply H. replace a with ((a+c)-c) by ring. apply Rplus_lt_compat_r. apply H. Qed. Lemma Rlt_minus_l : forall a b c,(a - c < b <-> a < b + c). Proof. split ; intros. replace a with ((a-c)+c) by ring. apply Rplus_lt_compat_r. apply H. replace b with ((b+c)-c) by ring. apply Rplus_lt_compat_r. apply H. Qed. Lemma Rle_minus_r : forall a b c,(a <= b - c <-> a + c <= b). Proof. split ; intros. replace b with ((b-c)+c) by ring. apply Rplus_le_compat_r. apply H. replace a with ((a+c)-c) by ring. apply Rplus_le_compat_r. apply H. Qed. Lemma Rminus_le_0 : forall a b, a <= b <-> 0 <= b - a. Proof. intros. pattern a at 1. rewrite <- (Rplus_0_l a). split ; apply Rle_minus_r. Qed. Lemma Rminus_lt_0 : forall a b, a < b <-> 0 < b - a. Proof. Proof. intros. pattern a at 1. rewrite <- (Rplus_0_l a). split ; apply Rlt_minus_r. Qed. (** * Rplus *) (** Sums *) Lemma sum_f_rw (a : nat -> R) (n m : nat) : (n < m)%nat -> sum_f (S n) m a = sum_f_R0 a m - sum_f_R0 a n. Proof. intro Hnm ; unfold sum_f. revert a n Hnm. induction m ; intros a n Hnm. apply Nat.nlt_0_r in Hnm ; intuition. rewrite (decomp_sum _ _ (Nat.lt_0_succ _)) ; simpl. revert Hnm ; destruct n ; intro Hnm. rewrite Nat.sub_0_r ; simpl ; ring_simplify. clear Hnm IHm. induction m ; simpl. reflexivity. rewrite <- plus_n_Sm, Nat.add_0_r, IHm ; reflexivity. rewrite (decomp_sum _ _ (Nat.lt_0_succ _)) ; simpl ; ring_simplify. apply <-Nat.succ_lt_mono in Hnm. rewrite <- (IHm _ _ Hnm). clear IHm. induction (m - S n)%nat ; simpl. reflexivity. rewrite <- plus_n_Sm, IHn0 ; reflexivity. Qed. Lemma sum_f_rw_0 (u : nat -> R) (n : nat) : sum_f O n u = sum_f_R0 u n. Proof. rewrite /sum_f Nat.sub_0_r. elim: n => [ | n IH] //. rewrite /sum_f_R0 -/sum_f_R0 //. by rewrite Nat.add_0_r IH. Qed. Lemma sum_f_n_Sm (u : nat -> R) (n m : nat) : (n <= m)%nat -> sum_f n (S m) u = sum_f n m u + u (S m). Proof. move => H. rewrite /sum_f Nat.sub_succ_l // /sum_f_R0 -/sum_f_R0. rewrite plus_Sn_m. by rewrite MyNat.sub_add. Qed. Lemma sum_f_u_Sk (u : nat -> R) (n m : nat) : (n <= m)%nat -> sum_f (S n) (S m) u = sum_f n m (fun k => u (S k)). Proof. move => H ; rewrite /sum_f. simpl minus. elim: (m - n)%nat => [ | k IH] //=. rewrite IH ; repeat apply f_equal. by rewrite plus_n_Sm. Qed. Lemma sum_f_u_add (u : nat -> R) (p n m : nat) : (n <= m)%nat -> sum_f (n + p)%nat (m + p)%nat u = sum_f n m (fun k => u (k + p)%nat). Proof. move => H ; rewrite /sum_f. rewrite ?(Nat.add_comm _ p) -MyNat.add_sub_add_l. elim: (m - n)%nat => [ | k IH] //=. by rewrite Nat.add_comm. rewrite IH ; repeat apply f_equal. ring. Qed. Lemma sum_f_Sn_m (u : nat -> R) (n m : nat) : (n < m)%nat -> sum_f (S n) m u = sum_f n m u - u n. Proof. move => H. elim: m n H => [ | m IH] // n H. by apply Nat.nlt_0_r in H. rewrite sum_f_u_Sk ; try by intuition. rewrite sum_f_n_Sm ; try by intuition. replace (sum_f n m u + u (S m) - u n) with ((sum_f n m u - u n) + u (S m)) by ring. apply (proj1 (Nat.lt_succ_r _ _)), le_lt_eq_dec in H. case: H => [ H | -> {n} ] //. rewrite -IH => //. rewrite /sum_f ; simpl. rewrite MyNat.sub_succ_r. apply lt_minus_O_lt in H. rewrite -{3}(MyNat.sub_add n m) ; try by intuition. case: (m-n)%nat H => {IH} [ | k] //= H. by apply Nat.nlt_0_r in H. apply (f_equal (fun y => y + _)). elim: k {H} => [ | k IH] //. rewrite /sum_f_R0 -/sum_f_R0 IH ; repeat apply f_equal ; intuition. rewrite /sum_f Nat.sub_diag /= ; ring. Qed. Lemma sum_f_R0_skip (u : nat -> R) (n : nat) : sum_f_R0 (fun k => u (n - k)%nat) n = sum_f_R0 u n. Proof. suff H : forall n m, (n < m)%nat -> sum_f n m (fun k => u ((m - k) + n)%nat) = sum_f n m u. case: n => [ | n] //. move: (H _ _ (Nat.lt_0_succ n)) => {} H. rewrite /sum_f in H. transitivity (sum_f_R0 (fun x : nat => u (S n - (x + 0) + 0)%nat) (S n - 0)). replace (S n - 0)%nat with (S n) by auto. elim: {2 4}(S n) => [ | m IH] //. simpl ; by rewrite Nat.add_0_r. rewrite /sum_f_R0 -/sum_f_R0 -IH. apply f_equal. by rewrite ?Nat.add_0_r. rewrite H. replace (S n - 0)%nat with (S n) by auto. elim: (S n) => [ | m IH] //. rewrite /sum_f_R0 -/sum_f_R0 -IH. apply f_equal. by rewrite Nat.add_0_r. move => {} n m H. elim: m u H => [ | m IH] u H //. apply (proj1 (Nat.lt_succ_r _ _)), le_lt_eq_dec in H ; case: H IH => [H IH | -> _ {n}] //. rewrite sum_f_n_Sm ; try by intuition. replace (sum_f n (S m) u) with (sum_f n (S m) u - u n + u n) by ring. rewrite -sum_f_Sn_m ; try by intuition. rewrite sum_f_u_Sk ; try by intuition. rewrite -(IH (fun k => u (S k))) => {IH} ; try by intuition. apply f_equal2. rewrite /sum_f. elim: {1 3 4}(m - n)%nat (Nat.le_refl (m-n)%nat) => [ | k IH] // Hk ; rewrite /sum_f_R0 -/sum_f_R0. apply f_equal. rewrite Nat.add_0_l MyNat.sub_add ; intuition. rewrite IH ; try by intuition. by rewrite Nat.sub_diag Nat.add_0_l. rewrite /sum_f. rewrite Nat.sub_succ_l ; try by intuition. rewrite Nat.sub_diag. rewrite /sum_f_R0 -/sum_f_R0. replace (1+m)%nat with (S m) by ring. rewrite Nat.add_0_l Nat.sub_diag MyNat.sub_add ; intuition. Qed. Lemma sum_f_chasles (u : nat -> R) (n m k : nat) : (n < m)%nat -> (m < k)%nat -> sum_f (S n) k u = sum_f (S n) m u + sum_f (S m) k u. Proof. move => Hnm Hmk. rewrite ?sum_f_rw //. ring. by apply Nat.lt_trans with m. Qed. (** * Rmin and Rmax *) (** Rewritings *) Lemma Rplus_max_distr_l : forall a b c, a + Rmax b c = Rmax (a + b) (a + c). Proof. intros a b c. unfold Rmax. case Rle_dec ; intros H ; case Rle_dec ; intros H' ; try easy. elim H'. apply Rplus_le_compat_l with (1 := H). elim H. apply Rplus_le_reg_l with (1 := H'). Qed. Lemma Rplus_max_distr_r : forall a b c, Rmax b c + a = Rmax (b + a) (c + a). Proof. intros a b c. rewrite <- 3!(Rplus_comm a). apply Rplus_max_distr_l. Qed. Lemma Rplus_min_distr_l : forall a b c, a + Rmin b c = Rmin (a + b) (a + c). Proof. intros a b c. unfold Rmin. case Rle_dec ; intros H ; case Rle_dec ; intros H' ; try easy. elim H'. apply Rplus_le_compat_l with (1 := H). elim H. apply Rplus_le_reg_l with (1 := H'). Qed. Lemma Rplus_min_distr_r : forall a b c, Rmin b c + a = Rmin (b + a) (c + a). Proof. intros a b c. rewrite <- 3!(Rplus_comm a). apply Rplus_min_distr_l. Qed. Lemma Rmult_max_distr_l : forall a b c, 0 <= a -> a * Rmax b c = Rmax (a * b) (a * c). Proof. intros a b c Ha. destruct Ha as [Ha|Ha]. unfold Rmax. case Rle_dec ; intros H. apply (Rmult_le_compat_l _ _ _ (Rlt_le _ _ Ha)) in H. case Rle_dec ; intuition. apply Rnot_le_lt, (Rmult_lt_compat_l _ _ _ Ha), Rlt_not_le in H. case Rle_dec ; intuition. rewrite <- Ha ; clear a Ha. repeat rewrite Rmult_0_l. unfold Rmax ; assert (H := Rle_refl 0). case Rle_dec ; intuition. Qed. Lemma Rmult_max_distr_r : forall a b c, 0 <= a -> Rmax b c * a = Rmax (b * a) (c * a). Proof. intros a b c. rewrite <- 3!(Rmult_comm a). apply Rmult_max_distr_l. Qed. Lemma Rmult_min_distr_l : forall a b c, 0 <= a -> a * Rmin b c = Rmin (a * b) (a * c). Proof. intros a b c Ha. destruct Ha as [Ha|Ha]. unfold Rmin. case Rle_dec ; intros H. apply (Rmult_le_compat_l _ _ _ (Rlt_le _ _ Ha)) in H. case Rle_dec ; intuition. apply Rnot_le_lt, (Rmult_lt_compat_l _ _ _ Ha), Rlt_not_le in H. case Rle_dec ; intuition. rewrite <- Ha ; clear a Ha. repeat rewrite Rmult_0_l. unfold Rmin ; assert (H := Rle_refl 0). case Rle_dec ; intuition. Qed. Lemma Rmult_min_distr_r : forall a b c, 0 <= a -> Rmin b c * a = Rmin (b * a) (c * a). Proof. intros a b c. rewrite <- 3!(Rmult_comm a). apply Rmult_min_distr_l. Qed. Lemma Rmin_assoc : forall x y z, Rmin x (Rmin y z) = Rmin (Rmin x y) z. intros x y z; unfold Rmin. destruct (Rle_dec y z); destruct (Rle_dec x y); destruct (Rle_dec x z); destruct (Rle_dec y z) ; try intuition. contradict n. apply Rle_trans with y ; auto. contradict r. apply Rlt_not_le, Rlt_trans with y ; apply Rnot_le_lt ; auto. Qed. Lemma Rmax_assoc : forall x y z, Rmax x (Rmax y z) = Rmax (Rmax x y) z. intros x y z; unfold Rmax. destruct (Rle_dec y z); destruct (Rle_dec x y); destruct (Rle_dec x z); destruct (Rle_dec y z) ; try intuition. contradict n. apply Rle_trans with y ; auto. contradict r. apply Rlt_not_le, Rlt_trans with y ; apply Rnot_le_lt ; auto. Qed. (** Order *) Lemma Rmax_le_compat : forall a b c d, a <= b -> c <= d -> Rmax a c <= Rmax b d. Proof. intros. unfold Rmax. destruct (Rle_dec a c). destruct (Rle_dec b d). apply H0. apply Rnot_le_lt in n. apply (Rle_trans _ d). apply H0. apply (Rlt_le _ _ n). destruct (Rle_dec b d). apply (Rle_trans _ b). apply H. apply r. apply H. Qed. Lemma Rmax_opp_Rmin : forall a b, Rmax (-a) (-b) = - Rmin a b. Proof. intros. destruct (Rle_or_lt a b). rewrite Rmax_left. rewrite Rmin_left. reflexivity. apply H. apply Ropp_le_contravar. apply H. rewrite Rmax_right. rewrite Rmin_right. reflexivity. apply Rlt_le, H. apply Ropp_le_contravar. apply Rlt_le. apply H. Qed. Lemma Rmin_opp_Rmax : forall a b, Rmin (-a) (-b) = - Rmax a b. Proof. intros. rewrite Rmax_comm. unfold Rmin ; case Rle_dec ; intro Hab. apply Ropp_le_cancel in Hab. unfold Rmax ; case Rle_dec ; intuition. apply Rnot_le_lt, Ropp_lt_cancel, Rlt_not_le in Hab. unfold Rmax ; case Rle_dec ; intuition. Qed. Lemma Rmax_mult : forall a b c, 0 <= c -> Rmax a b * c = Rmax (a * c) (b * c). Proof. intros. repeat rewrite (Rmult_comm _ c). apply sym_eq. apply RmaxRmult. apply H. Qed. Lemma Rmax_le_Rplus : forall a b : R, 0 <= a -> 0 <= b -> Rmax a b <= a + b. Proof. intros. destruct (Rle_lt_dec a b). rewrite <- (Rplus_0_l (Rmax a b)). rewrite Rmax_right. apply Rplus_le_compat_r. apply H. apply r. rewrite <- (Rplus_0_r (Rmax a b)). rewrite Rmax_left. apply Rplus_le_compat_l. apply H0. apply Rlt_le, r. Qed. Lemma Rplus_le_Rmax : forall a b : R, a + b <= 2*Rmax a b. Proof. intros. rewrite RIneq.double. destruct (Rle_lt_dec a b). rewrite Rmax_right. apply Rplus_le_compat_r. apply r. apply r. rewrite Rmax_left. apply Rplus_le_compat_l. apply Rlt_le. apply r. apply Rlt_le, r. Qed. Lemma Rmin_Rmax_l : forall a b, Rmin a b <= a <= Rmax a b. Proof. split. apply Rmin_l. apply RmaxLess1. Qed. Lemma Rmin_Rmax_r : forall a b, Rmin a b <= b <= Rmax a b. Proof. split. apply Rmin_r. apply RmaxLess2. Qed. Lemma Rmin_Rmax : forall a b, Rmin a b <= Rmax a b. Proof. intros. apply Rle_trans with a; apply Rmin_Rmax_l. Qed. (** * Rabs *) (** Rewritings *) Lemma Rabs_div : forall a b : R, b <> 0 -> Rabs (a/b) = (Rabs a) / (Rabs b). Proof. intros. unfold Rdiv. rewrite Rabs_mult. rewrite Rabs_Rinv. reflexivity. apply H. Qed. Lemma Rabs_eq_0 : forall x, Rabs x = 0 -> x = 0. Proof. intros. unfold Rabs in H. destruct Rcase_abs. rewrite <- (Ropp_involutive x). apply Ropp_eq_0_compat. apply H. apply H. Qed. (** Order *) Lemma Rabs_le_between : forall x y, (Rabs x <= y <-> -y <= x <= y). Proof. split. split. rewrite <-(Ropp_involutive x). apply Ropp_le_contravar. apply (Rle_trans _ (Rabs x)). rewrite <-Rabs_Ropp. apply RRle_abs. apply H. apply (Rle_trans _ (Rabs x)). apply RRle_abs. apply H. intros. unfold Rabs. destruct (Rcase_abs x). rewrite <-(Ropp_involutive y). apply Ropp_le_contravar. apply H. apply H. Qed. Lemma Rabs_le_between' : forall x y z, Rabs (x - y) <= z <-> y-z <= x <= y+z. Proof. split ; intros. cut (-z <= x-y <= z). intros ; split. rewrite <- (Rplus_0_l x). rewrite <-(Rplus_opp_r y). rewrite Rplus_assoc. apply Rplus_le_compat_l. rewrite Rplus_comm. apply H0. rewrite <- (Rplus_0_l x). rewrite <-(Rplus_opp_r y). rewrite Rplus_assoc. apply Rplus_le_compat_l. rewrite Rplus_comm. apply H0. apply (Rabs_le_between (x-y) z). apply H. apply (Rabs_le_between (x-y) z). split. rewrite <- (Rplus_0_r (-z)). rewrite <-(Rplus_opp_r y). rewrite <- Rplus_assoc. apply Rplus_le_compat_r. rewrite Rplus_comm. apply H. rewrite <- (Rplus_0_r z). rewrite <-(Rplus_opp_r y). rewrite <- Rplus_assoc. apply Rplus_le_compat_r. rewrite Rplus_comm. apply H. Qed. Lemma Rabs_lt_between : forall x y, (Rabs x < y <-> -y < x < y). Proof. split. intros; split; now apply Rabs_def2. intros (H1,H2); now apply Rabs_def1. Qed. Lemma Rabs_lt_between' : forall x y z, Rabs (x - y) < z <-> y-z < x < y+z. Proof. split ; intros. cut (-z < x-y < z). intros ; split. rewrite <- (Rplus_0_l x). rewrite <-(Rplus_opp_r y). rewrite Rplus_assoc. apply Rplus_lt_compat_l. rewrite Rplus_comm. apply H0. rewrite <- (Rplus_0_l x). rewrite <-(Rplus_opp_r y). rewrite Rplus_assoc. apply Rplus_lt_compat_l. rewrite Rplus_comm. apply H0. apply (Rabs_lt_between (x-y) z). apply H. apply (Rabs_lt_between (x-y) z). split. rewrite <- (Rplus_0_r (-z)). rewrite <-(Rplus_opp_r y). rewrite <- Rplus_assoc. apply Rplus_lt_compat_r. rewrite Rplus_comm. apply H. rewrite <- (Rplus_0_r z). rewrite <-(Rplus_opp_r y). rewrite <- Rplus_assoc. apply Rplus_lt_compat_r. rewrite Rplus_comm. apply H. Qed. Lemma Rabs_le_between_min_max : forall x y z, Rmin x y <= z <= Rmax x y -> Rabs (z - y) <= Rabs (x - y). Proof. intros x y z H. case (Rle_or_lt x y); intros H'. (* *) rewrite Rmin_left in H;[idtac|exact H']. rewrite Rmax_right in H;[idtac|exact H']. rewrite Rabs_left1. rewrite Rabs_left1. apply Ropp_le_contravar. apply Rplus_le_compat_r. apply H. apply Rle_minus; exact H'. apply Rle_minus; apply H. (* *) rewrite Rmin_right in H;[idtac|left; exact H']. rewrite Rmax_left in H;[idtac|left; exact H']. rewrite Rabs_right. rewrite Rabs_right. apply Rplus_le_compat_r. apply H. apply Rge_minus; left; apply H'. apply Rge_minus, Rle_ge; apply H. Qed. Lemma Rabs_le_between_Rmax : forall x m M, m <= x <= M -> Rabs x <= Rmax M (-m). Proof. intros x m M Hx. unfold Rabs ; destruct Rcase_abs as [H|H]. apply Rle_trans with (2 := RmaxLess2 _ _). apply Ropp_le_contravar, Hx. apply Rle_trans with (2 := RmaxLess1 _ _). apply Hx. Qed. Lemma Rabs_lt_between_Rmax : forall x m M, m < x < M -> Rabs x < Rmax M (-m). Proof. intros x m M Hx. unfold Rabs ; destruct Rcase_abs as [H|H]. apply Rlt_le_trans with (2 := RmaxLess2 _ _). apply Ropp_lt_contravar, Hx. apply Rlt_le_trans with (2 := RmaxLess1 _ _). apply Hx. Qed. Lemma Rabs_maj2 : forall x, -x <= Rabs x. Proof. intros. rewrite <- Rabs_Ropp. apply Rle_abs. Qed. (** * Req *) Lemma Req_lt_aux : forall x y, (forall eps : posreal, Rabs (x - y) < eps) -> x = y. Proof. intros. apply Rminus_diag_uniq. apply Rabs_eq_0. apply Rle_antisym. apply le_epsilon. intros. rewrite Rplus_0_l. apply Rlt_le. apply (H (mkposreal eps H0)). apply Rabs_pos. Qed. Lemma Req_le_aux : forall x y, (forall eps : posreal, Rabs (x - y) <= eps) -> x = y. Proof. intros. apply Rminus_diag_uniq. apply Rabs_eq_0. apply Rle_antisym. apply le_epsilon. intros. rewrite Rplus_0_l. apply (H (mkposreal eps H0)). apply Rabs_pos. Qed. (** * posreal *) Lemma is_pos_div_2 (eps : posreal) : 0 < eps / 2. Proof. unfold Rdiv ; apply Rmult_lt_0_compat ; [apply eps | apply Rinv_0_lt_compat, Rlt_0_2]. Qed. Definition pos_div_2 (eps : posreal) := mkposreal _ (is_pos_div_2 eps). (** * The sign function *) Definition sign (x : R) := match total_order_T 0 x with | inleft (left _) => 1 | inleft (right _) => 0 | inright _ => -1 end. Lemma sign_0 : sign 0 = 0. Proof. unfold sign. case total_order_T as [[H|H]|H]. elim (Rlt_irrefl _ H). exact H. elim (Rlt_irrefl _ H). Qed. Lemma sign_opp (x : R) : sign (-x) = - sign x. Proof. unfold sign. case total_order_T as [[H|H]|H] ; case total_order_T as [[H'|H']|H'] ; lra. Qed. Lemma sign_eq_1 (x : R) : 0 < x -> sign x = 1. Proof. intros Hx. unfold sign. case total_order_T as [[H|H]|H] ; lra. Qed. Lemma sign_eq_m1 (x : R) : x < 0 -> sign x = -1. Proof. intros Hx. unfold sign. case total_order_T as [[H|H]|H] ; lra. Qed. Lemma sign_le (x y : R) : x <= y -> sign x <= sign y. Proof. intros Hx. unfold sign. case total_order_T as [[H|H]|H] ; case total_order_T as [[H'|H']|H'] ; lra. Qed. Lemma sign_ge_0 (x : R) : 0 <= x -> 0 <= sign x. Proof. intros Hx. rewrite <- sign_0. now apply sign_le. Qed. Lemma sign_le_0 (x : R) : x <= 0 -> sign x <= 0. Proof. intros Hx. rewrite <- sign_0. now apply sign_le. Qed. Lemma sign_neq_0 (x : R) : x <> 0 -> sign x <> 0. Proof. intros Hx. unfold sign. case total_order_T as [[H|H]|H] ; lra. Qed. Lemma sign_mult (x y : R) : sign (x * y) = sign x * sign y. Proof. wlog: x / (0 < x) => [Hw | Hx]. case: (Rle_lt_dec 0 x) => Hx. case: Hx => Hx. by apply Hw. rewrite -Hx Rmult_0_l. rewrite sign_0. by rewrite Rmult_0_l. rewrite -(Ropp_involutive x). rewrite sign_opp Ropp_mult_distr_l_reverse sign_opp Hw. ring. by apply Ropp_0_gt_lt_contravar. wlog: y / (0 < y) => [Hw | Hy]. case: (Rle_lt_dec 0 y) => Hy. case: Hy => Hy. by apply Hw. rewrite -Hy Rmult_0_r. rewrite sign_0. by rewrite Rmult_0_r. rewrite -(Ropp_involutive y). rewrite sign_opp Ropp_mult_distr_r_reverse sign_opp Hw. ring. by apply Ropp_0_gt_lt_contravar. have Hxy : 0 < x * y. by apply Rmult_lt_0_compat. rewrite -> 3!sign_eq_1 by easy. by rewrite Rmult_1_l. Qed. Lemma sign_min_max (a b : R) : sign (b - a) * (Rmax a b - Rmin a b) = b - a. Proof. unfold sign. case total_order_T as [[H|H]|H]. assert (K := proj2 (Rminus_le_0 a b) (Rlt_le _ _ H)). rewrite (Rmax_right _ _ K) (Rmin_left _ _ K). apply Rmult_1_l. rewrite -H. apply Rmult_0_l. assert (K : b <= a). apply Rnot_lt_le. contradict H. apply Rle_not_lt. apply -> Rminus_le_0. now apply Rlt_le. rewrite (Rmax_left _ _ K) (Rmin_right _ _ K). ring. Qed. Lemma sum_INR : forall n, sum_f_R0 INR n = INR n * (INR n + 1) / 2. Proof. elim => [ | n IH] ; rewrite /sum_f_R0 -/sum_f_R0 ?S_INR /=. rewrite /Rdiv ; ring. rewrite IH ; field. Qed. (** * ssreflect.seq *) (** Finite subdivision *) Module ssrnat_eqType. Import eqtype ssrnat. Definition ssrnat_eqType := [the eqType of nat : Type]. End ssrnat_eqType. Export ssrnat_eqType. Lemma interval_finite_subdiv (a b : R) (eps : posreal) : (a <= b) -> {l : seq R | head 0 l = a /\ last 0 l = b /\ forall i, (S i < size l)%nat -> nth 0 l i < nth 0 l (S i) <= nth 0 l i + eps}. Proof. move => Hab. suff Hn : 0 <= (b - a) / eps. set n : nat := nfloor ((b - a) / eps) Hn. case: (Req_EM_T (INR n) ((b - a) / eps)) => Hdec. set l : seq R := mkseq (fun k => a + INR k * eps) (S n). exists l. split. simpl ; rewrite /Rdiv ; ring. split. replace b with (a + INR n * eps). simpl. rewrite (last_map (fun k => a + INR k * eps) _ O) /=. rewrite (last_nth O) size_iota /=. case H : n => [ | m]. by simpl. by rewrite /nth -/(nth _ _ m) nth_iota. rewrite Hdec ; field. by apply Rgt_not_eq, eps. move => i Hi ; rewrite size_mkseq in Hi. split. rewrite ?nth_mkseq //. rewrite S_INR Rminus_lt_0 ; ring_simplify. by apply eps. elim: (S n) (S i) Hi => /= [ | m IH] ; case => /= [ | j] Hj //. by apply Nat.lt_irrefl in Hj. by apply Nat.nlt_0_r in Hj. by apply IH, Nat.succ_lt_mono. elim: (S n) (S i) Hi => /= [ | m IH] ; case => /= [ | j] Hj //. by apply Nat.nlt_0_r in Hj. by apply IH, Nat.succ_lt_mono. rewrite ?nth_mkseq //. rewrite S_INR Rminus_le_0 ; ring_simplify. by apply Rle_refl. elim: (S n) (S i) Hi => /= [ | m IH] ; case => /= [ | j] Hj //. by apply Nat.nlt_0_r in Hj. by apply IH, Nat.succ_lt_mono. elim: (S n) (S i) Hi => /= [ | m IH] ; case => /= [ | j] Hj //. by apply Nat.nlt_0_r in Hj. by apply Nat.nlt_0_r in Hj. by apply IH, Nat.succ_lt_mono. set l : seq R := rcons (mkseq (fun k => a + INR k * eps) (S n)) b. exists l. split. simpl ; rewrite /Rdiv ; ring. split. simpl ; by rewrite last_rcons. move => i Hi ; rewrite size_rcons size_mkseq in Hi ; apply (proj1 (Nat.lt_succ_r _ _)), le_S_n in Hi. split. rewrite ?nth_rcons size_mkseq. have H : ssrnat.leq (S i) (S n) = true. apply le_n_S in Hi ; elim: (S i) (S n) Hi => //= j IH ; case => //= [ | m] Hi. by apply Nat.nle_succ_0 in Hi. apply IH ; by apply le_S_n. case: (ssrnat.leq (S i) (S n)) (H) => // _. case H0 : (ssrnat.leq (S (S i)) (S n)) => //. rewrite ?nth_mkseq //. rewrite S_INR Rminus_lt_0 ; ring_simplify. by apply eps. apply (f_equal negb) in H0 ; simpl in H0. rewrite -ssrnat.leqNgt in H0. case H1 : (@eqtype.eq_op ssrnat_eqType (S i) (S n)) => //. rewrite ssrnat.eqSS /= in H1. replace i with n. rewrite nth_mkseq => //. move: Hdec ; rewrite /n /nfloor. case: nfloor_ex => {Hn l Hi H H0 H1} n Hn /= Hdec. rewrite Rplus_comm ; apply Rlt_minus_r. apply Rlt_div_r. by apply eps. case: Hn => Hn _ ; case: Hn => // Hn. elim: n i H1 {Hi H H0 l Hdec} => [ | n IH] ; case => [ | i] // H. apply f_equal, IH ; intuition. by rewrite ssrnat.eqn_leq H H0 in H1. rewrite ?nth_rcons size_mkseq. have H : ssrnat.leq (S i) (S n) = true. apply le_n_S in Hi ; elim: (S i) (S n) Hi => //= j IH ; case => //= [ | m] Hi. by apply Nat.nle_succ_0 in Hi. apply IH ; by apply le_S_n. case: (ssrnat.leq (S i) (S n)) (H) => // _. case H0 : (ssrnat.leq (S (S i)) (S n)) => //. rewrite ?nth_mkseq //. rewrite S_INR Rminus_le_0 ; ring_simplify. by apply Rle_refl. apply (f_equal negb) in H0 ; simpl in H0. rewrite -ssrnat.leqNgt in H0. case H1 : (@eqtype.eq_op ssrnat_eqType (S i) (S n)) => //. rewrite ssrnat.eqSS /= in H1. replace i with n. rewrite nth_mkseq => //. move: Hdec ; rewrite /n /nfloor. case: nfloor_ex => {Hn l Hi H H0 H1} n Hn /= Hdec. rewrite Rplus_assoc Rplus_comm ; apply Rle_minus_l. replace (INR n * eps + eps) with ((INR n + 1) * eps) by ring. apply Rle_div_l. by apply eps. by apply Rlt_le, Hn. elim: n i H1 {Hi H H0 l Hdec} => [ | n IH] ; case => [ | i] // H. apply f_equal, IH ; intuition. by rewrite ssrnat.eqn_leq H H0 in H1. apply Rdiv_le_0_compat. by apply Rminus_le_0 in Hab. by apply eps. Qed. Lemma interval_finite_subdiv_between (a b : R) (eps : posreal) (Hab : a <= b) : let l := proj1_sig (interval_finite_subdiv a b eps Hab) in forall i, (i < size l)%nat -> a <= nth 0 l i <= b. Proof. case: interval_finite_subdiv => l Hl /= i Hi. case: Hl => <- ; case => <- Hl. move: (fun i Hi => proj1 (Hl i Hi)) => {} Hl. rewrite -nth0 (last_nth 0). suff : forall n m, (n <= m)%nat -> (m < size l)%nat -> nth 0 l n <= nth 0 l m. move => {} Hl ; split. apply Hl ; by intuition. case: l Hi Hl => /= [ | x0 l] Hi Hl. by apply Nat.nlt_0_r in Hi. apply Hl ; by intuition. elim: l Hl {i Hi} => [ | x0 l IH] Hl n m Hnm Hm. by apply Nat.nlt_0_r in Hm. case: n m Hnm Hm => [ | n] m //= Hnm Hm. clear Hnm ; elim: m Hm => {IH} /= [ | m IH] Hm. by apply Rle_refl. apply Rle_trans with (nth 0 (x0 :: l) m). apply IH ; intuition. by apply Rlt_le, Hl. case: m Hnm Hm => /= [ | m] Hnm Hm. by apply Nat.nle_succ_0 in Hnm. apply IH ; try by intuition. move => i Hi. apply (Hl (S i)). by apply (proj1 (Nat.succ_lt_mono _ _)). Qed. (** Notations *) Lemma SSR_leq (n m : nat) : is_true (ssrnat.leq n m) <-> (n <= m)%nat. Proof. set H := (@ssrnat.leP n m) ; case: H => H //=. Qed. Lemma SSR_minus (n m : nat) : ssrnat.subn n m = (n - m)%nat. Proof. elim: m n => //. Qed. (** rcons *) Lemma rcons_ind {T : Type} (P : seq T -> Type) : P [::] -> (forall (s : seq T) (t : T), P s -> P (rcons s t)) -> forall s, P s. Proof. move => H0 Hr s ; move: (refl_equal (size s)). move: {1}(size s) => n ; elim: n s => // [| n IH] s Hn ; case: s Hn => [| h s] Hn //. have: ({s0 : _&{ t0 | h::s = rcons s0 t0}}) ; [| case => s0 [t0 H]]. elim: (s) (h) => {s h Hn IH} [| h s IH] h0. exists [::] ; by exists h0. case: (IH h) => s0 [t0 H] ; exists (h0::s0) ; exists t0 ; by rewrite rcons_cons -H. rewrite H ; apply Hr, IH, eq_add_S ; by rewrite -(size_rcons s0 t0) -H. Qed. Lemma rcons_dec {T : Type} (P : seq T -> Type) : (P [::]) -> (forall s t, P (rcons s t)) -> forall s, P s. Proof. move => H0 Hr ; case => [| h s] //. have: ({s0 : _&{ t0 | h::s = rcons s0 t0}}) ; [| case => s0 [t0 H]]. elim: s h => [| h s IH] h0. exists [::] ; by exists h0. case: (IH h) => s0 [t0 H] ; exists (h0::s0) ; exists t0 ; by rewrite rcons_cons -H. by rewrite H. Qed. Lemma size_rcons_pos {T : Type} (s : seq T) (t : T) : (0 < size (rcons s t))%nat. Proof. rewrite size_rcons /= ; apply Nat.lt_0_succ. Qed. Lemma foldr_rcons {T T0 : Type} : forall (f : T0 -> T -> T) x0 s t, foldr f x0 (rcons s t) = foldr f (f t x0) s. Proof. move => f x0 s ; elim: s x0 => //= t s IH x0 t0 ; by rewrite IH. Qed. Lemma foldl_rcons {T T0 : Type} : forall (f : T -> T0 -> T) x0 s t, foldl f x0 (rcons s t) = f (foldl f x0 s) t. Proof. move => f x0 s ; elim: s x0 => //= t s IH x0 t0 ; by rewrite IH. Qed. (* head, last, behead and belast *) Lemma head_rcons {T : Type} (x0 : T) (s : seq T) (t : T) : head x0 (rcons s t) = head t s. Proof. case: s x0 t => //. Qed. Lemma behead_rcons {T : Type} (s : seq T) (t : T) : (0 < size s)%nat -> behead (rcons s t) = rcons (behead s) t. Proof. case: s t => // t Hi ; contradict Hi ; apply Nat.nlt_0_r. Qed. Definition belast {T : Type} (s : seq T) := match s with | [::] => [::] | h :: s => belast h s end. Lemma behead_rev {T : Type} (s : seq T) : behead (rev s) = rev (belast s). Proof. case: s => // t s ; elim: s t => // t s IHs t0. rewrite rev_cons behead_rcons ?IHs ?size_rev -?rev_cons //= ; by apply Nat.lt_0_succ. Qed. Lemma pairmap_rcons {T T0 : Type} (f : T -> T -> T0) (s : seq T) h0 h x0 : pairmap f x0 (rcons (rcons s h0) h) = rcons (pairmap f x0 (rcons s h0)) (f h0 h). Proof. elim: s x0 h h0 => [| h1 s IH] x0 h h0 //= ; by rewrite IH. Qed. Lemma map_pairmap {T T0 T1 : Type} (f : T0 -> T1) (g : T -> T -> T0) (s : seq T) (x0 : T) : map f (pairmap g x0 s) = pairmap (fun x y => f (g x y)) x0 s. Proof. elim: s x0 => [| h s IH] x0 //=. by rewrite IH. Qed. Lemma pairmap_map {T T0 T1 : Type} (f : T0 -> T0 -> T1) (g : T -> T0) (s : seq T) (x0 : T) : pairmap f (g x0) (map g s) = pairmap (fun x y => f (g x) (g y)) x0 s. Proof. elim: s x0 => [| h s IH] x0 //=. by rewrite IH. Qed. (** zip and unzip *) Lemma size_unzip1 {T T0 : Type} (s : seq (T * T0)) : size (unzip1 s) = size s. Proof. by elim: s => //= _ s0 ->. Qed. Lemma size_unzip2 {T T0 : Type} (s : seq (T * T0)) : size (unzip2 s) = size s. Proof. by elim: s => //= _ s0 ->. Qed. Lemma zip_cons {S T : Type} hs ht (s : seq S) (t : seq T) : zip (hs :: s) (ht :: t) = (hs,ht) :: zip s t. Proof. by []. Qed. Lemma zip_rcons {S T : Type} (s : seq S) (t : seq T) hs ht : size s = size t -> zip (rcons s hs) (rcons t ht) = rcons (zip s t) (hs,ht). Proof. elim: s t hs ht => [| hs s IHs] ; case => //= ht t hs' ht' Hs. rewrite IHs => // ; by apply eq_add_S. Qed. Lemma unzip1_rcons {S T : Type} (s : seq (S*T)) (h : S*T) : unzip1 (rcons s h) = rcons (unzip1 s) (fst h). Proof. elim: s => [ | h0 s IH] //= ; by rewrite IH. Qed. Lemma unzip2_rcons {S T : Type} (s : seq (S*T)) (h : S*T) : unzip2 (rcons s h) = rcons (unzip2 s) (snd h). Proof. elim: s => [ | h0 s IH] //= ; by rewrite IH. Qed. Lemma unzip1_belast {S T : Type} (s : seq (S*T)) : unzip1 (belast s) = belast (unzip1 s). Proof. elim: s => //= h0 ; case => //= h1 s -> //. Qed. Lemma unzip2_belast {S T : Type} (s : seq (S*T)) : unzip2 (belast s) = belast (unzip2 s). Proof. elim: s => //= h0 ; case => //= h1 s -> //. Qed. Lemma unzip1_behead {S T : Type} (s : seq (S*T)) : unzip1 (behead s) = behead (unzip1 s). Proof. elim: s => //= h0 ; case => //= h1 s -> //. Qed. Lemma unzip2_behead {S T : Type} (s : seq (S*T)) : unzip2 (behead s) = behead (unzip2 s). Proof. elim: s => //= h0 ; case => //= h1 s -> //. Qed. Lemma unzip1_fst {S T : Type} (s : seq (S*T)) : unzip1 s = map (@fst S T) s. Proof. by elim: s. Qed. Lemma unzip2_snd {S T : Type} (s : seq (S*T)) : unzip2 s = map (@snd S T) s. Proof. by elim: s. Qed. Lemma size_belast' {T : Type} (s : seq T) : size (belast s) = Peano.pred (size s). Proof. case: s => /= [ | x0 s] //. by rewrite size_belast. Qed. Lemma head_map {T1 T2 : Type} (f : T1 -> T2) (s : seq T1) (x : T1) : head (f x) (map f s) = f (head x s). Proof. by case: s. Qed. (** * Operations on the Riemann integral *) Lemma StepFun_bound {a b : R} (f : StepFun a b) : exists s : R, forall x, Rmin a b <= x <= Rmax a b -> f x <= s. Proof. case: f => /= f [lx [ly [Hsort [Hhead [Hlast [Hsize Hval]]]]]]; rename a into a0 ; rename b into b0 ; set a := Rmin a0 b0 ; set b := Rmax a0 b0 ; set Rl_max := fun x0 => fix f l := match l with | nil => x0 | h :: t => Rmax h (f t) end ; set f_lx := (fix app l := match l with | nil => nil | h :: t => f h :: app t end) lx ; set M_f_lx := Rl_max (f 0) f_lx ; set M_ly := Rl_max 0 ly. exists (Rmax M_f_lx M_ly) => x [Hx Hx']. rewrite /M_f_lx /f_lx ; case: lx Hsort Hhead Hlast Hsize Hval {f_lx M_f_lx}. (* lx = [::] *) move => _ _ _ H ; contradict H ; apply O_S. move => h l ; case: l h. (* lx = [:: h] *) move => h _ Ha Hb _ _ ; simpl in Ha, Hb. rewrite /a -Ha in Hx ; rewrite /b -Hb in Hx'. rewrite (Rle_antisym _ _ Hx Hx') /= ; apply Rle_trans with (2 := RmaxLess1 _ _) ; apply RmaxLess1. (* lx = [:: h,h'::l] *) move => h l h' Hsort Hhead Hlast Hsize Hval. apply Rle_lt_or_eq_dec in Hx' ; case: Hx' => Hx'. have H : exists i : nat, (i < S (length l))%nat /\ (RList.pos_Rl (cons h' (h :: l)) i) <= x < (RList.pos_Rl (cons h' (h :: l)) (S i)). rewrite /a -Hhead in Hx ; rewrite /b -Hlast in Hx'. elim: l h' h Hx Hx' Hsort {Hhead Hlast Hsize Hval} => [| h'' l IH] h' h Hx Hx' Hsort ; simpl in Hx, Hsort. case: (Rlt_le_dec x h) => H. exists O ; intuition. exists O => /= ; intuition. case: (Rlt_le_dec x h) => H. exists O => /= ; intuition. have H0 : RList.ordered_Rlist (h :: h'' :: l). move => i Hi ; apply (Hsort (S i)) => /= ; apply (proj1 (Nat.succ_lt_mono _ _)), Hi. case: (IH _ _ H Hx' H0) => {IH} i Hi. exists (S i) ; split. simpl ; apply (proj1 (Nat.succ_lt_mono _ _)), Hi => /=. apply Hi. case: H => i [Hi [Ht Ht']]. apply Rle_lt_or_eq_dec in Ht ; case: Ht => Ht. rewrite (Hval i Hi x). apply Rle_trans with (2 := RmaxLess2 _ _). rewrite /M_ly ; case: (ly). apply Rle_refl. move => y ly' ; elim: ly' (i) y. move => i0 y ; case: i0 => //=. apply RmaxLess1. move => _; apply RmaxLess2. move => y ly' IH i0 y' ; case: i0. apply RmaxLess1. move => n ; apply Rle_trans with (1 := IH n y) ; apply RmaxLess2. split => //. rewrite -Ht ; apply Rle_trans with (2 := RmaxLess1 _ _). case: (i). apply RmaxLess1. move => n ; elim: n (h) (h') (l). move => h0 h'0 l0 ; apply Rle_trans with (2 := RmaxLess2 _ _), RmaxLess1. move => n IH h0 h'0 l0. case: l0. apply Rle_trans with (2 := RmaxLess2 _ _), RmaxLess2. move => h''0 l0 ; apply Rle_trans with (1 := IH h''0 h0 l0), RmaxLess2. rewrite Hx' /b -Hlast. apply Rle_trans with (2 := RmaxLess1 _ _). elim: (l) (h') (h) => [| h''0 l0 IH] h'0 h0. apply Rle_trans with (2 := RmaxLess2 _ _), RmaxLess1. apply Rle_trans with (1 := IH h0 h''0), RmaxLess2. Qed. Lemma Riemann_integrable_bound (f : R -> R) (a b : R) : Riemann_integrable f a b -> exists s : R, forall x, Rmin a b <= x <= Rmax a b -> f x <= s. Proof. move => pr ; case (pr (mkposreal _ Rlt_0_1)) => {pr} phi [psi [pr _]] ; case: (StepFun_bound phi) => M_phi H_phi ; case: (StepFun_bound psi) => M_psi H_psi ; exists (M_psi + M_phi) => x Hx. apply Rle_trans with (2 := Rplus_le_compat _ _ _ _ (H_psi _ Hx) (H_phi _ Hx)). have: (f x = (f x - phi x) + phi x) ; first by ring. move => -> ; apply Rplus_le_compat_r, Rle_trans with (1 := Rle_abs _), pr, Hx. Qed. (** Extensionality *) Lemma Riemann_integrable_ext : forall (f g : R -> R) (a b : R), (forall x, Rmin a b <= x <= Rmax a b -> f x = g x) -> Riemann_integrable f a b -> Riemann_integrable g a b. Proof. intros f g a b Heq pr_f. intro eps. elim (pr_f eps) ; clear pr_f ; intros phi (psi, pr_f). exists phi. exists psi. split ; intros. rewrite <- (Heq t H). apply (proj1 pr_f t H). apply pr_f. Qed. Lemma RiemannInt_ext : forall (f g : R -> R) (a b : R) (pr_f : Riemann_integrable f a b) (pr_g : Riemann_integrable g a b) (Heq : forall x, Rmin a b <= x <= Rmax a b -> f x = g x), RiemannInt pr_f = RiemannInt pr_g. Proof. intros. destruct (Rle_lt_dec a b). apply RiemannInt_P18. apply r. intros. apply Heq. split. rewrite (Rmin_left _ _ r). apply Rlt_le ; apply H. rewrite (Rmax_right _ _ r). apply Rlt_le ; apply H. rewrite (RiemannInt_P8 pr_f (RiemannInt_P1 pr_f)). rewrite (RiemannInt_P8 pr_g (RiemannInt_P1 pr_g)). apply Ropp_eq_compat. apply RiemannInt_P18. apply Rlt_le ; apply r. intros. apply Heq. split. rewrite (Rmin_right _ _ (Rlt_le _ _ r)). apply Rlt_le ; apply H. rewrite (Rmax_left _ _ (Rlt_le _ _ r)). apply Rlt_le ; apply H. Qed. (** Constant function *) Lemma Riemann_integrable_const : forall (c a b : R), Riemann_integrable (fun x => c) a b. Proof. intros. apply RiemannInt_P14. Qed. Lemma RiemannInt_const : forall (c a b : R) (pr : Riemann_integrable (fun x => c) a b), RiemannInt pr = c * (b-a). Proof. intros. apply RiemannInt_P15. Qed. (** Addition *) Lemma Riemann_integrable_plus : forall (f g : R -> R) (a b : R), Riemann_integrable f a b -> Riemann_integrable g a b -> Riemann_integrable (fun x => f x + g x) a b. Proof. intros f g a b pr_f pr_g. apply (Riemann_integrable_ext (fun x => f x + 1 * g x)). intros ; ring. apply (RiemannInt_P10 1 pr_f pr_g). Qed. Lemma RiemannInt_plus : forall (f g : R -> R) (a b : R) (pr_f : Riemann_integrable f a b) (pr_g : Riemann_integrable g a b) (pr : Riemann_integrable (fun x => f x + g x) a b), RiemannInt pr = RiemannInt pr_f + RiemannInt pr_g. Proof. intros. rewrite <- (Rmult_1_l (RiemannInt pr_g)). rewrite <- (RiemannInt_P13 pr_f pr_g (RiemannInt_P10 1 pr_f pr_g)). apply RiemannInt_ext. intros ; ring. Qed. (** Subtraction *) Lemma Riemann_integrable_minus : forall (f g : R -> R) (a b : R), Riemann_integrable f a b -> Riemann_integrable g a b -> Riemann_integrable (fun x => f x - g x) a b. Proof. intros f g a b pr_f pr_g. apply (Riemann_integrable_ext (fun x => f x + (-1) * g x)). intros ; ring. apply (RiemannInt_P10 (-1) pr_f pr_g). Qed. Lemma RiemannInt_minus : forall (f g : R -> R) (a b : R) (pr_f : Riemann_integrable f a b) (pr_g : Riemann_integrable g a b) (pr : Riemann_integrable (fun x => f x - g x) a b), RiemannInt pr = RiemannInt pr_f - RiemannInt pr_g. Proof. intros. rewrite <- (Rmult_1_l (RiemannInt pr_g)). unfold Rminus. rewrite <- Ropp_mult_distr_l_reverse. rewrite -(RiemannInt_P13 pr_f pr_g (RiemannInt_P10 (-1) pr_f pr_g)). apply RiemannInt_ext. intros ; ring. Qed. (** Opposite *) Lemma Riemann_integrable_opp : forall (f : R -> R) (a b : R), Riemann_integrable f a b -> Riemann_integrable (fun x => - f x) a b. Proof. intros f a b pr_f. apply (Riemann_integrable_ext (fun x => 0 + (-1) * f x)). intros ; ring. apply (RiemannInt_P10 (-1) (Riemann_integrable_const _ _ _) pr_f). Qed. Lemma RiemannInt_opp : forall (f : R -> R) (a b : R) (pr_f : Riemann_integrable f a b) (pr : Riemann_integrable (fun x => - f x) a b), RiemannInt pr = - RiemannInt pr_f. Proof. intros. rewrite <- (Rmult_1_l (RiemannInt pr_f)). rewrite <- Ropp_mult_distr_l_reverse. rewrite -(Rplus_0_l (-1 * RiemannInt pr_f)). assert (0 = RiemannInt (Riemann_integrable_const 0 a b)). rewrite RiemannInt_const. ring. rewrite H ; clear H. rewrite <- (RiemannInt_P13 (Riemann_integrable_const 0 _ _) pr_f (RiemannInt_P10 (-1) (Riemann_integrable_const 0 a b) pr_f)). apply RiemannInt_ext. intros ; ring. Qed. (** Multiplication by a scalar *) Lemma Riemann_integrable_scal : forall (f : R -> R) (a b c : R), Riemann_integrable f a b -> Riemann_integrable (fun x => c * f x) a b. Proof. intros f a b c pr_f. apply (Riemann_integrable_ext (fun x => 0 + c * f x)). intros ; ring. apply (RiemannInt_P10 (c) (Riemann_integrable_const _ _ _) pr_f). Qed. Lemma RiemannInt_scal : forall (f : R -> R) (a b c : R) (pr_f : Riemann_integrable f a b) (pr : Riemann_integrable (fun x => c * f x) a b), RiemannInt pr = c * RiemannInt pr_f. Proof. intros. rewrite <- (Rplus_0_l (c * RiemannInt pr_f)). assert (0 = RiemannInt (Riemann_integrable_const 0 a b)). rewrite RiemannInt_const. ring. rewrite H ; clear H. rewrite <- (RiemannInt_P13 (Riemann_integrable_const 0 _ _) pr_f (RiemannInt_P10 (c) (Riemann_integrable_const 0 a b) pr_f)). apply RiemannInt_ext. intros ; ring. Qed. (** * Natural logarithm *) Lemma ln_pow x n : 0 < x -> ln (x^n) = INR n * ln x. intro Hx ; induction n as [ | n IH]. rewrite pow_O ln_1 ; simpl ; ring. rewrite S_INR ; simpl ; rewrite ln_mult ; try intuition. rewrite IH ; ring. Qed. Lemma ln_le x y : 0 < x -> x <= y -> ln x <= ln y. Proof. intros Hx Hxy ; destruct Hxy. left ; apply ln_increasing. exact Hx. exact H. rewrite H ; exact (Rle_refl _). Qed. Lemma ln_div x y : 0 < x -> 0 < y -> ln (x / y) = ln x - ln y. Proof. intros Hx Hy ; unfold Rdiv. rewrite ln_mult. rewrite ln_Rinv. ring. exact Hy. exact Hx. apply Rinv_0_lt_compat ; exact Hy. Qed. (** * Other *) Lemma derivable_pt_lim_atan : forall x, derivable_pt_lim atan x (/(1 + x^2)). Proof. intros x. apply derive_pt_eq_1 with (derivable_pt_atan x). replace (x ^ 2) with (x * x) by ring. rewrite -(Rmult_1_l (Rinv _)). apply derive_pt_atan. Qed. coquelicot-coquelicot-3.4.1/theories/SF_seq.v000066400000000000000000002725021455143432500212420ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect ssrbool. From mathcomp Require Import seq. Require Import Rcomplements Rbar Lub Hierarchy. Local Tactic Notation "intuition" := (intuition auto with arith zarith real rorders). (** This file describes many properties about sequences of real numbers. Several formalizations are provided. They are mainly used for defining pointed subvivision in order to define Riemann sums. *) Open Scope R_scope. (** * Complements abouts lists *) Lemma size_compat (s : seq R) : length s = size s. Proof. elim: s => // t s IHs /= ; by rewrite IHs. Qed. Lemma nth_compat (s : seq R) (n : nat) : RList.pos_Rl s n = nth 0 s n. Proof. elim: s n => [n|t s IHs n] /= ; case: n => //=. Qed. (** Various properties *) Lemma rev_rev {T} (l : seq T) : rev (rev l) = l. Proof. elim: l => /= [ | h l IH]. by []. by rewrite rev_cons rev_rcons IH. Qed. Lemma head_rev {T} (x0 : T) (l : seq T) : head x0 (rev l) = last x0 l. Proof. elim: l x0 => /= [ | x1 l IH] x0. by []. by rewrite rev_cons head_rcons. Qed. Lemma last_rev {T} (x0 : T) (l : seq T) : last x0 (rev l) = head x0 l. Proof. by rewrite -head_rev rev_rev. Qed. Lemma last_unzip1 {S T} x0 y0 (s : seq (S * T)) : last x0 (unzip1 s) = fst (last (x0,y0) s). Proof. case: s => [ | h s] //= . elim: s h => [ | h0 s IH] h //=. Qed. (** sorted *) Fixpoint sorted {T : Type} (Ord : T -> T -> Prop) (s : seq T) := match s with | [::] | [:: _] => True | h0 :: (h1 :: t1) as t0 => Ord h0 h1 /\ sorted Ord t0 end. Lemma sorted_nth {T : Type} (Ord : T -> T -> Prop) (s : seq T) : sorted Ord s <-> (forall i : nat, (i < Peano.pred (size s))%nat -> forall x0 : T, Ord (nth x0 s i) (nth x0 s (S i))). Proof. case: s. split => // _ i Hi ; contradict Hi ; apply Nat.nlt_0_r. move => t s ; elim: s t => [ t | t s IHs t0] ; split => // H. move => i Hi ; contradict Hi ; apply Nat.nlt_0_r. case => [| i] Hi x0 ; simpl in Hi. apply H. case: (IHs t) => {} IHs _ ; apply (IHs (proj2 H) i (proj2 (Nat.succ_lt_mono _ _) Hi) x0). split. apply (H O (Nat.lt_0_succ _) t). case: (IHs t) => {IHs} _ IHs. apply: IHs => i Hi x0 ; apply: (H (S i)) ; simpl ; apply ->Nat.succ_lt_mono. now apply Hi. Qed. Lemma sorted_cat {T : Type} (Ord : T -> T -> Prop) (s1 s2 : seq T) x0 : sorted Ord s1 -> sorted Ord s2 -> Ord (last x0 s1) (head x0 s2) -> sorted Ord (s1 ++ s2). Proof. move/sorted_nth => H1. move/sorted_nth => H2 H0. apply sorted_nth => i Hi => x1. rewrite ?nth_cat. rewrite ?SSR_minus. case: (le_dec (S i) (size s1)) => Hi0. move: (proj2 (SSR_leq _ _) Hi0) ; case: (ssrnat.leq (S i) (size s1)) => // _. case: (le_dec (S (S i)) (size s1)) => Hi1. move: (proj2 (SSR_leq _ _) Hi1) ; case: (ssrnat.leq (S (S i)) (size s1)) => // _. apply H1 ; intuition. have : ~ (ssrnat.leq (S (S i)) (size s1)). contradict Hi1 ; by apply SSR_leq. case: (ssrnat.leq (S (S i)) (size s1)) => // _. suff Hi' : i = Peano.pred (size s1). rewrite Hi' nth_last. replace (S (Peano.pred (size s1)) - size s1)%nat with O. rewrite nth0. apply not_le in Hi1. case: (s1) H0 Hi Hi' Hi0 Hi1 => [ | x2 s1'] //= H0 Hi Hi' Hi0 Hi1. by apply Nat.nle_succ_0 in Hi0. case: (s2) H0 Hi0 Hi => [ | x3 s2'] //= H0 Hi0 Hi. rewrite cats0 /= in Hi. rewrite Hi' in Hi. by apply Nat.lt_irrefl in Hi. case: (s1) Hi0 => //= [ | x2 s0] Hi0. by apply Nat.nle_succ_0 in Hi0. by rewrite Nat.sub_diag. apply sym_eq, Nat.le_antisymm. apply MyNat.le_pred_le_succ. apply not_le in Hi1. by apply Nat.lt_succ_r. replace i with (Peano.pred (S i)) by auto. by apply le_pred. have : ~ (ssrnat.leq (S i) (size s1)). contradict Hi0 ; by apply SSR_leq. case: (ssrnat.leq (S i) (size s1)) => // _. have : ~ssrnat.leq (S (S i)) (size s1). contradict Hi0. apply SSR_leq in Hi0. intuition. case: (ssrnat.leq (S (S i)) (size s1)) => // _. replace (S i - size s1)%nat with (S (i - size s1)). apply H2. rewrite size_cat in Hi. apply not_le in Hi0. elim: (size s1) i Hi Hi0 => [ | n IH] /= i Hi Hi0. rewrite Nat.sub_0_r. unfold ssrnat.addn, ssrnat.addn_rec in Hi. by rewrite Nat.add_0_l in Hi. case: i Hi Hi0 => [ | i] /= Hi Hi0. by apply Nat.lt_succ_r, Nat.nlt_0_r in Hi0. apply IH ; by intuition. apply not_le in Hi0. rewrite Nat.sub_succ_l ; by intuition. Qed. Lemma sorted_head (s : seq R) i : sorted Rle s -> (i < size s)%nat -> forall x0, head x0 s <= nth x0 s i. Proof. case: s => [| h s]. move => _ Hi ; by apply Nat.nlt_0_r in Hi. elim: s h i => [| h0 s IH] h i Hs Hi x0. apply Nat.lt_succ_r, Nat.le_0_r in Hi ; rewrite Hi ; apply Rle_refl. case: i Hi => [| i] Hi. apply Rle_refl. apply Rle_trans with (r2 := head x0 (h0::s)). apply Hs. apply IH. apply Hs. apply ->Nat.lt_succ_r; now apply Hi. Qed. Lemma sorted_incr (s : seq R) i j : sorted Rle s -> (i <= j)%nat -> (j < size s)%nat -> forall x0, nth x0 s i <= nth x0 s j. Proof. elim: i j s => [| i IH] j s Hs Hij Hj x0. rewrite nth0 ; by apply sorted_head. case: j Hij Hj => [| j] Hij Hj. by apply Nat.nle_succ_0 in Hij. case: s Hs Hj => [| h s] Hs Hj. by apply Nat.nlt_0_r in Hj. apply (IH j s) with (x0 := x0) => //. case: (s) Hs => {s Hj} [| h0 s] Hs ; apply Hs. apply le_S_n, Hij. apply le_S_n, Hj. Qed. Lemma sorted_last (s : seq R) i : sorted Rle s -> (i < size s)%nat -> forall x0, nth x0 s i <= last x0 s. Proof. move => Hs Hi x0 ; rewrite -nth_last. case: s Hi Hs => [| h s] Hi Hs //. by apply Nat.nlt_0_r in Hi. apply sorted_incr => //. intuition. Qed. Lemma sorted_dec (s : seq R) x0 (x : R) : sorted Rle s -> head x0 s <= x <= last x0 s -> {i : nat | nth x0 s i <= x < nth x0 s (S i) /\ (S (S i) < size s)%nat} + {nth x0 s (size s - 2)%nat <= x <= nth x0 s (size s - 1)%nat}. Proof. case: s => [/= _ Hx| h s] ; simpl minus ; rewrite -?Nat.sub_0_r. by right. case: s => [/= _ Hx| h0 s] ; simpl minus ; rewrite -?Nat.sub_0_r. by right. elim: s h h0 => [/= | h1 s IH] h h0 Hs Hx. by right. case: (Rlt_le_dec x h0) => Hx'. left ; exists O => /= ; intuition. case: (IH h0 h1) => [ | |[i Hi]|Hi]. apply Hs. split ; [apply Hx'|apply Hx]. left ; exists (S i) => /= ; intuition. right => /= ; simpl in Hi. by rewrite Nat.sub_0_r in Hi. Qed. Lemma sorted_compat (s : seq R) : sorted Rle s <-> RList.ordered_Rlist (s). Proof. case: s => [| h s]. (* s = [::] *) split => // H i /= Hi ; contradict Hi ; apply Nat.nlt_0_r. elim: s h => [h | h s IHs h']. (* s = [::_] *) split => // H i /= Hi ; contradict Hi ; apply Nat.nlt_0_r. (* s = _::(_::_) *) split => H. case => [ /= | i] ; rewrite size_compat => Hi ; simpl in Hi. apply H. apply (proj1 (IHs h) (proj2 H) i) ; rewrite size_compat /= ; apply Nat.lt_succ_r => //. split. apply (H O) ; rewrite size_compat /= ; apply Nat.lt_0_succ. apply IHs => i ; rewrite size_compat /= => Hi ; apply (H (S i)) ; rewrite size_compat /= ; apply ->Nat.succ_lt_mono; now apply Hi. Qed. (** seq_step *) Definition seq_step (s : seq R) := foldr Rmax 0 (pairmap (fun x y => Rabs (Rminus y x)) (head 0 s) (behead s)). Lemma seq_step_ge_0 x : (0 <= seq_step x). Proof. clear ; unfold seq_step ; case: x => [ | x0 x] //= . by apply Rle_refl. elim: x x0 => [ | x1 x IH] //= x0. by apply Rle_refl. apply Rmax_case. by apply Rabs_pos. by []. Qed. Lemma seq_step_cat (x y : seq R) : (0 < size x)%nat -> (0 < size y)%nat -> last 0 x = head 0 y -> seq_step (cat x (behead y)) = Rmax (seq_step x) (seq_step y). Proof. case: x => /= [ H | x0 x _]. by apply Nat.lt_irrefl in H. case: y => /= [ H | y0 y _]. by apply Nat.lt_irrefl in H. move => <-. elim: x y x0 {y0} => /= [ | x1 x IH] y x0. rewrite {2}/seq_step /=. rewrite /Rmax ; case: Rle_dec (seq_step_ge_0 (x0 :: y)) => // _ _. unfold seq_step ; simpl. rewrite -Rmax_assoc. apply f_equal. by apply IH. Qed. Lemma seq_step_rev (l : seq R) : seq_step (rev l) = seq_step l. Proof. rewrite /seq_step. rewrite head_rev behead_rev /=. case: l => [ | x0 l] //=. case: l => [ | x1 l] //=. rewrite rev_cons. case: l => [ | x2 l] //=. by rewrite -Rabs_Ropp Ropp_minus_distr'. rewrite rev_cons pairmap_rcons foldr_rcons. rewrite -Rabs_Ropp Ropp_minus_distr'. generalize (Rabs (x1 - x0)) ; clear. elim: l x1 x2 => [ | x2 l IH] x0 x1 r //=. rewrite -Rabs_Ropp Ropp_minus_distr' !Rmax_assoc. apply f_equal2 => //. by apply Rmax_comm. rewrite rev_cons pairmap_rcons foldr_rcons. rewrite -Rabs_Ropp Ropp_minus_distr' Rmax_assoc IH. by rewrite (Rmax_comm _ r) !Rmax_assoc. Qed. Lemma nth_le_seq_step x0 (l : seq R) (i : nat) : (S i < size l)%nat -> Rabs (nth x0 l (S i) - nth x0 l i) <= seq_step l. Proof. elim: i l => [ | i IH] ; case => [ | x1 l] /= Hi. by apply Nat.nlt_0_r in Hi. apply Nat.succ_lt_mono in Hi. destruct l as [ | x2 l]. by apply Nat.nlt_0_r in Hi. by apply Rmax_l. by apply Nat.nlt_0_r in Hi. apply Nat.succ_lt_mono in Hi. move: (IH l Hi). destruct l as [ | x2 l] ; simpl. by apply Nat.nlt_0_r in Hi. simpl in Hi ; apply Nat.succ_lt_mono in Hi. move => {} IH. eapply Rle_trans. by apply IH. by apply Rmax_r. Qed. (** * Definitions of SF_seq *) Section SF_seq. Context {T : Type}. Record SF_seq := mkSF_seq {SF_h : R ; SF_t : seq (R * T)}. Definition SF_lx (s : SF_seq) : seq R := (SF_h s)::(unzip1 (SF_t s)). Definition SF_ly (s : SF_seq) : seq T := unzip2 (SF_t s). Definition SF_make (lx : seq R) (ly : seq T) (Hs : size lx = S (size ly)) : SF_seq := mkSF_seq (head 0 lx) (zip (behead lx) ly). Lemma SF_size_lx_ly (s : SF_seq) : size (SF_lx s) = S (size (SF_ly s)). Proof. case: s => sh st ; rewrite /SF_lx /SF_ly /= ; elim: st => //= t s -> //. Qed. Lemma SF_seq_bij (s : SF_seq) : SF_make (SF_lx s) (SF_ly s) (SF_size_lx_ly s) = s. Proof. case: s => sh st ; by rewrite /SF_make (zip_unzip st). Qed. Lemma SF_seq_bij_lx (lx : seq R) (ly : seq T) (Hs : size lx = S (size ly)) : SF_lx (SF_make lx ly Hs) = lx. Proof. case: lx Hs => // x lx Hs ; rewrite /SF_make / SF_lx unzip1_zip //= ; apply SSR_leq, le_S_n ; rewrite -Hs => //. Qed. Lemma SF_seq_bij_ly (lx : seq R) (ly : seq T) (Hs : size lx = S (size ly)) : SF_ly (SF_make lx ly Hs) = ly. Proof. case: lx Hs => // x lx Hs ; rewrite /SF_make / SF_ly unzip2_zip //= ; apply SSR_leq, le_S_n ; rewrite -Hs => //. Qed. (** ** Constructors *) Definition SF_nil (x0 : R) : SF_seq := mkSF_seq x0 [::]. Definition SF_cons (h : R*T) (s : SF_seq) := mkSF_seq (fst h) ((SF_h s,snd h)::SF_t s). Definition SF_rcons (s : SF_seq) (t : R*T) := mkSF_seq (SF_h s) (rcons (SF_t s) t). Lemma SF_cons_dec (P : SF_seq -> Type) : (forall x0 : R, P (SF_nil x0)) -> (forall h s, P (SF_cons h s)) -> (forall s, P s). Proof. move => Hnil Hcons [sh st] ; case: st => [| h sf]. apply Hnil. move: (Hcons (sh,snd h) (mkSF_seq (fst h) sf)) => {Hcons} ; rewrite /SF_cons -surjective_pairing //=. Qed. Lemma SF_cons_ind (P : SF_seq -> Type) : (forall x0 : R, P (SF_nil x0)) -> (forall h s, P s -> P (SF_cons h s)) -> (forall s, P s). Proof. move => Hnil Hcons [sh st] ; elim: st sh => [sh |h sf IHst sh]. apply Hnil. move: (IHst (fst h)) => {} IHst. move: (Hcons (sh,snd h) (mkSF_seq (fst h) sf) IHst) => {Hcons} ; rewrite /SF_cons -surjective_pairing //=. Qed. Lemma SF_rcons_dec (P : SF_seq -> Type) : (forall x0 : R, P (SF_nil x0)) -> (forall s t, P (SF_rcons s t)) -> (forall s, P s). Proof. move => Hnil Hrcons [sh st] ; move: st ; apply rcons_dec => [| st t]. apply Hnil. apply (Hrcons (mkSF_seq sh st) t). Qed. Lemma SF_rcons_ind (P : SF_seq -> Type) : (forall x0 : R, P (SF_nil x0)) -> (forall s t, P s -> P (SF_rcons s t)) -> (forall s, P s). Proof. move => Hnil Hrcons [sh st] ; move: st sh ; apply (rcons_ind (fun st => forall sh, P {| SF_h := sh; SF_t := st |})) => [sh | st t IHst sh]. apply Hnil. apply (Hrcons (mkSF_seq sh st) t) => //. Qed. Lemma SF_cons_rcons (h : R*T) (s : SF_seq) (l : R*T) : SF_cons h (SF_rcons s l) = SF_rcons (SF_cons h s) l. Proof. case: h => hx hy ; case: l => lx ly ; case: s => sh st //. Qed. (** ** SF_seq and seq *) Lemma SF_lx_nil (x0 : R) : SF_lx (SF_nil x0) = [:: x0]. Proof. by []. Qed. Lemma SF_ly_nil (x0 : R) : SF_ly (SF_nil x0) = [::]. Proof. by []. Qed. Lemma SF_lx_cons (h : R*T) (s : SF_seq) : SF_lx (SF_cons h s) = (fst h) :: (SF_lx s). Proof. by []. Qed. Lemma SF_ly_cons (h : R*T) (s : SF_seq) : SF_ly (SF_cons h s) = (snd h) :: (SF_ly s). Proof. by []. Qed. Lemma SF_lx_rcons (s : SF_seq) (h : R*T) : SF_lx (SF_rcons s h) = rcons (SF_lx s) (fst h). Proof. case: s => sh st ; rewrite /SF_lx /SF_rcons /= ; elim: st sh => // [[x y] st] IHst sh /= ; by rewrite (IHst x). Qed. Lemma SF_ly_rcons (s : SF_seq) (h : R*T) : SF_ly (SF_rcons s h) = rcons (SF_ly s) (snd h). Proof. case: s => sh st ; rewrite /SF_ly /SF_rcons /= ; elim: st sh => // [[x y] st] IHst sh /= ; by rewrite (IHst x). Qed. Lemma SF_lx_surj (s s0 : SF_seq) : s = s0 -> SF_lx s = SF_lx s0. Proof. by move => ->. Qed. Lemma SF_ly_surj (s s0 : SF_seq) : s = s0 -> SF_ly s = SF_ly s0. Proof. by move => ->. Qed. Lemma SF_lx_ly_inj (s s0 : SF_seq) : SF_lx s = SF_lx s0 -> SF_ly s = SF_ly s0 -> s = s0. Proof. move: s0 ; apply SF_cons_ind with (s := s) => {s} [x | h s IH] s0 ; apply SF_cons_dec with (s := s0) => {s0} [x0 | h0 s0] Hx Hy //. (* s = SF_nil _ *) rewrite !SF_lx_nil in Hx. replace x with (head 0 ([::x])) by intuition ; by rewrite Hx. (* s = SF_cons _ _*) rewrite !SF_lx_cons in Hx ; rewrite !SF_ly_cons in Hy. replace h with (head (fst h) (fst h :: SF_lx s),head (snd h) (snd h :: SF_ly s)) ; [ rewrite Hx Hy (IH s0) //= | move => /= ; by apply injective_projections]. replace (SF_lx s) with (behead (fst h :: SF_lx s)) by intuition ; by rewrite Hx. replace (SF_ly s) with (behead (snd h :: SF_ly s)) by intuition ; by rewrite Hy. Qed. (** ** SF_size *) Definition SF_size (s : SF_seq) := size (SF_t s). Lemma SF_size_cons (h : R*T) (s : SF_seq) : SF_size (SF_cons h s) = S (SF_size s). Proof. rewrite /SF_cons /SF_size //=. Qed. Lemma SF_size_rcons (s : SF_seq) (t : R*T) : SF_size (SF_rcons s t) = S (SF_size s). Proof. rewrite /SF_rcons /SF_size size_rcons //=. Qed. Lemma SF_size_lx (s : SF_seq) : size (SF_lx s) = S (SF_size s). Proof. case: s => sh st ; rewrite /SF_size /= ; elim: st => //= _ st -> //. Qed. Lemma SF_size_ly (s : SF_seq) : size (SF_ly s) = SF_size s. Proof. case: s => sh st ; rewrite /SF_size /= ; elim: st => //= _ st -> //. Qed. (** ** SF_rev *) Lemma SF_rev_0 (s : SF_seq) : size (rev (SF_lx s)) = S (size (rev (SF_ly s))). Proof. by rewrite ?size_rev SF_size_lx SF_size_ly. Qed. Definition SF_rev (s : SF_seq) : SF_seq := SF_make (rev (SF_lx s)) (rev (SF_ly s)) (SF_rev_0 s). Lemma SF_rev_cons (h : R*T) (s : SF_seq) : SF_rev (SF_cons h s) = SF_rcons (SF_rev s) h. Proof. apply SF_lx_ly_inj. by rewrite SF_lx_rcons !SF_seq_bij_lx SF_lx_cons rev_cons. by rewrite SF_ly_rcons !SF_seq_bij_ly SF_ly_cons rev_cons. Qed. Lemma SF_rev_rcons (s : SF_seq) (t : R*T) : SF_rev (SF_rcons s t) = SF_cons t (SF_rev s). Proof. apply SF_lx_ly_inj. by rewrite SF_lx_cons !SF_seq_bij_lx SF_lx_rcons rev_rcons. by rewrite SF_ly_cons !SF_seq_bij_ly SF_ly_rcons rev_rcons. Qed. Lemma SF_rev_invol (s : SF_seq) : SF_rev (SF_rev s) = s. Proof. apply SF_lx_ly_inj. by rewrite /SF_rev ?SF_seq_bij_lx revK. by rewrite /SF_rev ?SF_seq_bij_ly revK. Qed. Lemma SF_lx_rev (s : SF_seq) : SF_lx (SF_rev s) = rev (SF_lx s). Proof. by rewrite /SF_rev ?SF_seq_bij_lx. Qed. Lemma SF_ly_rev (s : SF_seq) : SF_ly (SF_rev s) = rev (SF_ly s). Proof. by rewrite /SF_rev ?SF_seq_bij_ly. Qed. Lemma SF_size_rev (s : SF_seq) : SF_size (SF_rev s) = SF_size s. Proof. by rewrite -?SF_size_ly SF_ly_rev size_rev. Qed. Lemma SF_rev_surj (s s0 : SF_seq) : s = s0 -> SF_rev s = SF_rev s0. Proof. by move => ->. Qed. Lemma SF_rev_inj (s s0 : SF_seq) : SF_rev s = SF_rev s0 -> s = s0. Proof. move => H ; by rewrite -(SF_rev_invol s) -(SF_rev_invol s0) H. Qed. (** ** SF_cat *) Definition SF_cat (x y : SF_seq) := mkSF_seq (SF_h x) ((SF_t x) ++ (SF_t y)). Lemma SF_lx_cat (x y : SF_seq) : SF_lx (SF_cat x y) = (SF_lx x) ++ (behead (SF_lx y)). Proof. unfold SF_cat, SF_lx ; simpl. apply f_equal. by elim: (SF_t x) => //= t h ->. Qed. Lemma SF_last_cat (x y : SF_seq) : last (SF_h x) (SF_lx x) = head (SF_h y) (SF_lx y) -> last (SF_h (SF_cat x y)) (SF_lx (SF_cat x y)) = (last (SF_h y) (SF_lx y)). Proof. rewrite SF_lx_cat. unfold SF_cat, SF_lx ; simpl => <- /=. elim: (SF_t x) (SF_h x) => //= {x} x1 x x0. Qed. Lemma SF_cons_cat x0 (x y : SF_seq) : SF_cons x0 (SF_cat x y) = SF_cat (SF_cons x0 x) y. Proof. reflexivity. Qed. (** ** first and last pair *) Definition SF_head (y0 : T) (s : SF_seq) := (SF_h s, head y0 (SF_ly s)). Definition SF_behead (s : SF_seq) := mkSF_seq (head (SF_h s) (unzip1 (SF_t s))) (behead (SF_t s)). Definition SF_last y0 (s : SF_seq) : (R*T) := last (SF_h s,y0) (SF_t s). Definition SF_belast (s : SF_seq) : SF_seq := mkSF_seq (SF_h s) (Rcomplements.belast (SF_t s)). Lemma SF_last_lx x0 (s : SF_seq) : fst (SF_last x0 s) = last 0 (SF_lx s). Proof. rewrite /SF_last /=. apply sym_eq ; by apply last_unzip1. Qed. (** ** SF_sorted *) Definition SF_sorted (Ord : R -> R -> Prop) (s : SF_seq) := sorted Ord (SF_lx s). End SF_seq. (** ** SF_map *) Section SF_map. Context {T T0 : Type}. Definition SF_map (f : T -> T0) (s : SF_seq) : SF_seq := mkSF_seq (SF_h s) (map (fun x => (fst x,f (snd x))) (SF_t s)). Lemma SF_map_cons (f : T -> T0) (h : R*T) (s : SF_seq) : SF_map f (SF_cons h s) = SF_cons (fst h, f (snd h)) (SF_map f s). Proof. case: s => sh ; elim => // h st ; rewrite /SF_map => //. Qed. Lemma SF_map_rcons (f : T -> T0) (s : SF_seq) (h : R*T) : SF_map f (SF_rcons s h) = SF_rcons (SF_map f s) (fst h, f (snd h)). Proof. move: h ; apply SF_cons_ind with (s := s) => {s} [x0 | h0 s IH] //= h. rewrite SF_map_cons. replace (SF_rcons (SF_cons h0 s) h) with (SF_cons h0 (SF_rcons s h)) by auto. rewrite SF_map_cons. rewrite IH. auto. Qed. Lemma SF_map_lx (f : T -> T0) (s : SF_seq) : SF_lx (SF_map f s) = SF_lx s. Proof. apply SF_cons_ind with (s := s) => {s} //= h s IH ; by rewrite SF_map_cons ?SF_lx_cons IH. Qed. Lemma SF_map_ly (f : T -> T0) (s : SF_seq) : SF_ly (SF_map f s) = map f (SF_ly s). Proof. apply SF_cons_ind with (s := s) => {s} //= h s IH ; by rewrite SF_map_cons ?SF_ly_cons IH. Qed. Lemma SF_map_rev (f : T -> T0) s : SF_rev (SF_map f s) = SF_map f (SF_rev s). Proof. apply SF_lx_ly_inj. by rewrite SF_lx_rev ?SF_map_lx ?SF_lx_rev. by rewrite SF_ly_rev ?SF_map_ly ?SF_ly_rev map_rev. Qed. Lemma SF_map_sort (f : T -> T0) (s : SF_seq) (Ord : R -> R -> Prop) : SF_sorted Ord s -> SF_sorted Ord (SF_map f s). Proof. unfold SF_sorted ; apply SF_cons_ind with (s := s) => {s} /= [x0 | [x0 _] /= s IH] Hs. by []. split. by apply Hs. now apply IH. Qed. Lemma SF_size_map (f : T -> T0) s : SF_size (SF_map f s) = SF_size s. Proof. by rewrite -!SF_size_ly SF_map_ly size_map. Qed. End SF_map. (** * Pointed subvivision *) Definition pointed_subdiv (ptd : @SF_seq R) := forall i : nat, (i < SF_size ptd)%nat -> nth 0 (SF_lx ptd) i <= nth 0 (SF_ly ptd) i <= nth 0 (SF_lx ptd) (S i). Lemma ptd_cons h s : pointed_subdiv (SF_cons h s) -> pointed_subdiv s. Proof. move => H i Hi ; apply (H (S i)) ; rewrite SF_size_cons ; intuition. Qed. Lemma ptd_sort ptd : pointed_subdiv ptd -> SF_sorted Rle ptd. Proof. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | [x0 y0] ptd] ; [ | apply SF_cons_dec with (s := ptd) => {ptd} [ x1 | [x1 y1] ptd] IH] => Hptd ; try split => //=. apply Rle_trans with y0 ; apply (Hptd O) ; rewrite SF_size_cons ; apply Nat.lt_0_succ. apply Rle_trans with y0 ; apply (Hptd O) ; rewrite SF_size_cons ; apply Nat.lt_0_succ. apply IH, (ptd_cons (x0,y0)) => //. Qed. Lemma ptd_sort' ptd : pointed_subdiv ptd -> sorted Rle (SF_ly ptd). Proof. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | [x0 y0] ptd] ; [ | apply SF_cons_dec with (s := ptd) => {ptd} [ x1 | [x1 y1] ptd] IH] => Hptd ; try split. apply Rle_trans with x1 ; [apply (Hptd O) | apply (Hptd 1%nat)] ; rewrite ?SF_size_cons ; repeat apply ->Nat.succ_lt_mono ; apply Nat.lt_0_succ. apply IH, (ptd_cons (x0,y0)) => //. Qed. Lemma SF_cat_pointed (x y : SF_seq) : last (SF_h x) (SF_lx x) = head (SF_h y) (SF_lx y) -> pointed_subdiv x -> pointed_subdiv y -> pointed_subdiv (SF_cat x y). Proof. intros Hxy Hx Hy. move: Hxy Hx. apply (SF_cons_ind (fun x => last (SF_h x) (SF_lx x) = head (SF_h y) (SF_lx y) -> pointed_subdiv x -> pointed_subdiv (SF_cat x y))) => {x} /= [x0 | x0 x IH] Hxy Hx. rewrite Hxy. by apply Hy. rewrite -SF_cons_cat. case => [ | i] Hi. apply (Hx O), Nat.lt_0_succ. apply IH =>//. by apply ptd_cons with x0. by apply <-Nat.succ_lt_mono; apply Hi. Qed. (** * SF_seq for Chasles *) Fixpoint seq_cut_down (s : seq (R*R)) (x : R) : seq (R*R) := match s with | [::] => [:: (x,x)] | h :: t => match Rle_dec (fst h) x with | right _ => [:: (x,Rmin (snd h) x)] | left _ => h :: (seq_cut_down t x) end end. Fixpoint seq_cut_up (s : seq (R*R)) (x : R) : seq (R*R) := match s with | [::] => [:: (x,x)] | h :: t => match Rle_dec (fst h) x with | right _ => (x,x)::(fst h,Rmax (snd h) x)::t | left _ => seq_cut_up t x end end. Definition SF_cut_down (sf : @SF_seq R) (x : R) := let s := seq_cut_down ((SF_h sf,SF_h sf) :: (SF_t sf)) x in mkSF_seq (fst (head (SF_h sf,SF_h sf) s)) (behead s). Definition SF_cut_up (sf : @SF_seq R) (x : R) := let s := seq_cut_up ((SF_h sf,SF_h sf) :: (SF_t sf)) x in mkSF_seq (fst (head (SF_h sf,SF_h sf) s)) (behead s). Lemma SF_cut_down_step s x eps : SF_h s <= x <= last (SF_h s) (SF_lx s) -> seq_step (SF_lx s) < eps -> seq_step (SF_lx (SF_cut_down s x)) < eps. Proof. unfold SF_cut_down, seq_step ; simpl. case => Hh Hl. case: Rle_dec => //= _. move: Hh Hl ; apply SF_cons_ind with (s := s) => {s} [ x1 | [x1 y0] s IH ] /= Hx Hh Hl. rewrite (Rle_antisym _ _ Hx Hh) Rminus_eq_0 Rabs_R0. rewrite /Rmax ; by case: Rle_dec. case: Rle_dec => //= Hx'. apply Rmax_case. apply Rle_lt_trans with (2 := Hl) ; by apply Rmax_l. apply IH ; try assumption. apply Rle_lt_trans with (2 := Hl) ; by apply Rmax_r. apply Rle_lt_trans with (2 := Hl). apply Rmax_case ; apply Rle_trans with (2 := Rmax_l _ _). rewrite ?Rabs_pos_eq. apply Rplus_le_compat_r. by apply Rlt_le, Rnot_le_lt. rewrite -Rminus_le_0. apply Rle_trans with x. by []. by apply Rlt_le, Rnot_le_lt. by rewrite -Rminus_le_0. by apply Rabs_pos. Qed. Lemma SF_cut_up_step s x eps : SF_h s <= x <= last (SF_h s) (SF_lx s) -> seq_step (SF_lx s) < eps -> seq_step (SF_lx (SF_cut_up s x)) < eps. Proof. unfold SF_cut_down, seq_step ; simpl. case => Hh Hl. case: Rle_dec => //= _. move: {4 5}(SF_h s) Hh Hl ; apply SF_cons_ind with (s := s) => {s} [ x1 | [x1 y0] s IH ] /= x0 Hh Hl He. by apply He. case: Rle_dec => //= Hx. apply (IH x0) => //=. apply Rle_lt_trans with (2 := He). by apply Rmax_r. apply Rle_lt_trans with (2 := He). apply Rnot_le_lt in Hx. apply Rmax_case. apply Rle_trans with (2 := Rmax_l _ _). rewrite ?Rabs_pos_eq. by apply Rplus_le_compat_l, Ropp_le_contravar. rewrite -Rminus_le_0 ; by apply Rlt_le, Rle_lt_trans with x. rewrite -Rminus_le_0 ; by apply Rlt_le. by apply Rmax_r. Qed. Lemma SF_cut_down_pointed s x : SF_h s <= x -> pointed_subdiv s -> pointed_subdiv (SF_cut_down s x). Proof. unfold SF_cut_down ; simpl. case: Rle_dec => //= _. apply SF_cons_ind with (s := s) => {s} [x0 | [x1 y1] s IH] /= Hx0 H. move => i /= Hi. unfold SF_size in Hi ; simpl in Hi. apply Nat.lt_succ_r, Nat.le_0_r in Hi. rewrite Hi ; simpl ; split. by []. by apply Rle_refl. case: Rle_dec => //= Hx1. move: (H O (Nat.lt_0_succ _)) => /= H0. apply ptd_cons in H. move: (IH Hx1 H) => {} IH. rewrite /pointed_subdiv => i. destruct i => /= Hi. by apply H0. apply (IH i). apply Nat.succ_lt_mono, Hi. move => i /= Hi. unfold SF_size in Hi ; simpl in Hi. apply Nat.lt_succ_r, Nat.le_0_r in Hi. rewrite Hi ; simpl ; split. apply Rmin_case. apply (H O). by apply Nat.lt_0_succ. by []. by apply Rmin_r. Qed. Lemma SF_cut_up_pointed s x : SF_h s <= x -> pointed_subdiv s -> pointed_subdiv (SF_cut_up s x). Proof. unfold SF_cut_up ; simpl. case: Rle_dec => //= _. move: {2 3}(SF_h s) ; apply SF_cons_ind with (s := s) => {s} [ x1 | [x1 y0] s IH] /= x0 Hx0 H i Hi. by apply Nat.nlt_0_r in Hi. destruct (Rle_dec (SF_h s) x) as [Hx1|Hx1]. apply IH => //=. move: H ; by apply ptd_cons. destruct i ; simpl. split. by apply Rmax_r. apply Rmax_case. by apply (H O), Nat.lt_0_succ. by apply Rlt_le, Rnot_le_lt. apply (H (S i)), Hi. Qed. Lemma SF_cut_down_h s x : SF_h s <= x -> SF_h (SF_cut_down s x) = SF_h s. Proof. unfold SF_cut_down ; simpl. by case: Rle_dec. Qed. Lemma SF_cut_up_h s x : SF_h (SF_cut_up s x) = x. Proof. unfold SF_cut_up ; simpl. case: Rle_dec => //= ; simpl. move: {2 3}(SF_h s) ; apply SF_cons_ind with (s := s) => {s} [x1 | [x1 y1] s IH ] /= x0 Hx. by []. case: Rle_dec => //= Hx'. by apply IH. Qed. Lemma SF_cut_down_l s x : last (SF_h (SF_cut_down s x)) (SF_lx (SF_cut_down s x)) = x. Proof. unfold SF_cut_down ; simpl. case: Rle_dec => //= ; simpl. apply SF_cons_ind with (s := s) => {s} [x1 | [x1 y1] s IH ] /= Hx. by []. case: Rle_dec => //= Hx'. Qed. Lemma SF_cut_up_l s x : x <= last (SF_h s) (SF_lx s) -> last (SF_h (SF_cut_up s x)) (SF_lx (SF_cut_up s x)) = last (SF_h s) (SF_lx s). Proof. unfold SF_cut_down ; simpl. case: Rle_dec => //=. move: {3 4}(SF_h s); apply SF_cons_ind with (s := s) => {s} [x1 | [x1 y1] s IH ] /= x0 Hx Hx'. by apply Rle_antisym. case: Rle_dec => //= {} Hx. by apply IH. Qed. Lemma SF_cut_down_cons_0 h ptd x : x < fst h -> SF_cut_down (SF_cons h ptd) x = SF_nil x. Proof. intros H0. apply Rlt_not_le in H0. rewrite /SF_cut_down /=. by case: Rle_dec. Qed. Lemma SF_cut_up_cons_0 h ptd x : x < fst h -> SF_cut_up (SF_cons h ptd) x = SF_cons (x,Rmax (fst h) x) (SF_cons h ptd). Proof. intros H0. apply Rlt_not_le in H0. rewrite /SF_cut_up /=. by case: Rle_dec. Qed. Lemma SF_cut_down_cons_1 h ptd x : fst h <= x < SF_h ptd -> SF_cut_down (SF_cons h ptd) x = SF_cons (fst h, Rmin (snd h) x) (SF_nil x). Proof. intros [H0 Hx0]. apply Rlt_not_le in Hx0. rewrite /SF_cut_down /=. case: Rle_dec => //= _. by case: Rle_dec. Qed. Lemma SF_cut_up_cons_1 h ptd x : fst h <= x < SF_h ptd -> SF_cut_up (SF_cons h ptd) x = SF_cons (x,Rmax (snd h) x) ptd. Proof. intros [H0 Hx0]. apply Rlt_not_le in Hx0. rewrite /SF_cut_up /=. case: Rle_dec => //= _. by case: Rle_dec. Qed. Lemma SF_cut_down_cons_2 h ptd x : fst h <= SF_h ptd <= x -> SF_cut_down (SF_cons h ptd) x = SF_cons h (SF_cut_down ptd x). Proof. intros [H0 Hx0]. rewrite /SF_cut_down /=. case: Rle_dec (Rle_trans _ _ _ H0 Hx0) => //= _ _. by case: Rle_dec. Qed. Lemma SF_cut_up_cons_2 h ptd x : fst h <= SF_h ptd <= x -> SF_cut_up (SF_cons h ptd) x = SF_cut_up ptd x. Proof. intros [H0 Hx0]. rewrite /SF_cut_up /=. case: Rle_dec (Rle_trans _ _ _ H0 Hx0) => //= _ _. case: Rle_dec => //= _. move: {2 3}(SF_h ptd) Hx0 ; apply SF_cons_ind with (s := ptd) => {ptd H0} [ x0 | [x0 y0] ptd IH ] //= x0' Hx0. case: Rle_dec => //= Hx1. by apply IH. Qed. (** * Definition of SF_fun *) Section SF_fun. Context {T : Type}. Fixpoint SF_fun_aux (h : R*T) (s : seq (R*T)) (y0 : T) (x : R) := match s with | [::] => match Rle_dec x (fst h) with | left _ => snd h | right _ => y0 end | h0 :: s0 => match Rlt_dec x (fst h) with | left _ => snd h | right _ => SF_fun_aux h0 s0 y0 x end end. Definition SF_fun (s : SF_seq) (y0 : T) (x : R) := SF_fun_aux (SF_h s,y0) (SF_t s) y0 x. Lemma SF_fun_incr (s : SF_seq) (y0 : T) (x : R) Hs Hx : SF_fun s y0 x = match (sorted_dec (SF_lx s) 0 x Hs Hx) with | inleft H => nth y0 (SF_ly s) (proj1_sig H) | inright _ => nth y0 (SF_ly s) (SF_size s -1)%nat end. Proof. rewrite /SF_fun /=. (* s = SF_nil _ *) move: Hs Hx ; apply SF_cons_dec with (s := s) => {s} [/= x1 | h s] Hs /= Hx. case: sorted_dec => /= [[i Hi]|Hi] ; rewrite /SF_ly ; case: Rle_dec => //= ; case: i Hi => //. (* s = SF_cons _ (SF_nil _) *) case: Rlt_dec => [Hx' | _]. contradict Hx' ; apply Rle_not_lt, Hx. move: h Hs Hx ; apply SF_cons_ind with (s := s) => {s} [x1 | h0 s IH] h Hs /= Hx. case: sorted_dec => [/= [i [Hi' Hi]] /= |Hi]. by apply Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.nlt_0_r in Hi. case: Hx => Hx Hx' ; apply Rle_not_lt in Hx ; case: Rle_dec => //. (* s = SF_cons _ (SF_cons _ _) *) case: Rlt_dec => Hx'. case: sorted_dec => /= [[i Hi]|Hi]/=. case: i Hi => //= i Hi ; contradict Hx' ; apply Rle_not_lt, Rle_trans with (2 := proj1 (proj1 Hi)). simpl in Hs ; elim: (unzip1 (SF_t s)) (fst h0) (SF_h s) (i) (proj2 Hs) (proj2 Hi) => {s IH Hs Hx Hi h h0} [| h1 s IH] h h0 n Hs Hn. repeat apply <-Nat.succ_lt_mono in Hn ; by apply Nat.nlt_0_r in Hn. case: n Hn => [| n] Hn. apply Rle_refl. apply Rle_trans with (1 := proj1 Hs) => //= ; intuition. contradict Hx' ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hi). simpl in Hs ; elim: (unzip1 (SF_t s)) (fst h0) (SF_h s) (proj2 Hs) => {s IH Hs Hx Hi h h0} [| h1 s IH] h h0 Hs. apply Rle_refl. apply Rle_trans with (1 := proj1 Hs) => //= ; intuition. have : fst h0 <= x <= last (SF_h s) (unzip1 (SF_t s)) => [ | {} Hx']. split ; [by apply Rnot_lt_le | by apply Hx]. rewrite (IH h0 (proj2 Hs) Hx') => {IH} ; case: sorted_dec => [[i [Hxi Hi]]|Hi] ; case: sorted_dec => [[j [Hxj Hj]]|Hj] ; rewrite ?Nat.sub_0_r //=. (* i,j < size s - 2 *) move : h h0 i j Hs {Hx Hx'} Hxi Hi Hxj Hj ; apply SF_cons_ind with (s := s) => {s} [x1 | h1 s IH] h h0 i j Hs //= Hxi Hi Hxj Hj. by apply Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.nlt_0_r in Hi. case: j Hxj Hj => [/= | j] Hxj Hj. case: Hxj => _ Hxj ; contradict Hxj ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hxi). elim: (i) Hi => {i Hxi IH} //= [| i IH] Hi. apply Rle_refl. apply Rle_trans with (1 := IH (Nat.lt_trans _ _ _ (Nat.lt_succ_diag_r _) Hi)), (sorted_nth Rle) ; [apply Hs | simpl ; intuition]. case: i Hxi Hi => [/= | i] Hxi Hi. case: j Hxj Hj => [//= | j] Hxj Hj. case: Hxi => _ Hxi ; contradict Hxi ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hxj) ; elim: (j) Hj => {j Hxj IH} //= [| j IH] Hj. apply Rle_refl. apply Rle_trans with (1 := IH (Nat.lt_trans _ _ _ (Nat.lt_succ_diag_r _) Hj)), (sorted_nth Rle) ; [apply Hs | simpl ; intuition]. apply (IH h0 h1 i j) => //. apply Hs. apply Nat.succ_lt_mono, Hi. apply Nat.succ_lt_mono, Hj. (* i < j = size s - 2 *) simpl in Hxi, Hj ; case: Hxi => _ Hxi ; contradict Hxi ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hj). move: Hi Hs ; rewrite ?SF_lx_cons /SF_lx. elim: i (fst h) (fst h0) (SF_h s) (unzip1 (SF_t s)) => {s Hx Hx' Hj h y0 h0} [| i IH] h h0 h1 s Hi Hs. case: s Hi Hs => [| h2 s] Hi Hs /=. by apply Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.nlt_0_r in Hi. elim: s h h0 h1 h2 {Hi} Hs => [| h3 s IH] h h0 h1 h2 Hs /=. apply Rle_refl. apply Rle_trans with (r2 := h2). apply Hs. apply (IH h0 h1). apply (proj2 Hs). case: s Hi Hs => [| h2 s] Hi Hs. by apply Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.nlt_0_r in Hi. apply (IH h0 h1 h2 s). apply Nat.succ_lt_mono, Hi. apply Hs. (* j < i = size s - 2 *) simpl in Hxj, Hi ; case: Hxj => _ Hxj ; contradict Hxj ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hi). move: Hj Hs ; rewrite ?SF_lx_cons /SF_lx. rewrite Nat.sub_0_r ; elim: j (fst h) (fst h0) (SF_h s) (unzip1 (SF_t s)) => {s Hx Hx' Hi h y0 h0} [ | j IH] h h0 h1 s Hj Hs /=. elim: s h h0 h1 {Hj} Hs => [| h2 s IH] h h0 h1 Hs /=. apply Rle_refl. apply Rle_trans with (r2 := h1). apply Hs. apply (IH h0 h1 h2). apply (proj2 Hs). case: s Hj Hs => [| h2 s] Hj Hs. by apply Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.succ_lt_mono, Nat.nlt_0_r in Hj. apply (IH h0 h1 h2 s). apply Nat.succ_lt_mono, Hj. apply Hs. Qed. End SF_fun. Lemma SF_fun_map {T T0 : Type} (f : T -> T0) (s : SF_seq) y0 : forall x, SF_fun (SF_map f s) (f y0) x = f (SF_fun s y0 x). Proof. case: s => sh st ; rewrite /SF_fun /SF_map /= ; case: st => [| h st] x /=. by case: Rle_dec. case: Rlt_dec => //. elim: st sh h y0 x => [| h0 st IH] sh h y0 x Hx //=. by case: Rle_dec. case: Rlt_dec => // {} Hx. by apply: (IH (fst h)). Qed. (** * Particular SF_seq *) Definition SF_seq_f1 {T : Type} (f1 : R -> T) (P : seq R) : SF_seq := mkSF_seq (head 0 P) (pairmap (fun x y => (y, f1 x)) (head 0 P) (behead P)). Definition SF_seq_f2 {T : Type} (f2 : R -> R -> T) (P : seq R) : SF_seq := mkSF_seq (head 0 P) (pairmap (fun x y => (y, f2 x y)) (head 0 P) (behead P)). Lemma SF_cons_f1 {T : Type} (f1 : R -> T) (h : R) (P : seq R) : (0 < size P)%nat -> SF_seq_f1 f1 (h::P) = SF_cons (h,f1 h) (SF_seq_f1 f1 P). Proof. case: P => [ H | h0 P _] //. by apply Nat.nlt_0_r in H. Qed. Lemma SF_cons_f2 {T : Type} (f2 : R -> R -> T) (h : R) (P : seq R) : (0 < size P)%nat -> SF_seq_f2 f2 (h::P) = SF_cons (h,f2 h (head 0 P)) (SF_seq_f2 f2 P). Proof. case: P => [ H | h0 P _] //. by apply Nat.nlt_0_r in H. Qed. Lemma SF_size_f1 {T : Type} (f1 : R -> T) P : SF_size (SF_seq_f1 f1 P) = Peano.pred (size P). Proof. case: P => [| h P] //= ; by rewrite /SF_size /= size_pairmap. Qed. Lemma SF_size_f2 {T : Type} (f2 : R -> R -> T) P : SF_size (SF_seq_f2 f2 P) = Peano.pred (size P). Proof. case: P => [| h P] //= ; by rewrite /SF_size /= size_pairmap. Qed. Lemma SF_lx_f1 {T : Type} (f1 : R -> T) P : (0 < size P)%nat -> SF_lx (SF_seq_f1 f1 P) = P. Proof. elim: P => [ H | h l IH _] //=. by apply Nat.nlt_0_r in H. case: l IH => [ | h' l] //= IH. rewrite -{2}IH //. by apply Nat.lt_0_succ. Qed. Lemma SF_lx_f2 {T : Type} (f2 : R -> R -> T) P : (0 < size P)%nat -> SF_lx (SF_seq_f2 f2 P) = P. Proof. elim: P => [ H | h l IH _] //=. by apply Nat.nlt_0_r in H. case: l IH => [ | h' l] //= IH. rewrite -{2}IH //. by apply Nat.lt_0_succ. Qed. Lemma SF_ly_f1 {T : Type} (f1 : R -> T) P : SF_ly (SF_seq_f1 f1 P) = Rcomplements.belast (map f1 P). Proof. case: P => [| h P] // ; elim: P h => //= h P IH h0 ; by rewrite -(IH h). Qed. Lemma SF_ly_f2 {T : Type} (f2 : R -> R -> T) P : SF_ly (SF_seq_f2 f2 P) = behead (pairmap f2 0 P). Proof. case: P => [| h P] // ; elim: P h => //= h P IH h0 ; by rewrite -(IH h). Qed. Lemma SF_sorted_f1 {T : Type} (f1 : R -> T) P Ord : (sorted Ord P) <-> (SF_sorted Ord (SF_seq_f1 f1 P)). Proof. case: P => [ | h P] //. rewrite /SF_sorted SF_lx_f1 //. by apply Nat.lt_0_succ. Qed. Lemma SF_sorted_f2 {T : Type} (f2 : R -> R -> T) P Ord : (sorted Ord P) <-> (SF_sorted Ord (SF_seq_f2 f2 P)). Proof. case: P => [ | h P] //. rewrite /SF_sorted SF_lx_f2 //. by apply Nat.lt_0_succ. Qed. Lemma SF_rev_f2 {T : Type} (f2 : R -> R -> T) P : (forall x y, f2 x y = f2 y x) -> SF_rev (SF_seq_f2 f2 P) = SF_seq_f2 f2 (rev P). Proof. move => Hf2 ; apply SF_lx_ly_inj ; case: P => [ | h P] //=. rewrite SF_lx_rev !SF_lx_f2 ?rev_cons /= 1?headI // ; by apply Nat.lt_0_succ. rewrite SF_ly_rev !SF_ly_f2 /= ?rev_cons. elim: P h => [ | h0 P IH] h //=. rewrite !rev_cons pairmap_rcons behead_rcons ?(IH h0) ?(Hf2 h h0) //. rewrite size_pairmap size_rcons ; apply Nat.lt_0_succ. Qed. Lemma SF_map_f1 {T T0 : Type} (f : T -> T0) (f1 : R -> T) P : SF_map f (SF_seq_f1 f1 P) = SF_seq_f1 (fun x => f (f1 x)) P. Proof. case: P => [| h P] // ; elim: P h => [| h0 P IH] h //. rewrite ?(SF_cons_f1 _ _ (h0::P)) /= ; try intuition. rewrite SF_map_cons IH ; intuition. Qed. Lemma SF_map_f2 {T T0 : Type} (f : T -> T0) (f2 : R -> R -> T) P : SF_map f (SF_seq_f2 f2 P) = SF_seq_f2 (fun x y => f (f2 x y)) P. Proof. case: P => [| h P] // ; elim: P h => [| h0 P IH] h //. rewrite ?(SF_cons_f2 _ _ (h0::P)) /= ; try intuition. rewrite SF_map_cons IH ; intuition. Qed. Lemma ptd_f2 (f : R -> R -> R) s : sorted Rle s -> (forall x y, x <= y -> x <= f x y <= y) -> pointed_subdiv (SF_seq_f2 f s). Proof. intros Hs Hf. elim: s Hs => [ _ | h s]. intros i Hi. by apply Nat.nlt_0_r in Hi. case: s => [ | h' s] IH Hs. intros i Hi. by apply Nat.nlt_0_r in Hi. case => [ | i] Hi. apply Hf, Hs. apply IH. apply Hs. by apply Nat.succ_lt_mono. Qed. (** ** SF_fun *) Definition SF_fun_f1 {T : Type} (f1 : R -> T) (P : seq R) x : T := SF_fun (SF_seq_f1 f1 P) (f1 0) x. Definition SF_fun_f2 {T : Type} (f2 : R -> R -> T) (P : seq R) x := SF_fun (SF_seq_f2 f2 P) (f2 0 0) x. (** * Uniform partition *) Definition unif_part (a b : R) (n : nat) : seq R := mkseq (fun i => a + (INR i) * (b - a) / (INR n + 1)) (S (S n)). Lemma unif_part_bound (a b : R) (n : nat) : unif_part a b n = rev (unif_part b a n). Proof. apply (@eq_from_nth R 0) ; rewrite ?size_rev ?size_mkseq => // ; move => i Hi ; apply SSR_leq in Hi. rewrite nth_rev ?SSR_minus ?size_mkseq. 2: now apply SSR_leq. rewrite ?nth_mkseq. 3: now apply SSR_leq. rewrite minus_INR ?S_INR => // ; field. apply Rgt_not_eq, INRp1_pos. apply SSR_leq, INR_le ; rewrite ?S_INR minus_INR ?S_INR => //. apply Rminus_le_0 ; ring_simplify. apply pos_INR. Qed. Lemma unif_part_sort (a b : R) (n : nat) : a <= b -> sorted Rle (unif_part a b n). Proof. move => Hab ; apply sorted_nth => i Hi x0 ; rewrite ?size_mkseq in Hi ; rewrite ?nth_mkseq ?S_INR ; [ |apply SSR_leq ; intuition | apply SSR_leq ; intuition ]. apply Rminus_le_0 ; field_simplify ; [| apply Rgt_not_eq ; intuition] ; rewrite ?Rdiv_1 ; apply Rdiv_le_0_compat ; intuition. rewrite Rplus_comm ; by apply (proj1 (Rminus_le_0 _ _)). Qed. Lemma head_unif_part x0 (a b : R) (n : nat) : head x0 (unif_part a b n) = a. Proof. rewrite /= Rmult_0_l /Rdiv ; ring. Qed. Lemma last_unif_part x0 (a b : R) (n : nat) : last x0 (unif_part a b n) = b. Proof. rewrite (last_nth b) size_mkseq. replace (nth b (x0 :: unif_part a b n) (S (S n))) with (nth b (unif_part a b n) (S n)) by auto. rewrite nth_mkseq. rewrite S_INR ; field. by apply Rgt_not_eq, INRp1_pos. by []. Qed. Lemma unif_part_nat (a b : R) (n : nat) (x : R) : (a <= x <= b) -> {i : nat | nth 0 (unif_part a b n) i <= x < nth 0 (unif_part a b n) (S i) /\ (S (S i) < size (unif_part a b n))%nat} + {nth 0 (unif_part a b n) (n) <= x <= nth 0 (unif_part a b n) (S n)}. Proof. move: (sorted_dec (unif_part a b n) 0 x) => Hdec Hx. have Hs : sorted Rle (unif_part a b n) ; [ apply unif_part_sort, Rle_trans with (r2 := x) ; intuition | move: (Hdec Hs) => {Hs} Hdec]. have Hx' : (head 0 (unif_part a b n) <= x <= last 0 (unif_part a b n)). by rewrite head_unif_part last_unif_part. case: (Hdec Hx') => {Hdec Hx'} [[i Hi]|Hi]. left ; by exists i. right ; rewrite size_mkseq /= in Hi ; intuition. by rewrite Nat.sub_0_r in H1. Qed. Lemma seq_step_unif_part (a b : R) (n : nat) : seq_step (unif_part a b n) = Rabs ((b - a) / (INR n + 1)). Proof. assert (forall i, (S i < size (unif_part a b n))%nat -> (nth 0 (unif_part a b n) (S i) - nth 0 (unif_part a b n) i = (b - a) / (INR n + 1))%R). rewrite size_mkseq => i Hi. rewrite !nth_mkseq. rewrite S_INR /Rdiv /= ; ring. by apply SSR_leq, Nat.lt_le_incl. by apply SSR_leq. move: (eq_refl (size (unif_part a b n))). rewrite {2}size_mkseq. rewrite /seq_step ; elim: {2}(n) (unif_part a b n) H => [ | m IH] l //= ; destruct l as [ | x0 l] => //= ; destruct l as [ | x1 l] => //= ; destruct l as [ | x2 l] => //= ; intros. rewrite (H O). rewrite Rmax_comm /Rmax ; case: Rle_dec => // H1. contradict H1 ; by apply Rabs_pos. by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. rewrite -(IH (x1::x2::l)) /=. rewrite (H O). rewrite (H 1%nat). rewrite Rmax_assoc. apply f_equal2 => //. rewrite /Rmax ; by case: Rle_dec. by apply ->Nat.succ_lt_mono; apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. now intros ; apply (H (S i)); apply ->Nat.succ_lt_mono. by apply eq_add_S. Qed. Lemma seq_step_unif_part_ex (a b : R) (eps : posreal) : {n : nat | seq_step (unif_part a b n) < eps}. Proof. destruct (nfloor_ex (Rabs ((b - a) / eps))) as [n Hn]. by apply Rabs_pos. exists n. rewrite seq_step_unif_part. rewrite Rabs_div. rewrite (Rabs_pos_eq (INR n + 1)). apply Rlt_div_l. by apply INRp1_pos. rewrite Rmult_comm -Rlt_div_l. rewrite -(Rabs_pos_eq eps). rewrite -Rabs_div. by apply Hn. by apply Rgt_not_eq, eps. by apply Rlt_le, eps. by apply eps. by apply Rlt_le, INRp1_pos. by apply Rgt_not_eq, INRp1_pos. Qed. Lemma unif_part_S a b n : unif_part a b (S n) = a :: unif_part ((a * INR (S n) + b) / INR (S (S n))) b n. Proof. apply eq_from_nth with 0. by rewrite /= !size_map !size_iota. case => [ | i] Hi. by rewrite nth0 head_unif_part. change (nth 0 (a :: unif_part ((a * INR (S n) + b) / INR (S (S n))) b n) (S i)) with (nth 0 (unif_part ((a * INR (S n) + b) / INR (S (S n))) b n) i). rewrite /unif_part size_mkseq in Hi. rewrite /unif_part !nth_mkseq ; try by intuition. rewrite !S_INR ; field. rewrite -!S_INR ; split ; apply sym_not_eq, (not_INR 0), O_S. Qed. Definition SF_val_seq {T} (f : R -> T) (a b : R) (n : nat) : SF_seq := SF_seq_f2 (fun x y => f ((x+y)/2)) (unif_part a b n). Definition SF_val_fun {T} (f : R -> T) (a b : R) (n : nat) (x : R) : T := SF_fun_f2 (fun x y => f ((x+y)/2)) (unif_part a b n) x. Definition SF_val_ly {T} (f : R -> T) (a b : R) (n : nat) : seq T := behead (pairmap (fun x y => f ((x+y)/2)) 0 (unif_part a b n)). Lemma SF_val_ly_bound {T} (f : R -> T) (a b : R) (n : nat) : SF_val_ly f a b n = rev (SF_val_ly f b a n). Proof. rewrite /SF_val_ly (unif_part_bound b a). case: (unif_part a b n) => [| h s] // ; elim: s h => [| h0 s IH] h //=. rewrite ?rev_cons. replace (pairmap (fun x y : R => f ((x + y) / 2)) 0 (rcons (rcons (rev s) h0) h)) with (rcons (pairmap (fun x y : R => f ((x + y) / 2)) 0 (rcons (rev s) h0)) (f ((h0+h)/2))). rewrite behead_rcons. rewrite rev_rcons Rplus_comm -rev_cons -IH //. rewrite size_pairmap size_rcons ; apply Nat.lt_0_succ. move: (0) h h0 {IH} ; apply rcons_ind with (s := s) => {s} [| s h1 IH] x0 h h0 //. rewrite ?rev_rcons /= IH //. Qed. (** ** A proper filter on SF_seq *) Lemma Riemann_fine_unif_part : forall (f : R -> R -> R) (a b : R) (n : nat), (forall a b, a <= b -> a <= f a b <= b) -> a <= b -> seq_step (SF_lx (SF_seq_f2 f (unif_part a b n))) <= (b - a) / (INR n + 1) /\ pointed_subdiv (SF_seq_f2 f (unif_part a b n)) /\ SF_h (SF_seq_f2 f (unif_part a b n)) = a /\ last (SF_h (SF_seq_f2 f (unif_part a b n))) (SF_lx (SF_seq_f2 f (unif_part a b n))) = b. Proof. intros f a b n Hf Hab. assert (Hab' : 0 <= (b - a) / (INR n + 1)). apply Rdiv_le_0_compat. apply -> Rminus_le_0. apply Hab. apply INRp1_pos. unfold pointed_subdiv. rewrite SF_lx_f2. change (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n). split ; [|split ; [|split]]. - cut (forall i, (S i < size (unif_part a b n))%nat -> nth 0 (unif_part a b n) (S i) - nth 0 (unif_part a b n) i = (b - a) / (INR n + 1)). + induction (unif_part a b n) as [|x0 l IHl]. now intros _. intros H. destruct l as [|x1 l]. easy. change (seq_step _) with (Rmax (Rabs (x1 - x0)) (seq_step (x1 :: l))). apply Rmax_case. apply Req_le. rewrite (H 0%nat). now apply Rabs_pos_eq. apply ->Nat.succ_lt_mono. apply Nat.lt_0_succ. apply IHl. intros i Hi. apply (H (S i)). now apply ->Nat.succ_lt_mono. + rewrite size_mkseq. intros i Hi. rewrite !nth_mkseq. rewrite S_INR. unfold Rdiv. ring. apply SSR_leq. now apply Nat.lt_le_incl. now apply SSR_leq. - unfold pointed_subdiv. rewrite SF_size_f2. rewrite size_mkseq. intros i Hi. rewrite SF_ly_f2. rewrite nth_behead. apply Nat.lt_succ_r, SSR_leq in Hi. rewrite (nth_pairmap 0). change (nth 0 (0 :: unif_part a b n) (S i)) with (nth 0 (unif_part a b n) i). apply Hf. rewrite !nth_mkseq //. rewrite S_INR. lra. now apply ssrnat.leqW. by rewrite size_mkseq. - apply head_unif_part. - apply last_unif_part. rewrite size_mkseq ; by apply Nat.lt_0_succ. Qed. Definition Riemann_fine (a b : R) := within (fun ptd => pointed_subdiv ptd /\ SF_h ptd = Rmin a b /\ last (SF_h ptd) (SF_lx ptd) = Rmax a b) (locally_dist (fun ptd => seq_step (SF_lx ptd))). Global Instance Riemann_fine_filter : forall a b, ProperFilter (Riemann_fine a b). Proof. intros a b. constructor. - intros P [alpha H]. assert (Hab : Rmin a b <= Rmax a b). apply Rmax_case. apply Rmin_l. apply Rmin_r. assert (Hn : 0 <= ((Rmax a b - Rmin a b) / alpha)). apply Rdiv_le_0_compat. apply -> Rminus_le_0. apply Hab. apply cond_pos. set n := (nfloor _ Hn). exists (SF_seq_f2 (fun x y => x) (unif_part (Rmin a b) (Rmax a b) n)). destruct (Riemann_fine_unif_part (fun x y => x) (Rmin a b) (Rmax a b) n). intros u v Huv. split. apply Rle_refl. exact Huv. exact Hab. apply H. apply Rle_lt_trans with (1 := H0). apply Rlt_div_l. apply INRp1_pos. unfold n, nfloor. destruct nfloor_ex as [n' Hn']. simpl. rewrite Rmult_comm. apply Rlt_div_l. apply cond_pos. apply Hn'. exact H1. - apply within_filter. apply locally_dist_filter. Qed. (** * Riemann sums *) (** Riemann_sum *) Section Riemann_sum. Context {V : ModuleSpace R_Ring}. Definition Riemann_sum (f : R -> V) (ptd : SF_seq) : V := foldr plus zero (pairmap (fun x y => (scal (fst y - fst x) (f (snd y)))) (SF_h ptd,zero) (SF_t ptd)). Lemma Riemann_sum_cons (f : R -> V) (h0 : R * R) (ptd : SF_seq) : Riemann_sum f (SF_cons h0 ptd) = plus (scal (SF_h ptd - fst h0) (f (snd h0))) (Riemann_sum f ptd). Proof. rewrite /Riemann_sum /=. case: h0 => x0 y0 ; apply SF_cons_dec with (s := ptd) => {ptd} [ x1 | [x1 y1] ptd ] //=. Qed. Lemma Riemann_sum_rcons (f : R -> V) ptd l0 : Riemann_sum f (SF_rcons ptd l0) = plus (Riemann_sum f ptd) (scal (fst l0 - last (SF_h ptd) (SF_lx ptd)) (f (snd l0))). Proof. rewrite /Riemann_sum . case: l0 => x0 y0. apply SF_rcons_dec with (s := ptd) => {ptd} [ x1 | ptd [x1 y1]]. apply plus_comm. rewrite ?SF_map_rcons /=. rewrite pairmap_rcons foldr_rcons /=. rewrite unzip1_rcons last_rcons /=. set l := pairmap _ _ _. induction l ; simpl. apply plus_comm. rewrite IHl. apply plus_assoc. Qed. Lemma Riemann_sum_zero (f : R -> V) ptd : SF_sorted Rle ptd -> SF_h ptd = last (SF_h ptd) (SF_lx ptd) -> Riemann_sum f ptd = zero. Proof. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | [x0 y0] ptd IH] //= Hs Hhl. rewrite Riemann_sum_cons IH /= => {IH}. replace x0 with (SF_h ptd). rewrite Rminus_eq_0. rewrite plus_zero_r. by apply: scal_zero_l. apply Rle_antisym. rewrite Hhl => {Hhl} /=. apply (sorted_last (SF_h ptd :: @map (R*R) R (@fst R R) (SF_t ptd)) O) with (x0 := 0). replace ((SF_h ptd) :: map _ _) with (SF_lx ptd). apply Hs. apply SF_cons_ind with (s := ptd) => {ptd Hs} [x1 | [x1 y1] ptd IH] //=. apply Nat.lt_0_succ. apply Hs. apply Hs. apply Rle_antisym. apply (sorted_last (SF_h ptd :: @map (R*R) R (@fst R R) (SF_t ptd)) O) with (x0 := 0). replace ((SF_h ptd) :: map _ _) with (SF_lx ptd). apply Hs. apply SF_cons_ind with (s := ptd) => {ptd Hs Hhl} [x1 | [x1 y1] ptd IH] //=. apply Nat.lt_0_succ. move: Hhl ; rewrite -?(last_map (@fst R R)) /= => <- ; apply Hs. Qed. Lemma Riemann_sum_map (f : R -> V) (g : R -> R) ptd : Riemann_sum (fun x => f (g x)) ptd = Riemann_sum f (SF_map g ptd). Proof. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | h ptd IH]. by []. rewrite SF_map_cons !Riemann_sum_cons /=. by rewrite IH. Qed. Lemma Riemann_sum_const (v : V) ptd : Riemann_sum (fun _ => v) ptd = scal (last (SF_h ptd) (SF_lx ptd) - SF_h ptd) v. Proof. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | [x0 y0] s IH] /=. by rewrite /Riemann_sum /= Rminus_eq_0 scal_zero_l. rewrite Riemann_sum_cons IH /=. rewrite -scal_distr_r /=. apply (f_equal (fun x => scal x v)). rewrite /plus /=. ring. Qed. Lemma Riemann_sum_scal (a : R) (f : R -> V) ptd : Riemann_sum (fun x => scal a (f x)) ptd = scal a (Riemann_sum f ptd). Proof. apply SF_cons_ind with (s := ptd) => {ptd} /= [x0 | [x0 y0] s IH]. rewrite /Riemann_sum /=. apply sym_eq. apply @scal_zero_r. rewrite !Riemann_sum_cons /= IH. rewrite scal_distr_l. apply f_equal with (f := fun v => plus v _). rewrite 2!scal_assoc. by rewrite /mult /= Rmult_comm. Qed. Lemma Riemann_sum_opp (f : R -> V) ptd : Riemann_sum (fun x => opp (f x)) ptd = opp (Riemann_sum f ptd). Proof. apply SF_cons_ind with (s := ptd) => {ptd} /= [x0 | [x0 y0] s IH]. rewrite /Riemann_sum /=. rewrite opp_zero //. rewrite !Riemann_sum_cons /= IH. rewrite opp_plus. apply f_equal with (f := fun v => plus v (opp (Riemann_sum f s))). apply scal_opp_r. Qed. Lemma Riemann_sum_plus (f g : R -> V) ptd : Riemann_sum (fun x => plus (f x) (g x)) ptd = plus (Riemann_sum f ptd) (Riemann_sum g ptd). Proof. apply SF_cons_ind with (s := ptd) => {ptd} /= [x0 | [x0 y0] s IH]. rewrite /Riemann_sum /=. apply sym_eq, @plus_zero_l. rewrite !Riemann_sum_cons /= ; rewrite IH. rewrite scal_distr_l. rewrite -!plus_assoc. apply f_equal. rewrite !plus_assoc. apply (f_equal (fun x => plus x (Riemann_sum g s))). apply plus_comm. Qed. Lemma Riemann_sum_minus (f g : R -> V) ptd : Riemann_sum (fun x => minus (f x) (g x)) ptd = minus (Riemann_sum f ptd) (Riemann_sum g ptd). Proof. unfold minus. rewrite -Riemann_sum_opp. apply Riemann_sum_plus. Qed. End Riemann_sum. Section Riemann_sum_Normed. Context {V : NormedModule R_AbsRing}. Lemma Riemann_sum_Chasles_0 (f : R -> V) (M : R) (x : R) ptd : forall (eps : posreal), (forall x, SF_h ptd <= x <= last (SF_h ptd) (SF_lx ptd) -> norm (f x) < M) -> SF_h ptd <= x <= last (SF_h ptd) (SF_lx ptd) -> pointed_subdiv ptd -> seq_step (SF_lx ptd) < eps -> norm (minus (plus (Riemann_sum f (SF_cut_down ptd x)) (Riemann_sum f (SF_cut_up ptd x))) (Riemann_sum f ptd)) < 2 * eps * M. Proof. intros eps. apply (SF_cons_ind (T := R)) with (s := ptd) => {ptd} /= [ x0 | [x0 y1] ptd IH] /= Hfx [ Hx0 Hl] Hptd Hstep. + rewrite (Rle_antisym _ _ Hx0 Hl) ; clear -Hfx. rewrite /Riemann_sum /=. case: Rle_dec (Rle_refl x) => //= _ _. rewrite ?plus_zero_r Rminus_eq_0. rewrite scal_zero_l. rewrite /minus plus_zero_l norm_opp norm_zero. apply Rmult_lt_0_compat. apply Rmult_lt_0_compat. by apply Rlt_0_2. by apply eps. by apply Rle_lt_trans with (2:= (Hfx x0 (conj (Rle_refl _) (Rle_refl _)))), norm_ge_0. + case: (Rle_dec (SF_h ptd) x) => Hx1. - replace (minus (plus (Riemann_sum f (SF_cut_down (SF_cons (x0, y1) ptd) x)) (Riemann_sum f (SF_cut_up (SF_cons (x0, y1) ptd) x))) (Riemann_sum f (SF_cons (x0, y1) ptd))) with (minus (plus (Riemann_sum f (SF_cut_down ptd x)) (Riemann_sum f (SF_cut_up ptd x))) (Riemann_sum f ptd)). apply IH. intros y Hy. apply Hfx. split. apply Rle_trans with y1. by apply (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (SF_h ptd). by apply (Hptd O (Nat.lt_0_succ _)). by apply Hy. by apply Hy. by split. by apply ptd_cons in Hptd. apply Rle_lt_trans with (2 := Hstep). by apply Rmax_r. rewrite SF_cut_down_cons_2. rewrite SF_cut_up_cons_2. rewrite /minus 2?(Riemann_sum_cons _ (x0, y1)) SF_cut_down_h. rewrite opp_plus plus_assoc /=. apply (f_equal (fun x => plus x _)). rewrite (plus_comm (scal (SF_h ptd - x0) (f y1))) -3!plus_assoc. apply f_equal. by rewrite plus_comm -plus_assoc plus_opp_l plus_zero_r. by []. split ; [ | apply Hx1]. apply Rle_trans with y1 ; by apply (Hptd O (Nat.lt_0_succ _)). split ; [ | apply Hx1]. apply Rle_trans with y1 ; by apply (Hptd O (Nat.lt_0_succ _)). - apply Rnot_le_lt in Hx1. rewrite SF_cut_down_cons_1 /=. rewrite SF_cut_up_cons_1 /=. rewrite 3!Riemann_sum_cons /= => {IH}. replace (Riemann_sum f (SF_nil x) : V) with (zero : V) by auto. rewrite plus_zero_r /minus opp_plus. rewrite (plus_comm (opp (scal (SF_h ptd - x0) (f y1)))). rewrite ?plus_assoc -(plus_assoc _ _ (opp (Riemann_sum f ptd))). rewrite plus_opp_r plus_zero_r. rewrite -scal_opp_l. rewrite /opp /= Ropp_minus_distr. rewrite /Rmin /Rmax ; case: Rle_dec => _. rewrite (plus_comm (scal (x - x0) (f y1))) -plus_assoc. rewrite -scal_distr_r /plus /= -/plus. ring_simplify (x - x0 + (x0 - SF_h ptd)). eapply Rle_lt_trans. apply @norm_triangle. replace (2 * eps * M) with (eps * M + eps * M) by ring. apply Rplus_lt_compat ; eapply Rle_lt_trans ; try (apply @norm_scal) ; apply Rmult_le_0_lt_compat. by apply Rabs_pos. by apply norm_ge_0. apply Rle_lt_trans with (2 := Hstep). apply Rle_trans with (2 := Rmax_l _ _). simpl. apply Rlt_le in Hx1. move: (Rle_trans _ _ _ Hx0 Hx1) => Hx0'. apply Rminus_le_0 in Hx1. apply Rminus_le_0 in Hx0'. rewrite /abs /= ?Rabs_pos_eq //. by apply Rplus_le_compat_l, Ropp_le_contravar. apply Hfx. by split. by apply Rabs_pos. by apply norm_ge_0. apply Rle_lt_trans with (2 := Hstep). apply Rle_trans with (2 := Rmax_l _ _). rewrite /abs /plus /= -Ropp_minus_distr Rabs_Ropp. apply Rlt_le in Hx1. move: (Rle_trans _ _ _ Hx0 Hx1) => Hx0'. apply Rminus_le_0 in Hx1. apply Rminus_le_0 in Hx0'. rewrite ?Rabs_pos_eq //. by apply Rplus_le_compat_l, Ropp_le_contravar. apply Hfx. split. apply (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (SF_h ptd). apply (Hptd O (Nat.lt_0_succ _)). apply (fun H => sorted_last ((SF_h ptd) :: (unzip1 (SF_t ptd))) O H (Nat.lt_0_succ _) (SF_h ptd)). apply ptd_sort in Hptd. by apply Hptd. rewrite -plus_assoc -scal_distr_r /plus /= -/plus. replace (SF_h ptd - x + (x0 - SF_h ptd)) with (opp (x - x0)) by (rewrite /opp /= ; ring). rewrite scal_opp_l -scal_opp_r. rewrite -scal_distr_l. eapply Rle_lt_trans. apply @norm_scal. replace (2 * eps * M) with (eps * (M + M)) by ring. apply Rmult_le_0_lt_compat. by apply Rabs_pos. by apply norm_ge_0. apply Rle_lt_trans with (2 := Hstep). apply Rle_trans with (2 := Rmax_l _ _). simpl. apply Rlt_le in Hx1. move: (Rle_trans _ _ _ Hx0 Hx1) => Hx0'. apply Rminus_le_0 in Hx0. apply Rminus_le_0 in Hx0'. rewrite /abs /= ?Rabs_pos_eq //. by apply Rplus_le_compat_r. apply Rle_lt_trans with (norm (f x) + norm (opp (f y1))). apply @norm_triangle. apply Rplus_lt_compat. apply Hfx. by split. rewrite norm_opp. apply Hfx. split. apply (Hptd O (Nat.lt_0_succ _)). apply Rle_trans with (SF_h ptd). apply (Hptd O (Nat.lt_0_succ _)). apply (fun H => sorted_last ((SF_h ptd) :: (unzip1 (SF_t ptd))) O H (Nat.lt_0_succ _) (SF_h ptd)). apply ptd_sort in Hptd. by apply Hptd. by split. by split. Qed. Lemma Riemann_sum_norm (f : R -> V) (g : R -> R) ptd : pointed_subdiv ptd -> (forall t, SF_h ptd <= t <= last (SF_h ptd) (SF_lx ptd) -> norm (f t) <= g t) -> norm (Riemann_sum f ptd) <= Riemann_sum g ptd. Proof. apply SF_cons_ind with (s := ptd) => {ptd} /= [x0 | [x0 y0] s IH] /= Hs H. rewrite norm_zero ; exact: Rle_refl. rewrite !Riemann_sum_cons /=. eapply Rle_trans. by apply @norm_triangle. apply Rplus_le_compat. eapply Rle_trans. apply @norm_scal. refine (_ (Hs O _)). simpl. intros [H1 H2]. rewrite /abs /= Rabs_pos_eq. apply Rmult_le_compat_l. apply -> Rminus_le_0. now apply Rle_trans with y0. apply H. apply (conj H1). apply Rle_trans with (1 := H2). apply (sorted_last (SF_lx s) O) with (x0 := 0). by apply (ptd_sort _ Hs). exact: Nat.lt_0_succ. apply -> Rminus_le_0. now apply Rle_trans with y0. exact: Nat.lt_0_succ. apply IH. by apply ptd_cons with (h := (x0,y0)). move => t Ht ; apply H ; split. by apply Rle_trans with (2 := proj1 Ht), (ptd_sort _ Hs). by apply Ht. Qed. End Riemann_sum_Normed. Lemma Riemann_sum_le (f : R -> R) (g : R -> R) ptd : pointed_subdiv ptd -> (forall t, SF_h ptd <= t <= last (SF_h ptd) (SF_lx ptd) -> f t <= g t) -> Riemann_sum f ptd <= Riemann_sum g ptd. Proof. apply SF_cons_ind with (s := ptd) => {ptd} /= [x0 | [x0 y0] s IH] /= Hs H. apply Rle_refl. rewrite !Riemann_sum_cons /=. apply Rplus_le_compat. refine (_ (Hs O _)). simpl. intros [H1 H2]. apply Rmult_le_compat_l. apply -> Rminus_le_0. now apply Rle_trans with y0. apply H. apply (conj H1). apply Rle_trans with (1 := H2). apply (sorted_last (SF_lx s) O) with (x0 := 0). by apply (ptd_sort _ Hs). exact: Nat.lt_0_succ. exact: Nat.lt_0_succ. apply IH. by apply ptd_cons with (h := (x0,y0)). move => t Ht ; apply H ; split. by apply Rle_trans with (2 := proj1 Ht), (ptd_sort _ Hs). by apply Ht. Qed. (** Structures *) Lemma Riemann_sum_pair {U : ModuleSpace R_Ring} {V : ModuleSpace R_Ring} (f : R -> U * V) ptd : Riemann_sum f ptd = (Riemann_sum (fun t => fst (f t)) ptd, Riemann_sum (fun t => snd (f t)) ptd). Proof. apply SF_cons_ind with (s := ptd) => {ptd} [x0 | h0 ptd IH]. by []. rewrite !Riemann_sum_cons IH. by apply injective_projections. Qed. (** RInt_val *) Section RInt_val. Context {V : ModuleSpace R_Ring}. Definition RInt_val (f : R -> V) (a b : R) (n : nat) := Riemann_sum f (SF_seq_f2 (fun x y => (x + y) / 2) (unif_part a b n)). Lemma RInt_val_point (f : R -> V) (a : R) (n : nat) : RInt_val f a a n = zero. Proof. unfold RInt_val ; apply Riemann_sum_zero. rewrite /SF_sorted SF_lx_f2. apply unif_part_sort ; apply Rle_refl. rewrite size_mkseq ; by apply Nat.lt_0_succ. rewrite SF_lx_f2 /=. rewrite -{2}[1]/(INR 1) last_map. unfold Rdiv ; ring. by apply Nat.lt_0_succ. Qed. Lemma RInt_val_swap : forall (f : R -> V) (a b : R) (n : nat), RInt_val f a b n = opp (RInt_val f b a n). Proof. intros f a b n. rewrite /RInt_val. rewrite -Riemann_sum_opp. rewrite unif_part_bound. elim: (unif_part b a n) => [ | x1 s IH] /=. by []. clear -IH. rewrite rev_cons. destruct s as [ | x2 s]. by []. rewrite SF_cons_f2. 2: by apply Nat.lt_0_succ. rewrite Riemann_sum_cons /= -IH => {IH}. rewrite scal_opp_r -scal_opp_l /=. rewrite rev_cons. elim: (rev s) => {s} /= [ | x3 s IH]. rewrite /Riemann_sum /=. apply (f_equal2 (fun x y => plus (scal x (f y)) _)) ; rewrite /Rdiv /opp /= ; ring. rewrite !SF_cons_f2 ; try (by rewrite size_rcons ; apply Nat.lt_0_succ). rewrite !Riemann_sum_cons /= IH !plus_assoc => {IH}. apply (f_equal (fun x => plus x _)). rewrite plus_comm. apply f_equal. apply (f_equal2 (fun x y => scal (x - x3) (f ((x3 + y) / 2)))) ; clear ; by elim: s. Qed. Lemma RInt_val_ext (f g : R -> V) (a b : R) (n : nat) : (forall x, Rmin a b <= x <= Rmax a b -> f x = g x) -> RInt_val g a b n = RInt_val f a b n. Proof. wlog: a b / (a <= b) => [Hw | Hab]. case: (Rle_lt_dec a b) => Hab. by apply Hw. rewrite Rmin_comm Rmax_comm => Heq. apply Rlt_le in Hab. rewrite RInt_val_swap Hw => //=. apply sym_eq ; by apply RInt_val_swap. rewrite /Rmin /Rmax ; case: Rle_dec => //= _ Heq. unfold RInt_val. set l := (SF_seq_f2 (fun x y : R => (x + y) / 2) (unif_part a b n)). assert (forall i, (i < size (SF_ly l))%nat -> f (nth 0 (SF_ly l) i) = g (nth 0 (SF_ly l) i)). move => i Hi. apply Heq. destruct (fun H0 => Riemann_fine_unif_part (fun x y : R => (x + y) / 2) a b n H0 Hab) as [H [H0 [H1 H2]]]. clear. intros a b Hab. lra. fold l in H, H0, H1, H2. rewrite -H1 -H2 ; split. apply Rle_trans with (head 0 (SF_ly l)). apply (H0 O). by apply Nat.lt_0_succ. apply sorted_head. by apply ptd_sort'. by []. apply Rle_trans with (last 0 (SF_ly l)). apply sorted_last. by apply ptd_sort'. by []. rewrite -!nth_last SF_size_ly SF_size_lx SF_size_f2 size_mkseq. simpl Peano.pred. replace (nth (SF_h l) (SF_lx l) (S n)) with (nth 0 (SF_lx l) (S n)). apply (H0 n). rewrite SF_size_f2 size_mkseq /=. by apply Nat.lt_succ_diag_r. rewrite SF_lx_f2. assert (size (unif_part a b n) = S (S n)). by apply size_mkseq. elim: (S n) (unif_part a b n) H3 ; simpl ; clear ; intros. destruct unif_part0 ; simpl => //. replace unif_part0 with (head 0 unif_part0 :: behead unif_part0). apply H. destruct unif_part0 ; by intuition. destruct unif_part0 ; by intuition. by apply Nat.lt_0_succ. move: H => {Heq}. apply SF_cons_ind with (s := l) => {l} [x0 | h0 s IH] /= Heq. by []. rewrite !Riemann_sum_cons. apply (f_equal2 (fun x y => plus (scal (SF_h s - fst h0) x) y)). by apply sym_eq, (Heq O), Nat.lt_0_succ. apply IH => i Hi. now apply (Heq (S i)); apply ->Nat.succ_lt_mono. Qed. Lemma RInt_val_comp_opp (f : R -> V) (a b : R) (n : nat) : RInt_val (fun x => f (- x)) a b n = opp (RInt_val f (- a) (- b) n). Proof. rewrite /RInt_val. replace (unif_part (- a) (- b) n) with (map Ropp (unif_part a b n)). elim: (unif_part a b n) {1}0 {2}0 => /= [ | x1 s IH] x0 x0'. rewrite /Riemann_sum /=. rewrite opp_zero //. destruct s as [ | x2 s]. rewrite /Riemann_sum /=. rewrite opp_zero //. rewrite (SF_cons_f2 _ x1) ; try by apply Nat.lt_0_succ. rewrite (SF_cons_f2 _ (- x1)) ; try by apply Nat.lt_0_succ. rewrite !Riemann_sum_cons /=. rewrite opp_plus. apply f_equal2. rewrite -scal_opp_l. apply (f_equal2 (fun x y => scal x (f y))) ; rewrite /Rdiv /opp /= ; field. by apply IH. apply eq_from_nth with 0. by rewrite size_map !size_mkseq. rewrite size_map => i Hi. rewrite (nth_map 0 0) => //. rewrite size_mkseq in Hi. rewrite !nth_mkseq => //. field. now rewrite -S_INR ; apply not_0_INR, sym_not_eq, O_S. Qed. Lemma RInt_val_comp_lin (f : R -> V) (u v : R) (a b : R) (n : nat) : scal u (RInt_val (fun x => f (u * x + v)) a b n) = RInt_val f (u * a + v) (u * b + v) n. Proof. rewrite /RInt_val. replace (unif_part (u * a + v) (u * b + v) n) with (map (fun x => u * x + v) (unif_part a b n)). elim: (unif_part a b n) {1}0 {2}0 => /= [ | x1 s IH] x0 x0'. by apply @scal_zero_r. destruct s as [ | x2 s]. by apply @scal_zero_r. rewrite (SF_cons_f2 _ x1) ; try by apply Nat.lt_0_succ. rewrite (SF_cons_f2 _ (u * x1 + v)) ; try by apply Nat.lt_0_succ. rewrite !Riemann_sum_cons /=. rewrite scal_distr_l. apply f_equal2. rewrite scal_assoc. apply (f_equal2 (fun x y => scal x (f y))) ; rewrite /mult /= ; field. by apply IH. apply eq_from_nth with 0. by rewrite size_map !size_mkseq. rewrite size_map => i Hi. rewrite (nth_map 0 0) => //. rewrite size_mkseq in Hi. rewrite !nth_mkseq => //. field. now rewrite -S_INR ; apply not_0_INR, sym_not_eq, O_S. Qed. End RInt_val. (** ** From SF_seq to StepFun *) (** Alternative Chasles relation *) Fixpoint seq_cut_down' (s : seq (R*R)) (x x0 : R) : seq (R*R) := match s with | [::] => [:: (x,x0)] | h :: t => match Rle_dec (fst h) x with | right _ => [:: (x,snd h)] | left _ => h :: (seq_cut_down' t x (snd h)) end end. Fixpoint seq_cut_up' (s : seq (R*R)) (x x0 : R) : seq (R*R) := match s with | [::] => [:: (x,x0)] | h :: t => match Rle_dec (fst h) x with | right _ => (x,x0)::h::t | left _ => seq_cut_up' t x (snd h) end end. Definition SF_cut_down' (sf : @SF_seq R) (x : R) x0 := let s := seq_cut_down' ((SF_h sf,x0) :: (SF_t sf)) x x0 in mkSF_seq (fst (head (SF_h sf,x0) s)) (behead s). Definition SF_cut_up' (sf : @SF_seq R) (x : R) x0 := let s := seq_cut_up' ((SF_h sf,x0) :: (SF_t sf)) x x0 in mkSF_seq (fst (head (SF_h sf,x0) s)) (behead s). Lemma SF_Chasles {V : ModuleSpace R_AbsRing} (f : R -> V) (s : SF_seq) x x0 : (SF_h s <= x <= last (SF_h s) (unzip1 (SF_t s))) -> Riemann_sum f s = plus (Riemann_sum f (SF_cut_down' s x x0)) (Riemann_sum f (SF_cut_up' s x x0)). Proof. rename x0 into z0. apply SF_cons_ind with (s := s) => {s} /= [ x0 | [x0 y0] s IH] /= Hx. rewrite (Rle_antisym _ _ (proj1 Hx) (proj2 Hx)). move: (Rle_refl x). rewrite /SF_cut_down' /SF_cut_up' /= ; case: Rle_dec => //= _ _. by rewrite /Riemann_sum /= Rminus_eq_0 scal_zero_l !plus_zero_l. move: (fun Hx1 => IH (conj Hx1 (proj2 Hx))) => {IH}. rewrite /SF_cut_down' /SF_cut_up' /= ; case: (Rle_dec x0 _) (proj1 Hx) => //= Hx0 _. case: (Rle_dec (SF_h s) x) => //= Hx1 IH. move: (IH Hx1) => {} IH. rewrite (Riemann_sum_cons _ (x0,y0)) (Riemann_sum_cons _ (x0,y0) (mkSF_seq (SF_h s) (seq_cut_down' (SF_t s) x y0))) IH /= => {IH}. rewrite -!plus_assoc ; apply f_equal. assert (forall x0 y0, fst (head (x0, z0) (seq_cut_up' (SF_t s) x y0)) = x). elim: (SF_t s) => [ | x2 t IH] x1 y1 //=. by case: Rle_dec. rewrite ?H. move: (proj2 Hx) Hx1 => {Hx} ; apply SF_cons_dec with (s := s) => {s H} /= [x1 | [x1 y1] s] //= Hx Hx1. by rewrite /Riemann_sum /= (Rle_antisym _ _ Hx Hx1) Rminus_eq_0 !scal_zero_l !plus_zero_l. case: Rle_dec => //. rewrite Riemann_sum_cons (Riemann_sum_cons _ (x,y0) s) {2}/Riemann_sum /=. clear IH. rewrite plus_zero_r !plus_assoc. apply f_equal2 => //. rewrite -scal_distr_r. apply f_equal2 => //. rewrite /plus /= ; ring. Qed. Lemma seq_cut_up_head' (s : seq (R*R)) x x0 z : fst (head z (seq_cut_up' s x x0)) = x. Proof. elim: s z x0 => [ | x1 s IH] //= z x0. by case: Rle_dec. Qed. (** Build StepFun using SF_seq *) Lemma ad_SF_compat z0 (s : SF_seq) (pr : SF_sorted Rle s) : adapted_couple (SF_fun s z0) (head 0 (SF_lx s)) (last 0 (SF_lx s)) (SF_lx s) (SF_ly s). Proof. (* head and last *) have H : ((head 0 (SF_lx s)) <= (last 0 (SF_lx s))). move: pr ; rewrite /SF_sorted. case: (SF_lx s) => {s} [| h s] Hs. apply Rle_refl. rewrite -nth0 ; apply sorted_last => // ; apply Nat.lt_0_succ. rewrite /adapted_couple ?nth_compat ?size_compat ?nth0 ?nth_last /Rmin /Rmax ?SF_size_lx ?SF_size_ly ; case: (Rle_dec (head 0 (SF_lx s)) (last 0 (SF_lx s))) => // {H} _ ; intuition. (* sorted *) apply sorted_compat => //. (* adapted *) move: i pr H ; apply SF_cons_dec with (s := s) => {s} [x0 | h s] i Hs Hi x [Hx0 Hx1]. by apply Nat.nlt_0_r in Hi. rewrite /SF_fun ?SF_size_cons ?nth_compat -?SF_size_lx ?SF_lx_cons in Hi, Hx0, Hx1 |- *. simpl. move: h i x {1}z0 Hs Hi Hx0 Hx1 ; apply SF_cons_ind with (s := s) => {s} [x1 | h0 s IH] h ; case => [| i ] x z0' Hs Hi Hx0 Hx1 //= ; case: Rlt_dec => Hx' //. now contradict Hx' ; apply Rle_not_lt, Rlt_le, Hx0. now case: Rle_dec => Hx'' // ; contradict Hx'' ; apply Rlt_le, Hx1. now rewrite /= in Hi ; by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. now rewrite /= in Hi ; by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. now contradict Hx' ; apply Rle_not_lt, Rlt_le, Hx0. now case: Rlt_dec => Hx'' //. now contradict Hx' ; apply Rle_not_lt, Rlt_le, Rle_lt_trans with (2 := Hx0) ; have Hi' : (S i < size (SF_lx (SF_cons h (SF_cons h0 s))))%nat ; [ rewrite ?SF_lx_cons /= in Hi |-* ; apply Nat.lt_trans with (1 := Hi), Nat.lt_succ_diag_r | ] ; apply (sorted_head (SF_lx (SF_cons h (SF_cons h0 s))) (S i) Hs Hi' 0). rewrite -(IH h0 i x (snd h)) //=. apply Hs. rewrite ?SF_lx_cons /= in Hi |-* ; apply Nat.succ_lt_mono, Hi. Qed. Definition SF_compat_le (s : @SF_seq R) (pr : SF_sorted Rle s) : StepFun (head 0 (SF_lx s)) (last 0 (SF_lx s)). Proof. exists (SF_fun s 0) ; exists (SF_lx s) ; exists (SF_ly s). by apply ad_SF_compat. Defined. Lemma Riemann_sum_compat f (s : SF_seq) (pr : SF_sorted Rle s) : Riemann_sum f s = RiemannInt_SF (SF_compat_le (SF_map f s) (SF_map_sort f s _ pr)). Proof. rewrite /RiemannInt_SF ; case: Rle_dec => // [_ | H]. move: pr ; apply SF_cons_ind with (s := s) => {s} [x0 | h s IH] pr //=. rewrite /= -IH /Riemann_sum /SF_map /= => {IH}. rewrite Rmult_comm. by apply SF_cons_dec with (s := s). apply pr. contradict H ; rewrite -nth_last -nth0 ; move: (Nat.le_refl (ssrnat.predn (size (SF_lx (SF_map f s))))) ; elim: {1 3}(ssrnat.predn (size (SF_lx (SF_map f s)))) => /= [| i IH] Hi. apply Rle_refl. apply Rle_trans with (1 := IH (Nat.le_trans _ _ _ (Nat.le_succ_diag_r i) Hi)), (sorted_nth Rle) ; intuition. by apply SF_map_sort. Qed. (** Build StepFun using uniform partition *) Lemma ad_SF_val_fun (f : R -> R) (a b : R) (n : nat) : ((a <= b) -> adapted_couple (SF_val_fun f a b n) a b (unif_part a b n) (SF_val_ly f a b n)) /\ (~(a <= b) -> adapted_couple (SF_val_fun f b a n) a b (unif_part b a n) (SF_val_ly f b a n)). Proof. wlog : a b / (a <= b) => Hw. split ; case: (Rle_dec a b) => // Hab _. by apply Hw. apply StepFun_P2 ; apply Hw ; by apply Rlt_le, Rnot_le_lt. split ; case: (Rle_dec a b) => // {Hw} Hab _. have : (a = head 0 (SF_lx (SF_val_seq f a b n))) ; [rewrite SF_lx_f2 /= ; (try by apply Nat.lt_0_succ) ; field ; apply Rgt_not_eq ; intuition | move => {2}->]. pattern b at 3 ; replace b with (last 0 (SF_lx (SF_val_seq f a b n))). rewrite -(SF_lx_f2 (fun x y => f ((x+y)/2)) (unif_part a b n)) ; try by apply Nat.lt_0_succ. rewrite /SF_val_ly -SF_ly_f2. unfold SF_val_fun, SF_fun_f2. replace (SF_seq_f2 (fun x y : R => f ((x + y) / 2)) (unif_part a b n)) with (SF_val_seq f a b n) by auto. apply (ad_SF_compat _ (SF_val_seq f a b n)). by apply SF_sorted_f2, unif_part_sort. rewrite SF_lx_f2 ; replace (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n) by auto. rewrite -nth_last size_mkseq nth_mkseq ?S_INR //= ; field ; apply Rgt_not_eq, INRp1_pos. now rewrite size_mkseq ; apply Nat.lt_0_succ. Qed. Definition sf_SF_val_fun (f : R -> R) (a b : R) (n : nat) : StepFun a b. Proof. case : (Rle_dec a b) => Hab. exists (SF_val_fun f a b n) ; exists (unif_part a b n) ; exists (SF_val_ly f a b n) ; by apply ad_SF_val_fun. exists (SF_val_fun f b a n) ; exists (unif_part b a n) ; exists (SF_val_ly f b a n) ; by apply ad_SF_val_fun. Defined. Lemma SF_val_subdiv (f : R -> R) (a b : R) (n : nat) : subdivision (sf_SF_val_fun f a b n) = match (Rle_dec a b) with | left _ => unif_part a b n | right _ => unif_part b a n end. Proof. rewrite /sf_SF_val_fun ; case: (Rle_dec a b) => Hab //. Qed. Lemma SF_val_subdiv_val (f : R -> R) (a b : R) (n : nat) : subdivision_val (sf_SF_val_fun f a b n) = match (Rle_dec a b) with | left _ => SF_val_ly f a b n | right _ => SF_val_ly f b a n end. Proof. rewrite /sf_SF_val_fun ; case: (Rle_dec a b) => Hab //. Qed. Lemma SF_val_fun_rw (f : R -> R) (a b : R) (n : nat) (x : R) (Hx : a <= x <= b) : SF_val_fun f a b n x = match (unif_part_nat a b n x Hx) with | inleft H => f (a + (INR (proj1_sig H) + /2) * (b-a) / (INR n + 1)) | inright _ => f (a + (INR n + /2) * (b-a) / (INR n + 1)) end. Proof. have Hab : (a <= b) ; [by apply Rle_trans with (1 := proj1 Hx), Hx | ]. case: unif_part_nat => {Hx} [ [ i [Hx Hi] ] | Hx] /=. (* i < 2^n - 1 *) rewrite /SF_val_fun /SF_fun_f2. replace (a + (INR i + /2) * (b - a) / (INR n+1)) with ((nth 0 (unif_part a b n) i + nth 0 (unif_part a b n) (S i)) / 2) ; [ | rewrite size_mkseq in Hi ; rewrite ?nth_mkseq ?S_INR ; [field ; apply Rgt_not_eq | apply SSR_leq | apply SSR_leq ] ; intuition]. case: (unif_part a b n) (unif_part_sort a b n Hab) i Hi x Hx => {a b Hab n} [| h s] Hs /= i Hi. by apply Nat.nlt_0_r in Hi. case: (s) Hs (i) ((proj2 (Nat.succ_lt_mono _ _) Hi)) => {s i Hi} [| h0 s] Hs /= i Hi. by apply Nat.nlt_0_r in Hi. elim: (s) h h0 Hs (i) (proj2 (Nat.succ_lt_mono _ _) Hi) => {s i Hi} [|h1 s IH] h h0 Hs /= i Hi x Hx. by apply Nat.nlt_0_r in Hi. case: i Hx Hi => [|i]/= Hx Hi. rewrite /SF_fun /=. case: Rlt_dec => [Hx0 | _ ]. contradict Hx0 ; apply Rle_not_lt, Hx. case: Rlt_dec => // Hx0 ; contradict Hx0 ; apply Hx. rewrite -(IH h0 h1 (proj2 Hs) i ((proj2 (Nat.succ_lt_mono _ _) Hi)) x Hx). rewrite /SF_fun /= ; case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (1 := proj1 Hs), Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. (* i = 2^n - 1 *) replace (a + (INR n + /2) * (b - a) / (INR n + 1)) with ((nth 0 (unif_part a b n) (n) + nth 0 (unif_part a b n) (S n)) / 2) ; [ | rewrite ?nth_mkseq ?minus_INR ?S_INR /= ; [field ; apply Rgt_not_eq | apply SSR_leq | apply SSR_leq ] ; intuition]. suff : (1 < size (unif_part a b n))%nat. move: x Hx ; have: (n = size (unif_part a b n) - 2)%nat ; [ rewrite size_mkseq ; intuition | ]. move => {2 4 8 10}->. rewrite /SF_val_fun /SF_fun_f2. case: (unif_part a b n) (unif_part_sort a b n Hab) => {a b Hab n} [| h s Hs x Hx /= Hi] . intros _ x Hx Hi. by apply Nat.nlt_0_r in Hi. case: s h Hs Hi x Hx => [| h0 s] h Hs /= Hi. by apply Nat.lt_irrefl in Hi. elim: s h h0 Hs {Hi} => [| h1 s IH] h h0 Hs /= x Hx. rewrite /SF_fun /= ; case: Rlt_dec => [Hx0 | _]. contradict Hx0 ; apply Rle_not_lt, Hx. case: Rle_dec => [| Hx0] // ; contradict Hx0 ; apply Hx. rewrite Nat.sub_0_r in IH. rewrite -(IH h0 h1 (proj2 Hs) x Hx ). rewrite /SF_fun /= ; case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (1 := proj1 Hs), Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. rewrite size_mkseq ; by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. Qed. Lemma RInt_val_Reals (f : R -> R) (a b : R) (n : nat) : RInt_val f a b n = RiemannInt_SF (sf_SF_val_fun f a b n). Proof. rewrite /RiemannInt_SF SF_val_subdiv SF_val_subdiv_val ; case: Rle_dec => Hab. (* a <= b *) rewrite /RInt_val /SF_val_ly ; case: (unif_part a b n) => [| h s] /=. by []. elim: s h => [|h0 s IH] h /=. by []. rewrite (SF_cons_f2 _ h). 2: by apply Nat.lt_0_succ. rewrite Riemann_sum_cons /= IH /plus /scal /= /mult /=. ring. (* ~ a <= Rmult_plus_distr_l (b )*) rewrite RInt_val_swap /SF_val_ly /RInt_val. simpl opp ; apply f_equal. case: (unif_part b a n) => [| h s] /=. by []. elim: s h => [|h0 s IH] h /=. by []. rewrite SF_cons_f2. 2: by apply Nat.lt_0_succ. rewrite Riemann_sum_cons IH /= /plus /scal /= /mult /=. ring. Qed. (** ** Upper and lower step functions *) Lemma ex_Im_fct (f : R -> R) (a b : R) : a <> b -> exists x, (fun y => exists x, y = f x /\ Rmin a b < x < Rmax a b) x. Proof. exists (f ((a+b)/2)) ; exists ((a+b)/2) ; split. by []. rewrite /Rmin /Rmax. case Rle_dec ; lra. Qed. Definition Sup_fct (f : R -> R) (a b : R) : Rbar := match Req_EM_T a b with | right Hab => Lub_Rbar (fun y => exists x, y = f x /\ Rmin a b < x < Rmax a b) | left _ => Finite 0 end. Definition Inf_fct (f : R -> R) (a b : R) : Rbar := match Req_EM_T a b with | right Hab => Glb_Rbar (fun y => exists x, y = f x /\ Rmin a b < x < Rmax a b) | left _ => Finite 0 end. Lemma Sup_fct_bound (f : R -> R) (a b : R) : Sup_fct f a b = Sup_fct f b a. Proof. rewrite /Sup_fct /= ; case: Req_EM_T => Hab ; case: Req_EM_T => Hba. by []. by apply sym_equal in Hab. by apply sym_equal in Hba. apply Lub_Rbar_eqset => x ; by rewrite Rmin_comm Rmax_comm. Qed. Lemma Inf_fct_bound (f : R -> R) (a b : R) : Inf_fct f a b = Inf_fct f b a. Proof. rewrite /Inf_fct /= ; case: Req_EM_T => Hab ; case: Req_EM_T => Hba. by []. by apply sym_equal in Hab. by apply sym_equal in Hba. apply Glb_Rbar_eqset => x ; by rewrite Rmin_comm Rmax_comm. Qed. Lemma Sup_fct_le (f : R -> R) (a b : R) (x : R) : (Rmin a b < x < Rmax a b) -> Rbar_le (Finite (f x)) (Sup_fct f a b). Proof. move => Hx ; rewrite /Sup_fct. case: Req_EM_T => Hab. move: (Rlt_trans _ _ _ (proj1 Hx) (proj2 Hx)) => {Hx} ; rewrite /Rmin /Rmax ; case: Rle_dec (Req_le _ _ Hab) => //= _ _ Hx. contradict Hx ; by apply Rle_not_lt, Req_le. rewrite /Lub_Rbar ; case: ex_lub_Rbar => l lub ; apply lub ; exists x ; split ; by []. Qed. Lemma Inf_fct_le (f : R -> R) (a b : R) (x : R) : (Rmin a b < x < Rmax a b) -> Rbar_le (Inf_fct f a b) (Finite (f x)). Proof. move => Hx ; rewrite /Inf_fct. case: Req_EM_T => Hab. move: (Rlt_trans _ _ _ (proj1 Hx) (proj2 Hx)) => {Hx} ; rewrite /Rmin /Rmax ; case: Rle_dec (Req_le _ _ Hab) => //= _ _ Hx. contradict Hx ; by apply Rle_not_lt, Req_le. rewrite /Glb_Rbar ; case: ex_glb_Rbar => l lub ; apply lub ; exists x ; split ; by []. Qed. Lemma Sup_fct_maj (f : R -> R) (a b : R) (M : R) : (forall x, Rmin a b < x < Rmax a b -> f x <= M) -> is_finite (Sup_fct f a b). Proof. rewrite /Sup_fct ; case: Req_EM_T => Hab Hf. by []. rewrite /Lub_Rbar ; case: ex_lub_Rbar ; case => [l | | ] [lub ub] /=. by []. case: (ub (Finite M)) => //. move => _ [x [-> Hx]]. by apply Hf. case: (lub (f((a+b)/2))) => //. exists ((a + b) / 2) ; split. by []. rewrite /Rmin /Rmax. case Rle_dec ; lra. Qed. Lemma Inf_fct_min (f : R -> R) (a b : R) (m : R) : (forall x, Rmin a b < x < Rmax a b -> m <= f x) -> is_finite (Inf_fct f a b). Proof. rewrite /Inf_fct ; case: Req_EM_T => Hab Hf. by []. rewrite /Glb_Rbar ; case: ex_glb_Rbar ; case => [l | | ] [lub ub] /=. by []. case: (lub (f((a+b)/2))) => //. exists ((a + b) / 2) ; split. by []. rewrite /Rmin /Rmax. case Rle_dec ; lra. case: (ub (Finite m)) => //. move => _ [x [-> Hx]]. by apply Hf. Qed. (** SF_sup and SF_inf *) Definition SF_sup_seq (f : R -> R) (a b : R) (n : nat) : SF_seq := SF_seq_f2 (Sup_fct f) (unif_part a b n). Lemma SF_sup_lx (f : R -> R) (a b : R) (n : nat) : SF_lx (SF_sup_seq f a b n) = unif_part a b n. Proof. apply SF_lx_f2. now apply Nat.lt_0_succ. Qed. Lemma SF_sup_ly (f : R -> R) (a b : R) (n : nat) : SF_ly (SF_sup_seq f a b n) = behead (pairmap (Sup_fct f) 0 (unif_part a b n)). Proof. by apply SF_ly_f2. Qed. Definition SF_inf_seq (f : R -> R) (a b : R) (n : nat) : SF_seq := SF_seq_f2 (Inf_fct f) (unif_part a b n). Lemma SF_inf_lx (f : R -> R) (a b : R) (n : nat) : SF_lx (SF_inf_seq f a b n) = unif_part a b n. Proof. by apply SF_lx_f2, Nat.lt_0_succ. Qed. Lemma SF_inf_ly (f : R -> R) (a b : R) (n : nat) : SF_ly (SF_inf_seq f a b n) = behead (pairmap (Inf_fct f) 0 (unif_part a b n)). Proof. by apply SF_ly_f2. Qed. Lemma SF_sup_bound (f : R -> R) (a b : R) (n : nat) : SF_rev (SF_sup_seq f a b n) = SF_sup_seq f b a n. Proof. rewrite /SF_sup_seq unif_part_bound => //. rewrite SF_rev_f2 ?revK //. move => x y ; apply Sup_fct_bound. Qed. Lemma SF_inf_bound (f : R -> R) (a b : R) (n : nat) : SF_rev (SF_inf_seq f a b n) = SF_inf_seq f b a n. Proof. rewrite /SF_inf_seq unif_part_bound => //. rewrite SF_rev_f2 ?revK //. move => x y ; apply Inf_fct_bound. Qed. Definition SF_sup_fun (f : R -> R) (a b : R) (n : nat) (x : R) : Rbar := match (Rle_dec a b) with | left _ => SF_fun (SF_sup_seq f a b n) (Finite 0) x | right _ => SF_fun (SF_sup_seq f b a n) (Finite 0) x end. Definition SF_inf_fun (f : R -> R) (a b : R) (n : nat) (x : R) : Rbar := match (Rle_dec a b) with | left _ => SF_fun (SF_inf_seq f a b n) (Finite 0) x | right _ => SF_fun (SF_inf_seq f b a n) (Finite 0) x end. Lemma SF_sup_fun_bound (f : R -> R) (a b : R) (n : nat) (x : R) : SF_sup_fun f a b n x = SF_sup_fun f b a n x. Proof. rewrite /SF_sup_fun ; case: (Rle_dec a b) => Hab ; case : (Rle_dec b a) => Hba //. by rewrite (Rle_antisym _ _ Hab Hba). by contradict Hba ; apply Rlt_le, Rnot_le_lt. Qed. Lemma SF_inf_fun_bound (f : R -> R) (a b : R) (n : nat) (x : R) : SF_inf_fun f a b n x = SF_inf_fun f b a n x. Proof. rewrite /SF_inf_fun ; case: (Rle_dec a b) => Hab ; case : (Rle_dec b a) => Hba //. by rewrite (Rle_antisym _ _ Hab Hba). by contradict Hba ; apply Rlt_le, Rnot_le_lt. Qed. Lemma SF_sup_fun_rw (f : R -> R) (a b : R) (n : nat) (x : R) (Hx : a <= x <= b) : SF_sup_fun f a b n x = match (unif_part_nat a b n x Hx) with | inleft H => Sup_fct f (nth 0 (unif_part a b n) (proj1_sig H)) (nth 0 (unif_part a b n) (S (proj1_sig H))) | inright _ => Sup_fct f (nth 0 (unif_part a b n) (n)) (nth 0 (unif_part a b n) (S n)) end. Proof. have Hab : (a <= b) ; [by apply Rle_trans with (1 := proj1 Hx), Hx | ]. rewrite /SF_sup_fun /SF_sup_seq ; case: Rle_dec => // _. case: unif_part_nat => {Hx} [ [ i [Hx Hi] ] | Hx] ; simpl proj1_sig. (* i < n *) case: (unif_part a b n) (unif_part_sort a b n Hab) i Hi x Hx => {a b Hab n} [| h s] Hs /= i Hi. by apply Nat.nlt_0_r in Hi. case: (s) Hs (i) ((proj2 (Nat.succ_lt_mono _ _)) Hi) => {s i Hi} [| h0 s] Hs /= i Hi. by apply Nat.nlt_0_r in Hi. elim: (s) h h0 Hs (i) ((proj2 (Nat.succ_lt_mono _ _)) Hi) => {s i Hi} [|h1 s IH] h h0 Hs /= i Hi x Hx. by apply Nat.nlt_0_r in Hi. case: i Hx Hi => [|i]/= Hx Hi. rewrite /SF_fun /=. case: Rlt_dec => [Hx0 | _ ]. contradict Hx0 ; apply Rle_not_lt, Hx. case: Rlt_dec => // Hx0 ; contradict Hx0 ; apply Hx. rewrite -(IH h0 h1 (proj2 Hs) i ((proj2 (Nat.succ_lt_mono _ _) Hi)) x Hx). rewrite /SF_fun /= ; case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (1 := proj1 Hs), Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. (* i = n *) move: x Hx. suff : (1 < size (unif_part a b n))%nat. have: (n = size (unif_part a b n) - 2)%nat ; [ rewrite size_mkseq ; intuition | move => {3 5 8 10}->]. case: (unif_part a b n) (unif_part_sort a b n Hab) => {a b Hab n} [| h s] Hs /= Hi. by apply Nat.nlt_0_r in Hi. case: s h Hs Hi => [| h0 s] h Hs /= Hi. by apply Nat.lt_irrefl in Hi. rewrite Nat.sub_0_r ; elim: s h h0 Hs {Hi} => [| h1 s IH] h h0 Hs /= x Hx. rewrite /SF_fun /= ; case: Rlt_dec => [Hx0 | _]. contradict Hx0 ; apply Rle_not_lt, Hx. case: Rle_dec => [| Hx0] // ; contradict Hx0 ; apply Hx. rewrite -(IH h0 h1 (proj2 Hs) x Hx). rewrite /SF_fun /= ; case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (1 := proj1 Hs), Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. rewrite size_mkseq ; by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. Qed. Lemma SF_inf_fun_rw (f : R -> R) (a b : R) (n : nat) (x : R) (Hx : a <= x <= b) : SF_inf_fun f a b n x = match (unif_part_nat a b n x Hx) with | inleft H => Inf_fct f (nth 0 (unif_part a b n) (proj1_sig H)) (nth 0 (unif_part a b n) (S (proj1_sig H))) | inright _ => Inf_fct f (nth 0 (unif_part a b n) (n)) (nth 0 (unif_part a b n) (S n)) end. Proof. have Hab : (a <= b) ; [by apply Rle_trans with (1 := proj1 Hx), Hx | ]. rewrite /SF_inf_fun /SF_inf_seq ; case: Rle_dec => // _. case: unif_part_nat => {Hx} [ [ i [Hx Hi] ] | Hx] ; simpl proj1_sig. (* i < n *) case: (unif_part a b n) (unif_part_sort a b n Hab) i Hi x Hx => {a b Hab n} [| h s] Hs /= i Hi. by apply Nat.nlt_0_r in Hi. case: (s) Hs (i) ((proj2 (Nat.succ_lt_mono _ _) Hi)) => {s i Hi} [| h0 s] Hs /= i Hi. by apply Nat.nlt_0_r in Hi. elim: (s) h h0 Hs (i) ((proj2 (Nat.succ_lt_mono _ _) Hi)) => {s i Hi} [|h1 s IH] h h0 Hs /= i Hi x Hx. by apply Nat.nlt_0_r in Hi. case: i Hx Hi => [|i]/= Hx Hi. rewrite /SF_fun /=. case: Rlt_dec => [Hx0 | _ ]. contradict Hx0 ; apply Rle_not_lt, Hx. case: Rlt_dec => // Hx0 ; contradict Hx0 ; apply Hx. rewrite -(IH h0 h1 (proj2 Hs) i ((proj2 (Nat.succ_lt_mono _ _) Hi)) x Hx). rewrite /SF_fun /= ; case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (1 := proj1 Hs), Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. (* i = n *) move: x Hx. suff : (1 < size (unif_part a b n))%nat. have: (n = size (unif_part a b n) - 2)%nat ; [ rewrite size_mkseq ; intuition | move => {3 5 8 10}->]. case: (unif_part a b n) (unif_part_sort a b n Hab) => {a b Hab n} [| h s] Hs /= Hi. by apply Nat.nlt_0_r in Hi. case: s h Hs Hi => [| h0 s] h Hs /= Hi. by apply Nat.lt_irrefl in Hi. rewrite Nat.sub_0_r ; elim: s h h0 Hs {Hi} => [| h1 s IH] h h0 Hs /= x Hx. rewrite /SF_fun /= ; case: Rlt_dec => [Hx0 | _]. contradict Hx0 ; apply Rle_not_lt, Hx. case: Rle_dec => [| Hx0] // ; contradict Hx0 ; apply Hx. rewrite -(IH h0 h1 (proj2 Hs) x Hx). rewrite /SF_fun /= ; case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (1 := proj1 Hs), Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. case: Rlt_dec => [ Hx0 | _ ] //. contradict Hx0 ; apply Rle_not_lt, Rle_trans with (2 := proj1 Hx), (sorted_head [:: h0, h1 & s] _ (proj2 Hs)) ; simpl; intuition. rewrite size_mkseq ; by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. Qed. (** ** SF_sup_real is a StepFun *) Lemma ad_SF_sup_r (f : R -> R) (a b : R) (n : nat) : ((a <= b) -> adapted_couple (fun x => real (SF_sup_fun f a b n x)) a b (unif_part a b n) (behead (pairmap (fun x y => real (Sup_fct f x y)) 0 (unif_part a b n)))) /\ (~(a <= b) -> adapted_couple (fun x => real (SF_sup_fun f a b n x)) a b (unif_part b a n) (behead (pairmap (fun x y => real (Sup_fct f x y)) 0 (unif_part b a n)))). Proof. wlog : a b / (a <= b) => [Hw|Hab]. case: (Rle_dec a b) => // Hab ; split => // _. by apply (Hw a b). apply Rnot_le_lt, Rlt_le in Hab ; case : (Hw b a Hab) => {} Hw _ ; move: (Hw Hab) => {} Hw ; rewrite /adapted_couple in Hw |-* ; rewrite Rmin_comm Rmax_comm ; intuition => x Hx ; rewrite SF_sup_fun_bound ; by apply H4. split ; case: (Rle_dec a b)=> // _ _. rewrite /SF_sup_fun ; case: (Rle_dec a b) => // _. have Hs : (SF_sorted Rle (SF_map real (SF_sup_seq f a b n))). rewrite /SF_sorted SF_map_lx SF_lx_f2. replace (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n) by intuition. by apply unif_part_sort. by apply Nat.lt_0_succ. have {2}<-: head 0 (unif_part a b n) = a. apply head_unif_part. have {3}<-: last 0 (unif_part a b n) = b. apply last_unif_part. replace (behead (pairmap (fun x y : R => real (Sup_fct f x y)) 0 (unif_part a b n))) with (SF_ly (SF_map real (SF_sup_seq f a b n))). replace (unif_part a b n) with (SF_lx (SF_map real (SF_sup_seq f a b n))). move: (ad_SF_compat (f ((0+0)/2)) (SF_map real (SF_sup_seq f a b n)) Hs) ; rewrite /adapted_couple => Had ; intuition. move: (H4 i H3) => {H4} H3' x H4. move: (H3' x H4) => {H3'} <-. rewrite -(SF_fun_map real). 2: rewrite SF_map_lx SF_lx_f2 // ; by apply Nat.lt_0_succ. 2: rewrite SF_map_ly SF_ly_f2 ; by rewrite -behead_map map_pairmap. move: H3 H4. rewrite /SF_sup_seq. rewrite !nth_compat size_compat SF_map_lx SF_lx_f2. 2: apply Nat.lt_0_succ. unfold SF_fun. elim: (unif_part a b n) (unif_part_sort a b n Hab) {3}(0) {1}(f ((0 + 0) / 2)) i => [ | x0 l IH] Hl z0 z1 i Hi Hx. by apply Nat.nlt_0_r in Hi. simpl in Hi. destruct l as [ | x1 l]. by apply Nat.nlt_0_r in Hi. rewrite SF_cons_f2. 2: by apply Nat.lt_0_succ. rewrite SF_map_cons. case: i Hi Hx => [ | i] Hi /= Hx. case: Rlt_dec => Hx0 //. contradict Hx0 ; apply Rle_not_lt, Rlt_le, Hx. case: (l) => [ | x2 l'] /=. case: Rle_dec => // Hx1. contradict Hx1 ; by apply Rlt_le, Hx. case: Rlt_dec (proj2 Hx) => //. case: Rlt_dec => //= Hx0. contradict Hx0. apply Rle_not_lt, Rlt_le. eapply Rle_lt_trans, Hx. eapply Rle_trans, sorted_head. by apply Hl. by apply Hl. eapply Nat.lt_trans, Hi. by apply Nat.lt_succ_diag_r. eapply (IH (proj2 Hl) (Sup_fct f x0 x1) (Sup_fct f x0 x1)). 2: apply Hx. simpl ; by apply Nat.succ_lt_mono. Qed. Definition SF_sup_r (f : R -> R) (a b : R) (n : nat) : StepFun a b. Proof. exists (fun x => real (SF_sup_fun f a b n x)) ; case : (Rle_dec a b) => Hab. exists (unif_part a b n) ; exists (behead (pairmap (fun x y => real (Sup_fct f x y)) 0 (unif_part a b n))) ; by apply ad_SF_sup_r. exists (unif_part b a n) ; exists (behead (pairmap (fun x y => real (Sup_fct f x y)) 0 (unif_part b a n))) ; by apply ad_SF_sup_r. Defined. Lemma SF_sup_subdiv (f : R -> R) (a b : R) (n : nat) : subdivision (SF_sup_r f a b n) = match (Rle_dec a b) with | left _ => unif_part a b n | right _ => unif_part b a n end. Proof. rewrite /SF_sup_r ; case: (Rle_dec a b) => Hab //. Qed. Lemma SF_sup_subdiv_val (f : R -> R) (a b : R) (n : nat) : subdivision_val (SF_sup_r f a b n) = match (Rle_dec a b) with | left _ => behead (pairmap (fun x y => real (Sup_fct f x y)) 0 (unif_part a b n)) | right _ => behead (pairmap (fun x y => real (Sup_fct f x y)) 0 (unif_part b a n)) end. Proof. rewrite /SF_sup_r ; case: (Rle_dec a b) => Hab //. Qed. Lemma SF_sup_r_bound (f : R -> R) (a b : R) (n : nat) : forall x, SF_sup_r f a b n x = SF_sup_r f b a n x. Proof. move => x /= ; by rewrite SF_sup_fun_bound. Qed. (** ** SF_inf_real is a StepFun *) Lemma ad_SF_inf_r (f : R -> R) (a b : R) (n : nat) : ((a <= b) -> adapted_couple (fun x => real (SF_inf_fun f a b n x)) a b (unif_part a b n) (behead (pairmap (fun x y => real (Inf_fct f x y)) 0 (unif_part a b n)))) /\ (~(a <= b) -> adapted_couple (fun x => real (SF_inf_fun f a b n x)) a b (unif_part b a n) (behead (pairmap (fun x y => real (Inf_fct f x y)) 0 (unif_part b a n)))). Proof. wlog : a b / (a <= b) => [Hw|Hab]. case: (Rle_dec a b) => // Hab ; split => // _. by apply (Hw a b). apply Rnot_le_lt, Rlt_le in Hab ; case : (Hw b a Hab) => {} Hw _ ; move: (Hw Hab) => {} Hw ; rewrite /adapted_couple in Hw |-* ; rewrite Rmin_comm Rmax_comm ; intuition => x Hx ; rewrite SF_inf_fun_bound ; by apply H4. split ; case: (Rle_dec a b)=> // _ _. rewrite /SF_inf_fun ; case: (Rle_dec a b) => // _. have Hs : (SF_sorted Rle (SF_map real (SF_inf_seq f a b n))). rewrite /SF_sorted SF_map_lx SF_lx_f2. replace (head 0 (unif_part a b n) :: behead (unif_part a b n)) with (unif_part a b n) by intuition. by apply unif_part_sort. by apply Nat.lt_0_succ. have {2}<-: head 0 (unif_part a b n) = a. apply head_unif_part. have {3}<-: last 0 (unif_part a b n) = b. apply last_unif_part. replace (behead (pairmap (fun x y : R => real (Inf_fct f x y)) 0 (unif_part a b n))) with (SF_ly (SF_map real (SF_inf_seq f a b n))). replace (unif_part a b n) with (SF_lx (SF_map real (SF_inf_seq f a b n))). move: (ad_SF_compat (f ((0+0)/2)) (SF_map real (SF_inf_seq f a b n)) Hs) ; rewrite /adapted_couple => Had ; intuition. move: (H4 i H3) => {H4} H3' x H4. move: (H3' x H4) => {H3'} <-. rewrite -(SF_fun_map real). 2: rewrite SF_map_lx SF_lx_f2 // ; by apply Nat.lt_0_succ. 2: rewrite SF_map_ly SF_ly_f2 ; by rewrite -behead_map map_pairmap. move: H3 H4. rewrite /SF_inf_seq. rewrite !nth_compat size_compat SF_map_lx SF_lx_f2. 2: apply Nat.lt_0_succ. unfold SF_fun. elim: (unif_part a b n) (unif_part_sort a b n Hab) {3}(0) {1}(f ((0 + 0) / 2)) i => [ | x0 l IH] Hl z0 z1 i Hi Hx. by apply Nat.nlt_0_r in Hi. simpl in Hi. destruct l as [ | x1 l]. by apply Nat.nlt_0_r in Hi. rewrite SF_cons_f2. 2: by apply Nat.lt_0_succ. rewrite SF_map_cons. case: i Hi Hx => [ | i] Hi /= Hx. case: Rlt_dec => Hx0 //. contradict Hx0 ; apply Rle_not_lt, Rlt_le, Hx. case: (l) => [ | x2 l'] /=. case: Rle_dec => // Hx1. contradict Hx1 ; by apply Rlt_le, Hx. case: Rlt_dec (proj2 Hx) => //. case: Rlt_dec => //= Hx0. contradict Hx0. apply Rle_not_lt, Rlt_le. eapply Rle_lt_trans, Hx. eapply Rle_trans, sorted_head. by apply Hl. by apply Hl. eapply Nat.lt_trans, Hi. by apply Nat.lt_succ_diag_r. eapply (IH (proj2 Hl) (Inf_fct f x0 x1) (Inf_fct f x0 x1)). 2: apply Hx. simpl ; by apply Nat.succ_lt_mono. Qed. Definition SF_inf_r (f : R -> R) (a b : R) (n : nat) : StepFun a b. Proof. exists (fun x => real (SF_inf_fun f a b n x)) ; case : (Rle_dec a b) => Hab. exists (unif_part a b n) ; exists (behead (pairmap (fun x y => real (Inf_fct f x y)) 0 (unif_part a b n))) ; by apply ad_SF_inf_r. exists (unif_part b a n) ; exists (behead (pairmap (fun x y => real (Inf_fct f x y)) 0 (unif_part b a n))) ; by apply ad_SF_inf_r. Defined. Lemma SF_inf_subdiv (f : R -> R) (a b : R) (n : nat) : subdivision (SF_inf_r f a b n) = match (Rle_dec a b) with | left _ => unif_part a b n | right _ => unif_part b a n end. Proof. rewrite /SF_inf_r ; case: (Rle_dec a b) => Hab //. Qed. Lemma SF_inf_subdiv_val (f : R -> R) (a b : R) (n : nat) : subdivision_val (SF_inf_r f a b n) = match (Rle_dec a b) with | left _ => behead (pairmap (fun x y => real (Inf_fct f x y)) 0 (unif_part a b n)) | right _ => behead (pairmap (fun x y => real (Inf_fct f x y)) 0 (unif_part b a n)) end. Proof. rewrite /SF_inf_r ; case: (Rle_dec a b) => Hab //. Qed. Lemma SF_inf_r_bound (f : R -> R) (a b : R) (n : nat) : forall x, SF_inf_r f a b n x = SF_inf_r f b a n x. Proof. move => x /= ; by rewrite SF_inf_fun_bound. Qed. coquelicot-coquelicot-3.4.1/theories/Seq_fct.v000066400000000000000000001015661455143432500214470ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Rbar Lim_seq Continuity Derive Series Lub Hierarchy. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). (** This file describes sequences of functions and results about their convergence. *) Open Scope R_scope. (** * Sequence of functions *) (** ** Definitions *) Definition CVS_dom (fn : nat -> R -> R) (D : R -> Prop) := forall x : R, D x -> ex_finite_lim_seq (fun n => fn n x). Definition CVU_dom (fn : nat -> R -> R) (D : R -> Prop) := forall eps : posreal, eventually (fun n => forall x : R, D x -> Rabs ((fn n x) - real (Lim_seq (fun n => fn n x))) < eps). Definition CVU_cauchy (fn : nat -> R -> R) (D : R -> Prop) := forall eps : posreal, exists N : nat, forall (n m : nat) (x : R), D x -> (N <= n)%nat -> (N <= m)%nat -> Rabs (fn n x - fn m x) < eps. (** Equivalence with standard library *) Lemma CVU_dom_Reals (fn : nat -> R -> R) (f : R -> R) (x : R) (r : posreal) : (forall y, (Boule x r y) -> (Finite (f y)) = Lim_seq (fun n => fn n y)) -> (CVU fn f x r <-> CVU_dom fn (Boule x r)). Proof. split ; move => Hcvu. have Hf : forall y, Boule x r y -> is_lim_seq (fun n => fn n y) (f y). move => y Hy. apply is_lim_seq_spec. move => [e He] /=. case: (Hcvu e He) => {Hcvu} N Hcvu. exists N => n Hn. rewrite -Ropp_minus_distr' Rabs_Ropp. by apply Hcvu. move => [e He] /=. case: (Hcvu e He) => {Hcvu} N Hcvu. exists N => n Hn y Hy. rewrite (is_lim_seq_unique (fun n0 : nat => fn n0 y) _ (Hf y Hy)). simpl. rewrite -/(Rminus (fn n y) (f y)) -Ropp_minus_distr' Rabs_Ropp. by apply Hcvu. move => e He ; set eps := mkposreal e He. case: (Hcvu eps) => {Hcvu} N Hcvu. exists N => n y Hn Hy. move: (Hcvu n Hn y Hy). rewrite -(H y Hy) /=. by rewrite -Ropp_minus_distr' Rabs_Ropp. Qed. (** Various inclusions and equivalences between definitions *) Lemma CVU_CVS_dom (fn : nat -> R -> R) (D : R -> Prop) : CVU_dom fn D -> CVS_dom fn D. Proof. move => Hcvu x Hx. exists (real (Lim_seq (fun n => fn n x))). apply is_lim_seq_spec. intros eps. case: (Hcvu eps) => {Hcvu} N Hcvu. exists N => n Hn. by apply Hcvu. Qed. Lemma CVU_dom_cauchy (fn : nat -> R -> R) (D : R -> Prop) : CVU_dom fn D <-> CVU_cauchy fn D. Proof. split => H eps. (* CVU_dom -> CVU_cauchy *) case: (H (pos_div_2 eps)) => {H} N /= H. exists N => n m x Hx Hn Hm. rewrite (double_var eps). replace (fn n x - fn m x) with ((fn n x - real (Lim_seq (fun n0 : nat => fn n0 x))) - (fn m x - real (Lim_seq (fun n0 : nat => fn n0 x)))) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _) ; rewrite Rabs_Ropp. apply Rplus_lt_compat ; by apply H. (* CVU_cauchy -> CVU_dom *) rewrite /Lim_seq. case: (H (pos_div_2 eps)) => {H} N /= H. exists N => n Hn x Hx. rewrite /LimSup_seq ; case: ex_LimSup_seq ; case => [ls | | ] /= Hls. rewrite /LimInf_seq ; case: ex_LimInf_seq ; case => [li | | ] /= Hli. replace (fn n x - (ls + li) / 2) with (((fn n x - ls) + (fn n x - li))/2) by field. rewrite Rabs_div ; [ | by apply Rgt_not_eq, Rlt_R0_R2]. rewrite (Rabs_pos_eq 2) ; [ | by apply Rlt_le, Rlt_R0_R2]. rewrite Rlt_div_l ; [ | by apply Rlt_R0_R2]. apply Rle_lt_trans with (1 := Rabs_triang _ _). replace (eps * 2) with (eps + eps) by ring. apply Rplus_lt_compat ; apply Rabs_lt_between'. case: (Hls (pos_div_2 eps)) => {Hls Hli} /= H0 [N0 H1] ; split. case: (H0 N) => {H0} m [Hm H0]. apply Rlt_trans with (fn m x - eps/2). replace (ls - eps) with ((ls - eps / 2) - eps/2) by field. by apply Rplus_lt_compat_r. replace (fn n x) with (eps/2 + (fn n x - eps/2)) by ring. replace (fn m x - eps / 2) with ((fn m x - fn n x) + (fn n x - eps/2)) by ring. apply Rplus_lt_compat_r. apply Rle_lt_trans with (1 := Rle_abs _) ; by apply H. apply Rlt_trans with (fn (n+N0)%nat x + eps/2). replace (fn n x) with (fn (n + N0)%nat x + (fn n x - fn (n+N0)%nat x)) by ring. apply Rplus_lt_compat_l. apply Rle_lt_trans with (1 := Rle_abs _). apply H ; by intuition. replace (ls + eps) with ((ls + eps/2) + eps/2) by field. apply Rplus_lt_compat_r. apply H1 ; by intuition. case: (Hli (pos_div_2 eps)) => {Hls Hli} /= H0 [N0 H1] ; split. apply Rlt_trans with (fn (n+N0)%nat x - eps/2). replace (li - eps) with ((li - eps/2) - eps/2) by field. apply Rplus_lt_compat_r. apply H1 ; by intuition. replace (fn n x) with (eps/2 + (fn n x - eps/2)) by ring. replace (fn (n + N0)%nat x - eps / 2) with ((fn (n + N0)%nat x - fn n x) + (fn n x - eps/2)) by ring. apply Rplus_lt_compat_r. apply Rle_lt_trans with (1 := Rle_abs _). apply H ; by intuition. case: (H0 N) => {H0} m [Hm H0]. apply Rlt_trans with (fn m x + eps/2). replace (fn n x) with (fn m x + (fn n x - fn m x)) by ring. apply Rplus_lt_compat_l. apply Rle_lt_trans with (1 := Rle_abs _) ; by apply H. replace (li + eps) with ((li + eps / 2) + eps/2) by field. by apply Rplus_lt_compat_r. case: (Hli (fn n x + eps / 2)) => {Hls Hli} N0 H0. move: (H0 _ (MyNat.le_add_l N0 N)) => {} H0 ; contradict H0. apply Rle_not_lt, Rlt_le. replace (fn (N + N0)%nat x) with (fn n x + (fn (N + N0)%nat x - fn n x)) by ring. apply Rplus_lt_compat_l. apply Rle_lt_trans with (1 := Rle_abs _). apply H ; by intuition. case: (Hli (fn n x - eps / 2) N) => {Hls Hli} m [Hm H0]. contradict H0. apply Rle_not_lt, Rlt_le. replace (fn m x) with (eps/2 + (fn m x - eps/2)) by ring. replace (fn n x - eps / 2) with ((fn n x - fn m x) + (fn m x - eps/2)) by ring. apply Rplus_lt_compat_r, Rle_lt_trans with (1 := Rle_abs _) ; by apply H. case: (Hls (fn n x + eps / 2) N) => {Hls} m [Hm H0]. contradict H0. apply Rle_not_lt, Rlt_le. replace (fn m x) with (fn n x + (fn m x - fn n x)) by ring. apply Rplus_lt_compat_l, Rle_lt_trans with (1 := Rle_abs _) ; by apply H. case: (Hls (fn n x - eps / 2)) => {Hls} N0 H0. move: (H0 _ (MyNat.le_add_l N0 N)) => {} H0 ; contradict H0. apply Rle_not_lt, Rlt_le. replace (fn (N + N0)%nat x) with (eps/2 + (fn (N + N0)%nat x - eps/2)) by ring. replace (fn n x - eps / 2) with ((fn n x - fn (N+N0)%nat x) + (fn (N+N0)%nat x - eps/2)) by ring. apply Rplus_lt_compat_r. apply Rle_lt_trans with (1 := Rle_abs _). apply H ; by intuition. Qed. Lemma CVU_dom_include (fn : nat -> R -> R) (D1 D2 : R -> Prop) : (forall y, D2 y -> D1 y) -> CVU_dom fn D1 -> CVU_dom fn D2. Proof. move => H H1 eps. case: (H1 eps) => {H1} N H1. exists N => n Hn x Hx. apply H1. exact Hn. by apply H. Qed. (** ** Limits, integrals and differentiability *) Definition is_connected (D : R -> Prop) := forall a b x, D a -> D b -> a <= x <= b -> D x. Lemma CVU_limits_open (fn : nat -> R -> R) (D : R -> Prop) : open D -> CVU_dom fn D -> (forall x n, D x -> ex_finite_lim (fn n) x) -> forall x, D x -> ex_finite_lim_seq (fun n => real (Lim (fn n) x)) /\ ex_finite_lim (fun y => real (Lim_seq (fun n => fn n y))) x /\ real (Lim_seq (fun n => real (Lim (fn n) x))) = real (Lim (fun y => real (Lim_seq (fun n => fn n y))) x). Proof. move => Ho Hfn Hex x Hx. have H : ex_finite_lim_seq (fun n : nat => real (Lim (fn n) x)). apply CVU_dom_cauchy in Hfn. apply ex_lim_seq_cauchy_corr => eps. case: (Hfn (pos_div_2 eps)) => {Hfn} /= N Hfn. exists N => n m Hn Hm. case: (Hex x n Hx) => ln Hex_n ; rewrite (is_lim_unique _ _ _ Hex_n). case: (Hex x m Hx) => {Hex} lm Hex_m ; rewrite (is_lim_unique _ _ _ Hex_m). apply is_lim_spec in Hex_n. apply is_lim_spec in Hex_m. case: (Hex_n (pos_div_2 (pos_div_2 eps))) => {Hex_n} /= dn Hex_n. case: (Hex_m (pos_div_2 (pos_div_2 eps))) => {Hex_m} /= dm Hex_m. case: (Ho x Hx) => {Ho} d0 Ho. set y := x + Rmin (Rmin dn dm) d0 / 2. have Hd : 0 < Rmin (Rmin dn dm) d0 / 2. apply Rdiv_lt_0_compat. apply Rmin_case ; [ | by apply d0]. apply Rmin_case ; [ by apply dn | by apply dm]. exact: Rlt_R0_R2. have Hy : Rabs (y - x) < d0. rewrite /y ; ring_simplify ((x + Rmin (Rmin dn dm) d0 / 2) - x). rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hd)). generalize (Rmin_r (Rmin dn dm) d0). lra. move : (Ho y Hy) => {Ho} Hy. replace (ln - lm) with (- (fn n y - ln) + (fn m y - lm) + (fn n y - fn m y)) by ring. rewrite (double_var eps) ; apply Rle_lt_trans with (1 := Rabs_triang _ _), Rplus_lt_compat. rewrite (double_var (eps/2)) ; apply Rle_lt_trans with (1 := Rabs_triang _ _), Rplus_lt_compat. rewrite Rabs_Ropp ; apply Hex_n. rewrite /y /ball /= /AbsRing_ball /= /minus /plus /opp /abs /=. ring_simplify ((x + Rmin (Rmin dn dm) d0 / 2) + - x). rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hd)). generalize (Rmin_l (Rmin dn dm) d0) (Rmin_l dn dm). lra. apply Rgt_not_eq, Rlt_gt, Rminus_lt_0. rewrite /y ; by ring_simplify ((x + Rmin (Rmin dn dm) d0 / 2) - x). apply Hex_m. rewrite /y /ball /= /AbsRing_ball /= /minus /plus /opp /abs /=. ring_simplify ((x + Rmin (Rmin dn dm) d0 / 2) + - x). rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hd)). generalize (Rmin_l (Rmin dn dm) d0) (Rmin_r dn dm). lra. apply Rgt_not_eq, Rlt_gt, Rminus_lt_0. rewrite /y ; by ring_simplify ((x + Rmin (Rmin dn dm) d0 / 2) - x). by apply Hfn. split. exact: H. apply Lim_seq_correct' in H. move: (real (Lim_seq (fun n : nat => real (Lim (fn n) x)))) H => l H. have H0 : is_lim (fun y : R => real (Lim_seq (fun n : nat => fn n y))) x l. apply is_lim_spec. move => eps. apply is_lim_seq_spec in H. case: (Hfn (pos_div_2 (pos_div_2 eps))) => {Hfn} /= n1 Hfn. case: (H (pos_div_2 (pos_div_2 eps))) => {H} /= n2 H. set n := (n1 + n2)%nat. move: (fun y Hy => Hfn n (Nat.le_add_r _ _) y Hy) => {} Hfn. move: (H n (MyNat.le_add_l _ _)) => {} H. move: (Hex x n Hx) => {} Hex. apply Lim_correct' in Hex. apply is_lim_spec in Hex. case: (Hex (pos_div_2 eps)) => {Hex} /= d1 Hex. case: (Ho x Hx) => {Ho} /= d0 Ho. have Hd : 0 < Rmin d0 d1. apply Rmin_case ; [by apply d0 | by apply d1]. exists (mkposreal _ Hd) => /= y Hy Hxy. replace (real (Lim_seq (fun n0 : nat => fn n0 y)) - l) with ((real (Lim (fn n) x) - l) - (fn n y - real (Lim_seq (fun n : nat => fn n y))) + (fn n y - real (Lim (fn n) x))) by ring. rewrite (double_var eps) ; apply Rle_lt_trans with (1 := Rabs_triang _ _), Rplus_lt_compat. rewrite (double_var (eps/2)) ; apply Rle_lt_trans with (1 := Rabs_triang _ _), Rplus_lt_compat. exact: H. rewrite Rabs_Ropp ; apply Hfn. by apply Ho, Rlt_le_trans with (1 := Hy), Rmin_l. apply Hex. by apply Rlt_le_trans with (1 := Hy), Rmin_r. exact: Hxy. split. by exists l. replace l with (real l) by auto. by apply sym_eq, (f_equal real), is_lim_unique. Qed. Lemma CVU_cont_open (fn : nat -> R -> R) (D : R -> Prop) : open D -> CVU_dom fn D -> (forall n, forall x, D x -> continuity_pt (fn n) x) -> forall x, D x -> continuity_pt (fun y => real (Lim_seq (fun n => fn n y))) x. Proof. move => Ho Hfn Hc x Hx. case: (fun H => CVU_limits_open fn D Ho Hfn H x Hx) => [{Hx} x n Hx | Hex_s [Hex_f Heq]]. exists (fn n x). apply is_lim_spec. intros eps. case: (Hc n x Hx eps (cond_pos eps)) => {Hc} d [Hd Hc]. exists (mkposreal d Hd) => /= y Hy Hxy. apply (Hc y). split. split. exact: I. by apply sym_not_eq, Hxy. exact: Hy. apply Lim_correct' in Hex_f. rewrite -Heq in Hex_f => {Heq}. replace (Lim_seq (fun n : nat => real (Lim (fn n) x))) with (Lim_seq (fun n : nat => (fn n) x)) in Hex_f. move => e He. apply is_lim_spec in Hex_f. case: (Hex_f (mkposreal e He)) => {Hex_f} /= delta Hex_f. exists delta ; split => [ | y [[_ Hxy] Hy]]. by apply delta. apply Hex_f. exact: Hy. by apply sym_not_eq. apply Lim_seq_ext => n. replace (fn n x) with (real (fn n x)) by auto. apply sym_eq, f_equal, is_lim_unique. apply is_lim_spec. move => eps. case: (Hc n x Hx eps (cond_pos eps)) => {Hc} d [Hd Hc]. exists (mkposreal d Hd) => /= y Hy Hxy. apply (Hc y). split. split. exact: I. by apply sym_not_eq, Hxy. exact: Hy. Qed. Lemma CVU_Derive (fn : nat -> R -> R) (D : R -> Prop) : open D -> is_connected D -> CVU_dom fn D -> (forall n x, D x -> ex_derive (fn n) x) -> (forall n x, D x -> continuity_pt (Derive (fn n)) x) -> CVU_dom (fun n x => Derive (fn n) x) D -> (forall x , D x -> (is_derive (fun y => real (Lim_seq (fun n => fn n y))) x (real (Lim_seq (fun n => Derive (fn n) x))))). Proof. move => Ho Hc Hfn Edn Cdn Hdn. set rn := fun x n h => match (Req_EM_T h 0) with | left _ => Derive (fn n) x | right _ => (fn n (x+h) - fn n x)/h end. assert (Ho' : forall x : R, open (fun h : R => D (x + h))). intros x. apply open_comp with (2 := Ho). intros t _. eapply (filterlim_comp_2 (F := locally t)). apply filterlim_const. apply filterlim_id. apply: filterlim_plus. have Crn : forall x, D x -> forall n h, D (x+h) -> is_lim (rn x n) h (rn x n h). move => x Hx n h Hh. rewrite {2}/rn ; case: (Req_EM_T h 0) => [-> | Hh0]. apply is_lim_spec. move => eps. cut (locally 0 (fun y : R => y <> 0 -> Rabs ((fn n (x + y) - fn n x) / y - Derive (fn n) x) < eps)). case => d H. exists d => y Hy Hxy. rewrite /rn ; case: Req_EM_T => // _ ; by apply H. move: (Edn n x Hx) => {} Edn. apply Derive_correct in Edn. apply is_derive_Reals in Edn. case: (Edn eps (cond_pos eps)) => {Edn} delta Edn. exists delta => y Hy Hxy. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= in Hy. rewrite -/(Rminus _ _) Rminus_0_r in Hy. by apply Edn. have H : continuity_pt (fun h => ((fn n (x + h) - fn n x) / h)) h. apply derivable_continuous_pt. apply derivable_pt_div. apply derivable_pt_minus. apply derivable_pt_comp. apply (derivable_pt_plus (fun _ => x) (fun h => h) h). exact: derivable_pt_const. exact: derivable_pt_id. exists (Derive (fn n) (x + h)) ; by apply is_derive_Reals, Derive_correct, Edn. exact: derivable_pt_const. exact: derivable_pt_id. exact: Hh0. apply is_lim_spec. move => eps. case: (H eps (cond_pos eps)) => {H} d [Hd H]. have Hd0 : 0 < Rmin d (Rabs h). apply Rmin_case. exact: Hd. by apply Rabs_pos_lt. exists (mkposreal _ Hd0) => /= y Hy Hhy. rewrite /rn ; case: Req_EM_T => /= Hy'. contradict Hy. apply Rle_not_lt. rewrite /abs /minus /plus /opp /=. rewrite Hy' -/(Rminus _ _) Rminus_0_l Rabs_Ropp ; by apply Rmin_r. apply (H y) ; split. split. exact: I. by apply sym_not_eq. by apply Rlt_le_trans with (1 := Hy), Rmin_l. have Hrn : forall x, D x -> CVU_dom (rn x) (fun h : R => D (x + h)). move => x Hx. apply CVU_dom_cauchy => eps. apply CVU_dom_cauchy in Hdn. case: (Hdn eps) => {Hdn} /= N Hdn. exists N => n m h Hh Hn Hm. rewrite /rn ; case: Req_EM_T => Hh0. exact: (Hdn n m x Hx Hn Hm). replace ((fn n (x + h) - fn n x) / h - (fn m (x + h) - fn m x) / h) with (((fn n (x + h) - fn m (x + h)) - (fn n x - fn m x))/h) by (field ; auto). case: (MVT_gen (fun x => (fn n x - fn m x)) x (x+h) (Derive (fun x => fn n x - fn m x))) => [y Hy | y Hy | z [Hz ->]]. apply Derive_correct. apply: ex_derive_minus ; apply Edn, (Hc (Rmin x (x + h)) (Rmax x (x + h))). apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. split ; apply Rlt_le ; by apply Hy. apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. split ; apply Rlt_le ; by apply Hy. apply derivable_continuous_pt, derivable_pt_minus. exists (Derive (fn n) y) ; apply is_derive_Reals, Derive_correct, Edn, (Hc (Rmin x (x + h)) (Rmax x (x + h))). apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. by apply Hy. exists (Derive (fn m) y) ; apply is_derive_Reals, Derive_correct, Edn, (Hc (Rmin x (x + h)) (Rmax x (x + h))). apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. by apply Hy. replace (Derive (fun x1 : R => fn n x1 - fn m x1) z * (x + h - x) / h) with (Derive (fun x1 : R => fn n x1 - fn m x1) z) by (field ; auto). rewrite Derive_minus. apply (Hdn n m z). apply (Hc (Rmin x (x + h)) (Rmax x (x + h))). apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. by apply Hz. exact: Hn. exact: Hm. apply Edn, (Hc (Rmin x (x + h)) (Rmax x (x + h))). apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. by apply Hz. apply Edn, (Hc (Rmin x (x + h)) (Rmax x (x + h))). apply Rmin_case ; [by apply Hx | by apply Hh]. apply Rmax_case ; [by apply Hx | by apply Hh]. by apply Hz. have Lrn : forall x, D x -> (forall (y : R) (n : nat), (fun h : R => D (x + h)) y -> ex_finite_lim (rn x n) y). intros ; exists (rn x n y) ; by intuition. move => x Hx. case: (CVU_limits_open (rn x) _ (Ho' x) (Hrn x Hx) (Lrn x Hx) 0) => [ | H [H0 H1]]. by rewrite Rplus_0_r. have : ex_derive (fun y : R => real (Lim_seq (fun n : nat => fn n y))) x /\ Derive (fun y : R => real (Lim_seq (fun n : nat => fn n y))) x = real (Lim_seq (fun n : nat => Derive (fn n) x)). split. case: H0 => df H0. exists df. apply is_derive_Reals => e He. apply is_lim_spec in H0. case: (H0 (mkposreal e He)) => {H0} /= delta H0. destruct (Ho x Hx) as [dx Hd]. have H2 : 0 < Rmin delta dx. apply Rmin_case ; [by apply delta | by apply dx]. exists (mkposreal _ H2) => /= h Hh0 Hh. replace (real (Lim_seq (fun n : nat => fn n (x + h))) - real (Lim_seq (fun n : nat => fn n x))) with (real (Rbar_minus (Lim_seq (fun n : nat => fn n (x + h))) (Lim_seq (fun n : nat => fn n x)))). rewrite -Lim_seq_minus. replace (real (Lim_seq (fun n : nat => fn n (x + h) - fn n x)) / h) with (real (Rbar_mult (/h) (Lim_seq (fun n : nat => fn n (x + h) - fn n x)))). rewrite -Lim_seq_scal_l. replace (Lim_seq (fun n : nat => / h * (fn n (x + h) - fn n x))) with (Lim_seq (fun n : nat => rn x n h)). apply H0. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. rewrite -/(Rminus _ _) Rminus_0_r ; apply Rlt_le_trans with (1 := Hh), Rmin_l. exact: Hh0. apply Lim_seq_ext => n. rewrite /rn /Rdiv ; case: Req_EM_T => // _ ; exact: Rmult_comm. case: (Lim_seq (fun n : nat => fn n (x + h) - fn n x)) => [l | | ] //=. by field. rewrite /Rdiv Rmult_0_l. case: Rle_dec => // Hh1. case: Rle_lt_or_eq_dec => //. rewrite /Rdiv Rmult_0_l. case: Rle_dec => // Hh1. case: Rle_lt_or_eq_dec => //. apply ex_finite_lim_seq_correct, CVU_CVS_dom with D. exact: Hfn. apply Hd. simpl. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. ring_simplify (x + h + - x) ; apply Rlt_le_trans with (1 := Hh), Rmin_r. apply ex_finite_lim_seq_correct, CVU_CVS_dom with D. exact: Hfn. apply Hd. apply ball_center. apply (CVU_CVS_dom fn D) in Hfn ; rewrite /CVS_dom in Hfn. move: (fun H => Lim_seq_correct' _ (Hfn (x+h) (Hd _ H))) => F. move: (fun H => Lim_seq_correct' _ (Hfn (x) (Hd _ H))) => F0. rewrite (is_lim_seq_unique _ (real (Lim_seq (fun n : nat => fn n (x + h))))). rewrite (is_lim_seq_unique (fun n : nat => fn n (x)) (real (Lim_seq (fun n : nat => fn n (x))))). easy. apply F0. apply ball_center. apply F. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. ring_simplify (x + h + - x). apply Rlt_le_trans with (1 := Hh), Rmin_r. apply (CVU_CVS_dom fn D) in Hfn ; rewrite /CVS_dom in Hfn. move: (fun H => Lim_seq_correct' _ (Hfn (x+h) (Hd _ H))) => F. move: (fun H => Lim_seq_correct' _ (Hfn (x) (Hd _ H))) => F0. rewrite (is_lim_seq_unique _ (real (Lim_seq (fun n : nat => fn n (x + h))))). rewrite (is_lim_seq_unique (fun n : nat => fn n (x)) (real (Lim_seq (fun n : nat => fn n (x))))). by []. apply F0. apply ball_center. apply F. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. ring_simplify (x + h + - x). apply Rlt_le_trans with (1 := Hh), Rmin_r. rewrite /Derive. replace (Lim_seq (fun n : nat => real (Lim (fun h : R => (fn n (x + h) - fn n x) / h) 0))) with (Lim_seq (fun n : nat => real (Lim (rn x n) 0))). rewrite H1. case: H0 => drn H0. rewrite (is_lim_unique _ _ _ H0). apply f_equal, is_lim_unique. apply is_lim_spec. intros eps. apply is_lim_spec in H0. case: (H0 eps) => {H0} delta H0. destruct (Ho x Hx) as [dx Hd]. have H2 : 0 < Rmin delta dx. apply Rmin_case ; [by apply delta | by apply dx]. exists (mkposreal _ H2) => /= h Hh0 Hh. replace (real (Lim_seq (fun n : nat => fn n (x + h))) - real (Lim_seq (fun n : nat => fn n x))) with (real (Rbar_minus (Lim_seq (fun n : nat => fn n (x + h))) (Lim_seq (fun n : nat => fn n x)))). rewrite -Lim_seq_minus. replace (real (Lim_seq (fun n : nat => fn n (x + h) - fn n x)) / h) with (real (Rbar_mult (/h) (Lim_seq (fun n : nat => fn n (x + h) - fn n x)))). rewrite -Lim_seq_scal_l. replace (Lim_seq (fun n : nat => / h * (fn n (x + h) - fn n x))) with (Lim_seq (fun n : nat => rn x n h)). apply H0. apply Rlt_le_trans with (1 := Hh0), Rmin_l. exact: Hh. apply Lim_seq_ext => n. rewrite /rn /Rdiv ; case: Req_EM_T => // _ ; exact: Rmult_comm. case: (Lim_seq (fun n : nat => fn n (x + h) - fn n x)) => [l | | ] //=. by field. rewrite /Rdiv Rmult_0_l. case: Rle_dec => // Hh1. case: Rle_lt_or_eq_dec => //. rewrite /Rdiv Rmult_0_l. case: Rle_dec => // Hh1. case: Rle_lt_or_eq_dec => //. apply ex_finite_lim_seq_correct, CVU_CVS_dom with D. exact: Hfn. apply Hd. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. ring_simplify (x + h + - x) ; rewrite -(Rminus_0_r h) ; apply Rlt_le_trans with (1 := Hh0), Rmin_r. apply ex_finite_lim_seq_correct, CVU_CVS_dom with D. exact: Hfn. apply Hd. apply ball_center. apply (CVU_CVS_dom fn D) in Hfn ; rewrite /CVS_dom in Hfn. move: (fun H => Lim_seq_correct' _ (Hfn (x+h) (Hd _ H))) => F. move: (fun H => Lim_seq_correct' _ (Hfn (x) (Hd _ H))) => F0. rewrite (is_lim_seq_unique _ (real (Lim_seq (fun n : nat => fn n (x + h))))). rewrite (is_lim_seq_unique (fun n : nat => fn n (x)) (real (Lim_seq (fun n : nat => fn n (x))))). easy. apply F0. apply ball_center. apply F. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. ring_simplify (x + h + - x). rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= in Hh0. rewrite -/(Rminus _ _) Rminus_0_r in Hh0. apply Rlt_le_trans with (1 := Hh0), Rmin_r. apply (CVU_CVS_dom fn D) in Hfn ; rewrite /CVS_dom in Hfn. move: (fun H => Lim_seq_correct' _ (Hfn (x+h) (Hd _ H))) => F. move: (fun H => Lim_seq_correct' _ (Hfn (x) (Hd _ H))) => F0. rewrite (is_lim_seq_unique _ (real (Lim_seq (fun n : nat => fn n (x + h))))). rewrite (is_lim_seq_unique (fun n : nat => fn n (x)) (real (Lim_seq (fun n : nat => fn n (x))))). by []. apply F0. apply ball_center. apply F. rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /=. ring_simplify (x + h + - x). rewrite /ball /= /AbsRing_ball /= /minus /plus /opp /= in Hh0. rewrite -/(Rminus _ _) Rminus_0_r in Hh0. apply Rlt_le_trans with (1 := Hh0), Rmin_r. apply Lim_seq_ext => n. apply sym_eq, f_equal, is_lim_unique. have Hx' : D (x + 0). by rewrite Rplus_0_r. rewrite (is_lim_unique _ _ _ (Crn x Hx n 0 Hx')). apply is_lim_spec. move: (Crn x Hx n 0 Hx') => H2 eps. apply is_lim_spec in H2. case: (H2 eps) => {H2} delta H2. exists delta => y Hy Hy0. move: (H2 y Hy Hy0). rewrite {1}/rn ; by case: Req_EM_T. case => H2 H3. rewrite -H3. by apply Derive_correct. Qed. (** ** Dini's theorem *) Lemma Dini (fn : nat -> R -> R) (a b : R) : a < b -> CVS_dom fn (fun x => a <= x <= b) -> (forall (n : nat) (x : R), a <= x <= b -> continuity_pt (fn n) x) -> (forall (x : R), a <= x <= b -> continuity_pt (fun y => Lim_seq (fun n => fn n y)) x) -> (forall (n : nat) (x y : R), a <= x -> x <= y -> y <= b -> fn n x <= fn n y) -> CVU_dom fn (fun x => a <= x <= b). Proof. set AB := fun x => a <= x <= b. set f : R -> R := (fun y : R => Lim_seq (fun n : nat => fn n y)). move => Hab Hcvs Cfn Cf Hfn. have CUf : uniform_continuity f AB. apply Heine. by apply compact_P3. by apply Cf. suff H : forall eps : posreal, exists N : nat, forall n : nat, (N <= n)%nat -> forall x : R, AB x -> Rabs (fn n x - Lim_seq (fun n0 : nat => fn n0 x)) < 5 * eps. move => eps. replace (pos eps) with (5 * (eps / 5)) by field. suff He : 0 < eps / 5. by apply (H (mkposreal _ He)). apply Rdiv_lt_0_compat. by apply eps. repeat (apply Rplus_lt_0_compat || apply Rmult_lt_0_compat) ; apply Rlt_0_1. move => eps. case: (CUf eps) => {CUf} eta CUf. move: (interval_finite_subdiv_between a b (pos_div_2 eta) (Rlt_le _ _ Hab)). case: (interval_finite_subdiv a b (pos_div_2 eta) (Rlt_le _ _ Hab)) => a_ Ha_ /= Ha_0. have : exists N, forall n i, (N <= n)%nat -> (i < seq.size a_)%nat -> Rabs (fn n (seq.nth 0 a_ i) - f (seq.nth 0 a_ i)) < eps. case: a_ Ha_ Ha_0 => [ | a0 a_] Ha_ /= Ha_0. contradict Hab. rewrite -(proj1 Ha_) -(proj1 (proj2 Ha_)). by apply Rlt_irrefl. elim: (a_) (a0) Ha_0 => /= [ | x1 l IH] x0 Hl. move: (Hcvs x0 (Hl O (Nat.lt_succ_diag_r _))) ; move/Lim_seq_correct' => {} Hcvs. apply is_lim_seq_spec in Hcvs. case: (Hcvs eps) => {Hcvs} N Hcvs. exists N => n i Hn Hi. case: i Hi => /= [ | i] Hi. by apply Hcvs. by apply Nat.succ_lt_mono, Nat.nlt_0_r in Hi. case: (IH x1). move => i Hi. by apply (Hl (S i)), (proj1 (Nat.succ_lt_mono _ _)). move => N0 HN0. move: (Hcvs x0 (Hl O (Nat.lt_0_succ _))) ; move/Lim_seq_correct' => {} Hcvs. apply is_lim_seq_spec in Hcvs. case: (Hcvs eps) => {Hcvs} N Hcvs. exists (N + N0)%nat => n i Hn Hi. case: i Hi => /= [ | i ] Hi. apply Hcvs ; by intuition. apply HN0 ; by intuition. case => N HN. exists N => n Hn x Hx. have : exists i, (S i < seq.size a_)%nat /\ seq.nth 0 a_ i <= x <= seq.nth 0 a_ (S i). case: a_ Ha_ Ha_0 {HN} => [ | a0 a_] Ha_ /= Ha_0. contradict Hab. rewrite -(proj1 Ha_) -(proj1 (proj2 Ha_)). by apply Rlt_irrefl. case: a_ Ha_ Ha_0 => [ | a1 a_] Ha_ /= Ha_0. contradict Hab. rewrite -(proj1 Ha_) -(proj1 (proj2 Ha_)). by apply Rlt_irrefl. rewrite -(proj1 Ha_) in AB Hcvs CUf Hx Hab Cfn Cf Hfn Ha_0 |- * ; case: Ha_ => {a} _ Ha_. rewrite -(proj1 Ha_) in AB Hcvs CUf Hx Hab Cfn Cf Hfn Ha_0 |- * ; case: Ha_ => {b} _ Ha_. clear Hcvs CUf ; revert AB Hx ; elim: (a_) (a0) (a1) => /= [ | x2 l IH] x0 x1 Hx. exists O ; split => /=. by apply Nat.lt_succ_diag_r. by apply Hx. case: (Rlt_le_dec x x1) => Hx'. exists O ; split => /=. by apply ->Nat.succ_lt_mono; apply Nat.lt_0_succ. split ; intuition. case: (IH x1 x2). by intuition. move => i [Hi Hx0]. exists (S i) ; by intuition. case => i [Hi Hx']. replace (fn n x - Lim_seq (fun n0 : nat => fn n0 x)) with ((f (seq.nth 0 a_ i) - f x) + (fn n x - f (seq.nth 0 a_ i))) by (rewrite /f ; ring). replace (5 * eps) with (eps + 4 * eps) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). apply Rplus_lt_compat. apply CUf. apply Ha_0 ; by intuition. by apply Hx. rewrite -Rabs_Ropp Ropp_minus_distr' Rabs_pos_eq. apply Rle_lt_trans with (seq.nth 0 a_ (S i) - seq.nth 0 a_ i). apply Rplus_le_compat_r. by apply Hx'. apply Rle_lt_trans with (eta/2). apply Rle_minus_l. rewrite Rplus_comm. by apply Ha_. apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. apply Rle_minus_r ; rewrite Rplus_0_l. by apply Hx'. replace (fn n x - f (seq.nth 0 a_ i)) with ((fn n (seq.nth 0 a_ i) - f (seq.nth 0 a_ i)) + (fn n x - fn n (seq.nth 0 a_ i))) by ring. replace (4 * eps) with (eps + 3 * eps) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _). apply Rplus_lt_compat. apply HN ; by intuition. rewrite Rabs_pos_eq. apply Rle_lt_trans with (fn n (seq.nth 0 a_ (S i)) - fn n (seq.nth 0 a_ i)). apply Rplus_le_compat_r. apply Hfn. by apply Hx. by apply Hx'. by apply Ha_0. replace (fn n (seq.nth 0 a_ (S i)) - fn n (seq.nth 0 a_ i)) with ((fn n (seq.nth 0 a_ (S i)) - f (seq.nth 0 a_ (S i))) - (fn n (seq.nth 0 a_ i) - f (seq.nth 0 a_ i)) + (f (seq.nth 0 a_ (S i)) - f (seq.nth 0 a_ i))) by ring. replace (3 * eps) with ((eps + eps) + eps) by ring. apply Rle_lt_trans with (1 := Rle_abs _). apply Rle_lt_trans with (1 := Rabs_triang _ _). apply Rplus_lt_compat. apply Rle_lt_trans with (1 := Rabs_triang _ _). apply Rplus_lt_compat. apply HN ; by intuition. rewrite Rabs_Ropp. apply HN ; by intuition. apply CUf. apply Ha_0 ; by intuition. apply Ha_0 ; by intuition. rewrite Rabs_pos_eq. apply Rle_lt_trans with (eta/2). apply Rle_minus_l. rewrite Rplus_comm. by apply Ha_. apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1. by apply is_pos_div_2. apply Rle_minus_r ; rewrite Rplus_0_l. apply Rle_trans with x ; apply Hx'. apply Rle_minus_r ; rewrite Rplus_0_l. apply Hfn. apply Ha_0 ; by intuition. by apply Hx'. by apply Hx. Qed. (** ** Series of functions *) Lemma CVN_CVU_r (fn : nat -> R -> R) (r : posreal) : CVN_r fn r -> forall x, (Rabs x < r) -> exists e : posreal, CVU (fun n => SP fn n) (fun x => Series (fun n => fn n x)) x e. Proof. case => An [l [H H0]] x Hx. assert (H1 : ex_series An). apply ex_series_Reals_1. exists l => e He. case: (H e He) => {H} N H. exists N => n Hn. replace (sum_f_R0 An n) with (sum_f_R0 (fun k : nat => Rabs (An k)) n). by apply H. elim: n {Hn} => /= [ | n IH]. apply Rabs_pos_eq. apply Rle_trans with (Rabs (fn O 0)). by apply Rabs_pos. apply H0 ; rewrite /Boule Rminus_0_r Rabs_R0 ; by apply r. rewrite IH Rabs_pos_eq. by []. apply Rle_trans with (Rabs (fn (S n) 0)). by apply Rabs_pos. apply H0 ; rewrite /Boule Rminus_0_r Rabs_R0 ; by apply r. have H2 : is_lim_seq (fun n => Series (fun k => An (n + k)%nat)) 0. apply is_lim_seq_incr_1. apply is_lim_seq_ext with (fun n => Series An - sum_f_R0 An n). move => n ; rewrite (Series_incr_n An (S n)) /=. ring. by apply Nat.lt_0_succ. by apply H1. replace (Finite 0) with (Rbar_plus (Series An) (- Series An)) by (simpl ; apply Rbar_finite_eq ; ring). apply (is_lim_seq_plus _ _ (Series An) (-Series An)). by apply is_lim_seq_const. replace (Finite (-Series An)) with (Rbar_opp (Series An)) by (simpl ; apply Rbar_finite_eq ; ring). apply -> is_lim_seq_opp. rewrite /Series ; apply (is_lim_seq_ext (sum_n (fun k => An k))). elim => /= [ | n IH]. by rewrite sum_O. by rewrite sum_Sn IH. apply is_lim_seq_ext with (sum_n An). move => n ; by rewrite sum_n_Reals. apply Lim_seq_correct', H1. easy. assert (H3 : forall y, Boule 0 r y -> ex_series (fun n => Rabs (fn n y))). move => y Hy. move: H1 ; apply @ex_series_le. move => n. rewrite /norm /= /abs /= Rabs_Rabsolu. by apply H0. apply Rminus_lt_0 in Hx. set r0 := mkposreal _ Hx. exists r0 => e He ; set eps := mkposreal e He. apply is_lim_seq_spec in H2. case: (H2 eps) => {H2} N H2. exists N => n y Hn Hy. have H4 : Boule 0 r y. rewrite /Boule /= in Hy |- *. apply Rle_lt_trans with (1 := Rabs_triang_inv _ _) in Hy. rewrite /Rminus ?(Rplus_comm _ (-Rabs x)) in Hy. apply Rplus_lt_reg_l in Hy. by rewrite Rminus_0_r. apply Rle_lt_trans with (2 := H2 (S n) (Nat.le_trans _ _ _ (Nat.le_succ_diag_r _) (le_n_S _ _ Hn))). rewrite Rminus_0_r /SP. rewrite (Series_incr_n (fun k : nat => fn k y) (S n)) /=. ring_simplify (sum_f_R0 (fun k : nat => fn k y) n + Series (fun k : nat => fn (S (n + k)) y) - sum_f_R0 (fun k : nat => fn k y) n). apply Rle_trans with (2 := Rle_abs _). apply Rle_trans with (Series (fun k : nat => Rabs (fn (S (n + k)) y))). apply Series_Rabs. apply ex_series_ext with (fun n0 : nat => Rabs (fn (S (n) + n0)%nat y)). move => n0 ; by rewrite plus_Sn_m. apply (ex_series_incr_n (fun n => Rabs (fn n y))). by apply H3. apply Series_le. move => k ; split. by apply Rabs_pos. by apply H0. apply ex_series_ext with (fun k : nat => An (S n + k)%nat). move => k ; by rewrite plus_Sn_m. by apply ex_series_incr_n. by apply Nat.lt_0_succ. apply ex_series_Rabs. by apply H3. Qed. coquelicot-coquelicot-3.4.1/theories/Series.v000066400000000000000000001064151455143432500213130ustar00rootroot00000000000000(** This file is part of the Coquelicot formalization of real analysis in Coq: http://coquelicot.saclay.inria.fr/ Copyright (C) 2011-2015 Sylvie Boldo #
# Copyright (C) 2011-2015 Catherine Lelay #
# Copyright (C) 2011-2015 Guillaume Melquiond This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This library 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 COPYING file for more details. *) From Coq Require Import Reals Psatz ssreflect. Require Import Rcomplements Lim_seq Rbar Hierarchy. Local Tactic Notation "intuition" := (intuition auto with arith zarith real). (** This file gives definitions and properties about series defined on a normed module. An equivalence with the standard library and several convergence criteria are provided. *) Section Definitions. (** * Definitions *) Context {K : AbsRing} {V : NormedModule K}. Definition is_series (a : nat -> V) (l : V) := filterlim (sum_n a) (eventually) (locally l). Definition ex_series (a : nat -> V) := exists l : V, is_series a l. Definition Cauchy_series (a : nat -> V) := forall eps : posreal, exists N : nat, forall n m : nat, (N <= n)%nat -> (N <= m)%nat -> norm (sum_n_m a n m) < eps. End Definitions. Definition Series (a : nat -> R) : R := real (Lim_seq (sum_n a)). Lemma ex_series_dec (a : nat -> R) : {ex_series a} + {~ ex_series a}. Proof. case: (ex_lim_seq_dec (sum_n a)) => H. apply Lim_seq_correct in H. case: (Lim_seq (sum_n a)) H => [l | | ] H. left ; by exists l. right ; case => l H0. absurd (p_infty = Finite l) => //. rewrite -(is_lim_seq_unique _ _ H). by apply is_lim_seq_unique. right ; case => l H0. absurd (m_infty = Finite l) => //. rewrite -(is_lim_seq_unique _ _ H). by apply is_lim_seq_unique. right ; case => l. contradict H. by exists l. Qed. Lemma is_series_unique (a : nat -> R) (l : R) : is_series a l -> Series a = l. Proof. move => Ha. replace l with (real (Finite l)) by auto. apply (f_equal real). by apply is_lim_seq_unique. Qed. Lemma Series_correct (a : nat -> R) : ex_series a -> is_series a (Series a). Proof. case => l Ha. by rewrite (is_series_unique a l). Qed. Lemma is_series_Reals (a : nat -> R) (l : R) : is_series a l <-> infinite_sum a l. Proof. split => H. apply (is_lim_seq_spec _ l) in H. move => e He ; set eps := mkposreal e He. case: (H eps) => /= {H} N H. exists N => n Hn. rewrite <- sum_n_Reals. by apply (H n Hn). apply (is_lim_seq_spec _ l). move => eps. case: (H eps (cond_pos eps)) => {H} N H. exists N => n Hn. rewrite sum_n_Reals. by apply (H n Hn). Qed. Lemma ex_series_Reals_0 (a : nat -> R) : ex_series a -> { l:R | Un_cv (fun N:nat => sum_f_R0 a N) l }. Proof. move => H ; exists (Series a) ; case: H => l H. replace (Series a) with l. move => e He ; set eps := mkposreal e He. apply (is_lim_seq_spec _ l) in H. case: (H eps) => /= {H} N H. exists N => n Hn. rewrite <- sum_n_Reals. by apply (H n Hn). apply sym_eq. rewrite /Series. replace l with (real (Finite l)) by auto. apply f_equal. by apply is_lim_seq_unique. Qed. Lemma ex_series_Reals_1 (a : nat -> R) : { l:R | Un_cv (fun N:nat => sum_f_R0 a N) l } -> ex_series a. Proof. case => l H. exists l. apply (is_lim_seq_spec _ l). move => eps. case: (H eps (cond_pos eps)) => {H} N H. exists N => n Hn. rewrite sum_n_Reals. by apply (H n Hn). Qed. (** Cauchy *) Lemma Cauchy_ex_series {K : AbsRing} {V : CompleteNormedModule K} (a : nat -> V) : ex_series a -> Cauchy_series a. Proof. intros [l Hl] eps. generalize (filterlim_locally_closely (U := V) (F := eventually) (sum_n (fun k => a k))). move /proj2 /(_ (ex_intro _ l Hl)). move /(filterlim_filter_le_2 _ closely_le_closely_norm). move /filterlim_closely_norm. case /(_ eps) => [P [[N HN] HP]]. exists (S N). intros [|u] v Hu Hv. elim Nat.nle_succ_0 with (1 := Hu). destruct (Nat.le_gt_cases u v) as [Huv|Huv]. rewrite (sum_n_m_sum_n _ _ _ Huv). apply HP ; apply HN. now apply le_S_n. now apply Nat.lt_le_incl. rewrite sum_n_m_zero. rewrite norm_zero. apply cond_pos. now apply Nat.lt_lt_succ_r. Qed. Lemma ex_series_Cauchy {K : AbsRing} {V : CompleteNormedModule K} (a : nat -> V) : Cauchy_series a -> ex_series a. Proof. intros Ca. destruct (proj1 (filterlim_locally_cauchy (U := V) (F := eventually) (sum_n a))) as [l Hl]. 2: now exists l. intros eps. destruct (Ca eps) as [N HN]. exists (le N). split. now exists N. intros u v. wlog Huv: u v / (u <= v)%nat. intros H. destruct (Nat.le_gt_cases u v) as [Huv|Huv]. now apply H. intros Hu Hv. apply ball_sym. apply H => //. now apply Nat.lt_le_incl. intros Hu Hv. apply: norm_compat1. rewrite -(sum_n_m_sum_n _ _ _ Huv). apply HN => //. now apply le_S. Qed. Section Properties1. Context {K : AbsRing} {V : NormedModule K}. (** Extensionality *) Lemma is_series_ext (a b : nat -> V) (l : V) : (forall n, a n = b n) -> (is_series a l) -> is_series b l. Proof. move => Heq. apply filterlim_ext. intros x; now apply sum_n_m_ext. Qed. Lemma ex_series_ext (a b : nat -> V) : (forall n, a n = b n) -> ex_series a -> ex_series b. Proof. move => Heq [l Ha]. exists l ; by apply is_series_ext with a. Qed. Lemma Series_ext (a b : nat -> R) : (forall n, a n = b n) -> Series a = Series b. Proof. move => Heq. apply (f_equal real). apply Lim_seq_ext. intros n; now apply sum_n_m_ext. Qed. (** Index offset *) Lemma is_series_incr_1 (a : nat -> V) (l : V) : is_series a (plus l (a O)) -> is_series (fun k => a (S k)%nat) l. Proof. intros H. apply filterlim_ext with (fun k => plus (sum_n a (S k)) (opp (a 0%nat))). induction x; simpl. rewrite sum_Sn !sum_O (plus_comm _ (a 1%nat)); rewrite <- plus_assoc. now rewrite plus_opp_r plus_zero_r. rewrite !sum_Sn -IHx -!sum_Sn sum_Sn; simpl. rewrite <- plus_assoc, <- (plus_assoc _ _ (a (S (S x)))). apply f_equal; apply plus_comm. apply filterlim_comp with (G:=(locally (plus l (a 0%nat)))) (g:=fun x => plus x (opp (a 0%nat))). (* . *) apply filterlim_comp with (f:= fun x => S x) (2:=H). apply eventually_subseq; intros n; lia. (* . *) pattern l at 2; replace l with (plus (plus l (a 0%nat)) (opp (a 0%nat))). apply filterlim_comp_2 with (3 := filterlim_plus _ _). apply filterlim_id. apply filterlim_const. rewrite -plus_assoc plus_opp_r. apply plus_zero_r. Qed. Lemma is_series_incr_n (a : nat -> V) (n : nat) (l : V) : (0 < n)%nat -> is_series a (plus l (sum_n a (pred n))) -> is_series (fun k => a (n + k)%nat) l. Proof. case: n => /= [ | n] Hn Ha. by apply Nat.lt_irrefl in Hn. clear Hn. elim: n l Ha => [ | n IH] l Ha. rewrite sum_O in Ha. by apply is_series_incr_1. apply is_series_ext with (fun k : nat => a (S (n + S k))). move => k ; apply f_equal ; ring. apply (is_series_incr_1 (fun k : nat => a (S (n + k))) l). rewrite Nat.add_0_r. apply IH. replace (plus (plus l (a (S n))) (sum_n a n)) with (plus l (sum_n a (S n))). assumption. rewrite <- plus_assoc, sum_Sn; apply f_equal; simpl; apply plus_comm. Qed. Lemma is_series_decr_1 (a : nat -> V) (l : V) : is_series (fun k => a (S k)%nat) (plus l (opp (a O))) -> is_series a l. Proof. intros H. apply filterlim_ext_loc with (fun v => plus (a 0%nat) (sum_n (fun k : nat => a (S k)) (pred v))). exists 1%nat. intros n Hn; apply sym_eq. rewrite /sum_n sum_Sn_m. apply f_equal. rewrite sum_n_m_S. apply f_equal ; lia. by apply Nat.le_0_l. replace l with (plus (a 0%nat) (plus l (opp (a 0%nat)))). apply filterlim_comp_2 with (3 := filterlim_plus _ _). apply filterlim_id. apply filterlim_const. apply filterlim_comp with (f:= fun x => pred x) (2:=H). intros P (N1,HN1). exists (S N1). intros n Hn; apply HN1; lia. rewrite plus_comm; rewrite <- plus_assoc. rewrite (plus_comm _ (a 0%nat)); rewrite plus_opp_r. apply plus_zero_r. Qed. Lemma is_series_decr_n (a : nat -> V) (n : nat) (l : V) : (0 < n)%nat -> is_series (fun k => a (n + k)%nat) (plus l (opp (sum_n a (pred n)))) -> is_series a l. Proof. case: n => /= [ | n] Hn Ha. by apply Nat.lt_irrefl in Hn. clear Hn. elim: n a l Ha => [ | n IH] a l Ha. rewrite sum_O in Ha. by apply is_series_decr_1. apply is_series_decr_1. apply IH. replace (plus (plus l (opp (a 0%nat))) (opp (sum_n (fun k : nat => a (S k)) n))) with (plus l (opp (sum_n a (S n)))). by apply Ha. rewrite /sum_n sum_n_m_S sum_Sn_m /=. rewrite <- plus_assoc. apply f_equal. now rewrite opp_plus. by apply Nat.le_0_l. Qed. Lemma ex_series_incr_1 (a : nat -> V) : ex_series a <-> ex_series (fun k => a (S k)%nat). Proof. split ; move => [la Ha]. exists (plus la (opp (a O))). apply is_series_incr_1. now rewrite -plus_assoc plus_opp_l plus_zero_r. exists (plus la (a O)). apply is_series_decr_1. now rewrite -plus_assoc plus_opp_r plus_zero_r. Qed. Lemma ex_series_incr_n (a : nat -> V) (n : nat) : ex_series a <-> ex_series (fun k => a (n + k)%nat). Proof. case: n => [ | n]. split ; apply ex_series_ext ; by intuition. split ; move => [la Ha]. exists (plus la (opp (sum_n a (pred (S n))))). apply is_series_incr_n. by apply Nat.lt_0_succ. now rewrite -plus_assoc plus_opp_l plus_zero_r. exists (plus la (sum_n a (pred (S n)))). apply is_series_decr_n with (S n). by apply Nat.lt_0_succ. now rewrite -plus_assoc plus_opp_r plus_zero_r. Qed. End Properties1. Lemma Series_incr_1 (a : nat -> R) : ex_series a -> Series a = a O + Series (fun k => a (S k)). Proof. move => Ha. apply is_series_unique. rewrite Rplus_comm. apply is_series_decr_1. rewrite /plus /opp /=. ring_simplify (Series (fun k : nat => a (S k)) + a 0%nat +- a 0%nat). apply Series_correct. by apply (ex_series_incr_1 a). Qed. Lemma Series_incr_n (a : nat -> R) (n : nat) : (0 < n)%nat -> ex_series a -> Series a = sum_f_R0 a (pred n) + Series (fun k => a (n + k)%nat). Proof. move => Hn Ha. apply is_series_unique. rewrite Rplus_comm. apply is_series_decr_n with n. by []. rewrite /plus /opp /= sum_n_Reals. ring_simplify (Series (fun k : nat => a (n+ k)%nat) + sum_f_R0 a (pred n) + - sum_f_R0 a (pred n)). apply Series_correct. by apply ex_series_incr_n. Qed. Lemma Series_incr_1_aux (a : nat -> R) : a O = 0 -> Series a = Series (fun k => a (S k)). Proof. move => Ha. rewrite /Series. rewrite -Lim_seq_incr_1. apply f_equal, Lim_seq_ext => n. rewrite /sum_n sum_n_m_S sum_Sn_m. rewrite Ha ; by apply Rplus_0_l. by apply Nat.le_0_l. Qed. Lemma Series_incr_n_aux (a : nat -> R) (n : nat) : (forall k, (k < n)%nat -> a k = 0) -> Series a = Series (fun k => a (n + k)%nat). Proof. elim: n => [ | n IH] Ha. by apply Series_ext => k. rewrite IH. rewrite Series_incr_1_aux. apply Series_ext => k. apply f_equal ; ring. intuition. move => k Hk ; intuition. Qed. (** * Convergence theorems *) Lemma Cauchy_series_Reals (a : nat -> R) : Cauchy_series a <-> Cauchy_crit_series a. Proof. split => Hcv. apply cv_cauchy_1, ex_series_Reals_0. by apply: ex_series_Cauchy. apply: Cauchy_ex_series. apply ex_series_Reals_1. apply cv_cauchy_2. by apply Hcv. Qed. Lemma ex_series_lim_0 (a : nat -> R) : ex_series a -> is_lim_seq a 0. Proof. intros Hs. apply is_lim_seq_spec. intros eps. apply (Cauchy_ex_series (V := R_CompleteNormedModule)) in Hs. case: (Hs eps) => {Hs} N Hs. exists (S N) ; case => [ | n] Hn. by apply Nat.nle_succ_0 in Hn. apply le_S_n in Hn. replace (a (S n) - 0) with (sum_n_m a (S n) (S n)). apply Hs ; by intuition. by rewrite sum_n_n Rminus_0_r. Qed. Lemma ex_series_Rabs (a : nat -> R) : ex_series (fun n => Rabs (a n)) -> ex_series a. Proof. move => H. apply: ex_series_Cauchy. apply Cauchy_series_Reals. apply cauchy_abs. apply Cauchy_series_Reals. by apply: Cauchy_ex_series. Qed. Lemma Series_Rabs (a : nat -> R) : ex_series (fun n => Rabs (a n)) -> Rabs (Series a) <= Series (fun n => Rabs (a n)). Proof. move => Hra. have Ha := (ex_series_Rabs a Hra). case: Hra => lra Hra. case: Ha => la Ha. rewrite /is_series in Hra Ha. rewrite /Series /=. replace (Lim_seq (sum_n a)) with (Finite la). replace (Lim_seq (sum_n (fun k : nat => Rabs (a k)))) with (Finite lra). simpl. apply (is_lim_seq_abs _ la) in Ha. change (Rbar_le (Rabs la) lra). eapply is_lim_seq_le with (2:=Ha). 2: apply Hra. elim => [ | n IH] /=. rewrite !sum_O. by apply Rle_refl. rewrite !sum_Sn. apply Rle_trans with (1 := Rabs_triang _ _). apply Rplus_le_compat_r. by apply IH. by apply sym_eq, is_lim_seq_unique. by apply sym_eq, is_lim_seq_unique. Qed. (** Comparison *) Lemma ex_series_le {K : AbsRing} {V : CompleteNormedModule K} (a : nat -> V) (b : nat -> R) : (forall n : nat, norm (a n) <= b n) -> ex_series b -> ex_series a. Proof. move => H Hb. apply (Cauchy_ex_series (V := R_CompleteNormedModule)) in Hb. apply ex_series_Cauchy. move => e. case (Hb e) => {Hb} N Hb. exists N => n m Hn Hm. eapply Rle_lt_trans, (Hb _ _ Hn Hm) => //. eapply Rle_trans. apply norm_sum_n_m. apply Rle_trans with (sum_n_m b n m). by apply sum_n_m_le. right. assert (forall n, 0 <= b n). intros k. eapply Rle_trans, H. by apply norm_ge_0. clear -H0. apply sym_eq, Rabs_pos_eq. elim: n m b H0 => /= [ | n IH] m b Hb. elim: m => /= [ | m IH]. rewrite sum_n_n. by apply Hb. rewrite sum_n_Sm. by apply Rplus_le_le_0_compat. by apply Nat.le_0_l. case: m => /= [ | m]. by apply Rle_refl. rewrite -sum_n_m_S. apply IH => k. by apply Hb. Qed. Lemma Series_le (a b : nat -> R) : (forall n : nat, 0 <= a n <= b n) -> ex_series b -> Series a <= Series b. Proof. move => Hn Hb. have Ha := (ex_series_le a b). apply Lim_seq_correct' in Ha. apply Lim_seq_correct' in Hb. move: Ha Hb ; apply is_lim_seq_le. elim => [ | n IH] /=. rewrite !sum_O. by apply Hn. rewrite !sum_Sn. apply Rplus_le_compat. by apply IH. by apply Hn. intros n. rewrite /norm /= /abs /= Rabs_pos_eq ; by apply Hn. by apply Hb. Qed. (** * Operations *) (** Additive operators *) Section Properties2. Context {K : AbsRing} {V : NormedModule K}. Lemma is_series_opp (a : nat -> V) (la : V) : is_series a la -> is_series (fun n => opp (a n)) (opp la). Proof. move => Ha. apply filterlim_ext with (fun n => opp (sum_n a n)). elim => [ | n IH]. rewrite !sum_O ; easy. rewrite !sum_Sn -IH. apply: opp_plus. apply filterlim_comp with (1:=Ha). apply filterlim_opp. Qed. Lemma ex_series_opp (a : nat -> V) : ex_series a -> ex_series (fun n => opp (a n)). Proof. move => [la Ha]. exists (opp la). exact: is_series_opp. Qed. Lemma Series_opp (a : nat -> R) : Series (fun n => - a n) = - Series a. Proof. rewrite /Series (Lim_seq_ext (sum_n (fun k : nat => - a k)) (fun n => - (sum_n (fun k => a k) n))). rewrite Lim_seq_opp. by rewrite Rbar_opp_real. elim => [ | n IH]. rewrite !sum_O ; ring. rewrite !sum_Sn IH /plus /=. ring. Qed. Lemma is_series_plus (a b : nat -> V) (la lb : V) : is_series a la -> is_series b lb -> is_series (fun n => plus (a n) (b n)) (plus la lb). Proof. move => Ha Hb. apply filterlim_ext with (fun n => plus (sum_n a n) (sum_n b n)). elim => [ | n IH]; simpl. by rewrite !sum_O. rewrite !sum_Sn -IH; rewrite <- 2!plus_assoc; apply f_equal. rewrite 2!plus_assoc; apply f_equal2; try easy. apply plus_comm. now apply filterlim_comp_2 with (3 := filterlim_plus _ _). Qed. Lemma ex_series_plus (a b : nat -> V) : ex_series a -> ex_series b -> ex_series (fun n => plus (a n) (b n)). Proof. move => [la Ha] [lb Hb]. exists (plus la lb). by apply is_series_plus. Qed. Lemma is_series_minus (a b : nat -> V) (la lb : V) : is_series a la -> is_series b lb -> is_series (fun n => plus (a n) (opp (b n))) (plus la (opp lb)). Proof. move => Ha Hb. apply is_series_plus => //. apply is_series_opp => //. Qed. Lemma ex_series_minus (a b : nat -> V) : ex_series a -> ex_series b -> ex_series (fun n => plus (a n) (opp (b n))). Proof. move => Ha Hb. apply ex_series_plus => //. apply ex_series_opp => //. Qed. End Properties2. Lemma Series_plus (a b : nat -> R) : ex_series a -> ex_series b -> Series (fun n => a n + b n) = Series a + Series b. Proof. intros Ha Hb. replace (Series a + Series b) with (real (Series a + Series b)) by auto. apply (f_equal real), is_lim_seq_unique. apply: is_series_plus ; by apply Series_correct. Qed. Lemma Series_minus (a b : nat -> R) : ex_series a -> ex_series b -> Series (fun n => a n - b n) = Series a - Series b. Proof. intros Ha Hb. rewrite Series_plus => //. rewrite Series_opp => //. apply ex_series_opp in Hb. now simpl in Hb. Qed. (** Multiplication by a scalar *) Section Properties3. Context {K : AbsRing} {V : NormedModule K}. Lemma is_series_scal (c : K) (a : nat -> V) (l : V) : is_series a l -> is_series (fun n => scal c (a n)) (scal c l). Proof. move => Ha. apply filterlim_ext with (fun n => scal c (sum_n a n)). elim => [ | n IH]; simpl. by rewrite !sum_O. rewrite !sum_Sn -IH. apply: scal_distr_l. now apply filterlim_comp with (2 := filterlim_scal_r _ _). Qed. Lemma is_series_scal_l : forall (c : K) (a : nat -> V) (l : V), is_series a l -> is_series (fun n => scal c (a n)) (scal c l). exact is_series_scal. Qed. Lemma ex_series_scal (c : K) (a : nat -> V) : ex_series a -> ex_series (fun n => scal c (a n)). Proof. move => [l Ha]. exists (scal c l). by apply: is_series_scal_l. Qed. Lemma ex_series_scal_l : forall (c : K) (a : nat -> V), ex_series a -> ex_series (fun n => scal c (a n)). exact ex_series_scal. Qed. End Properties3. Lemma Series_scal_l (c : R) (a : nat -> R) : Series (fun n => c * a n) = c * Series a. Proof. rewrite /Series. have H0 : (forall x, c * Rbar.real x = Rbar.real (Rbar.Rbar_mult (Rbar.Finite c) x)). case: (Req_dec c 0) => [-> | Hk]. case => [x | | ] //= ; rewrite Rmult_0_l. case: Rle_dec (Rle_refl 0) => //= H0 _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => //= _ _. case: Rle_dec (Rle_refl 0) => //= H0 _. case: Rle_lt_or_eq_dec (Rlt_irrefl 0) => //= _ _. case => [x | | ] //= ; rewrite Rmult_0_r. case: Rle_dec => //= H0. case: Rle_lt_or_eq_dec => //=. case: Rle_dec => //= H0. case: Rle_lt_or_eq_dec => //=. rewrite H0 -(Lim_seq_scal_l _ c). apply f_equal, Lim_seq_ext. elim => [ | n IH]. rewrite !sum_O ; ring. rewrite !sum_Sn IH /plus /=. ring. Qed. Lemma is_series_scal_r (c : R) (a : nat -> R) (l : R) : is_series a l -> is_series (fun n => (a n) * c) (l * c). Proof. move => Ha. rewrite Rmult_comm. apply is_series_ext with (fun n : nat => c * a n). move => n ; apply Rmult_comm. apply (is_series_scal_l _ _ _ Ha). Qed. Lemma ex_series_scal_r (c : R) (a : nat -> R) : ex_series a -> ex_series (fun n => a n * c). Proof. intros [l Ha]. exists (l * c). by apply is_series_scal_r. Qed. Lemma Series_scal_r (c : R) (a : nat -> R) : Series (fun n => a n * c) = Series a * c. Proof. rewrite Rmult_comm -Series_scal_l. apply Series_ext. move => n ; apply Rmult_comm. Qed. Lemma is_series_mult_pos (a b : nat -> R) (la lb : R) : is_series a la -> is_series b lb -> (forall n, 0 <= a n) -> (forall n, 0 <= b n) -> is_series (fun n => sum_f_R0 (fun k => a k * b (n - k)%nat) n) (la * lb). Proof. move => Hla Hlb Ha Hb. have H0 : forall n, sum_f_R0 (fun k : nat => sum_f_R0 (fun p : nat => a p * b (k - p)%nat) k) n <= sum_f_R0 a n * sum_f_R0 b n. case => [ | n]. simpl ; apply Rle_refl. rewrite (cauchy_finite a b (S n) (Nat.lt_0_succ n)). apply Rminus_le_0 ; ring_simplify. apply cond_pos_sum => m. apply cond_pos_sum => k. by apply Rmult_le_pos. have H1 : forall n, sum_f_R0 a n * sum_f_R0 b n <= sum_f_R0 (fun k : nat => sum_f_R0 (fun p : nat => a p * b (k - p)%nat) k) ((2*n)%nat). case => [ /= | n]. by apply Rle_refl. rewrite (cauchy_finite a b (S n) (Nat.lt_0_succ n)). rewrite Rplus_comm ; apply Rle_minus_r. replace (pred (S n)) with n by auto. replace (2 * S n)%nat with (S n + S n)%nat by ring. rewrite -sum_f_rw. rewrite /sum_f. replace (S n + S n - S (S n))%nat with n. elim: {1 5 8}n (Nat.le_refl n) => [ | m IH] Hm ; rewrite /sum_f_R0 -/sum_f_R0. rewrite Nat.sub_0_r Nat.add_0_l ; simpl pred. rewrite -?sum_f_rw_0. replace (sum_f 0 (S (S n)) (fun p : nat => a p * b (S (S n) - p)%nat)) with ((sum_f 0 (S (S n)) (fun p : nat => a p * b (S (S n) - p)%nat) - (fun p : nat => a p * b (S (S n) - p)%nat) 0%nat) + a O * b (S (S n))) by (rewrite Nat.sub_0_r ; ring). rewrite -(sum_f_Sn_m _ O (S (S n))) ; [ | by apply Nat.lt_0_succ]. rewrite sum_f_u_Sk ; [ | by apply Nat.le_0_l]. rewrite sum_f_n_Sm ; [ | by apply Nat.le_0_l]. apply Rle_trans with (sum_f 0 n (fun l0 : nat => a (S (l0 + 0)) * b (S n - l0)%nat) + a (S (S n)) * b (S (S n) - S (S n))%nat + a 0%nat * b (S (S n))). apply Rminus_le_0 ; ring_simplify. apply Rplus_le_le_0_compat ; by apply Rmult_le_pos. repeat apply Rplus_le_compat_r. apply Req_le. rewrite ?sum_f_rw_0. elim: {1 4 6}n (Nat.le_refl n) => [ | k IH] Hk // ; rewrite /sum_f_R0 -/sum_f_R0. rewrite IH ; try by intuition. apply f_equal. by rewrite Nat.add_0_r /=. apply Rplus_le_compat. apply IH ; intuition. rewrite -?sum_f_rw_0. rewrite MyNat.sub_succ_l ; try by intuition. replace (pred (S (n - S m))) with (n - S m)%nat by auto. rewrite plus_Sn_m -?plus_n_Sm. replace (sum_f 0 (S (S (S (m + n)))) (fun p : nat => a p * b (S (S (S (m + n))) - p)%nat)) with (sum_f 1 (S (S (S (m + n)))) (fun p : nat => a p * b (S (S (S (m + n))) - p)%nat) + a O * b (S (S (S (m + n))))). rewrite -(Rplus_0_r (sum_f O _ _)). apply Rplus_le_compat. rewrite (sum_f_chasles _ O (S m) (S (S (S (m + n))))) ; try by intuition. rewrite -(Rplus_0_l (sum_f O _ _)). apply Rplus_le_compat. rewrite /sum_f. elim: (S m - 1)%nat => {IH} [ | k IH] ; rewrite /sum_f_R0 -/sum_f_R0 //. by apply Rmult_le_pos. apply Rplus_le_le_0_compat. by apply IH. by apply Rmult_le_pos. replace (S (S m)) with (1 + S m)%nat by ring. replace (S (S (S (m + n)))) with (S (S n) + S m )%nat by ring. rewrite sum_f_u_add. rewrite (sum_f_chasles _ O (S (n - S m)) (S (S n))) ; try by intuition. rewrite -(Rplus_0_r (sum_f O _ _)). apply Rplus_le_compat. rewrite sum_f_u_Sk. rewrite ?sum_f_rw_0. apply Req_le. elim: (n - S m)%nat => {IH} [ | k IH] ; rewrite /sum_f_R0 -/sum_f_R0 //. apply f_equal2 ; apply f_equal ; intuition. rewrite IH ; apply f_equal, f_equal2 ; apply f_equal. ring. rewrite ?(Nat.add_comm _ (S m)) -MyNat.add_sub_add_l //=. apply Nat.le_0_l. rewrite /sum_f. elim: (S (S n) - S (S (n - S m)))%nat => {IH} [ | k IH] ; rewrite /sum_f_R0 -/sum_f_R0 //. by apply Rmult_le_pos. apply Rplus_le_le_0_compat => // ; by apply Rmult_le_pos. by apply le_n_S, Nat.le_0_l. by apply Rmult_le_pos. rewrite sum_f_Sn_m ?Nat.sub_0_r ; try by intuition. ring. replace (S (S n)) with (S n + 1)%nat. rewrite -MyNat.add_sub_add_l. simpl; apply eq_sym, Nat.sub_0_r. now rewrite Nat.add_comm. elim: n => [ | n IH] //. rewrite -plus_n_Sm plus_Sn_m. apply Nat.lt_succ_r ; intuition. have H2 : forall n, sum_f_R0 a (Nat.div2 n)%nat * sum_f_R0 b (Nat.div2 n)%nat <= sum_f_R0 (fun k : nat => sum_f_R0 (fun p : nat => a p * b (k - p)%nat) k) n. move => n. case: (even_odd_cor n) => k ; case => -> {n}. rewrite div2_double. by apply H1. rewrite div2_S_double. apply Rle_trans with (1 := H1 _). apply Rminus_le_0 ; rewrite -sum_f_rw ; try by intuition. rewrite /sum_f Nat.sub_diag /sum_f_R0 -/sum_f_R0. apply cond_pos_sum => l ; by apply Rmult_le_pos. change (is_lim_seq (sum_n (fun n : nat => sum_f_R0 (fun k : nat => a k * b (n - k)%nat) n)) (Finite (la * lb))). apply is_lim_seq_le_le with (u := fun n => sum_f_R0 a (Nat.div2 n) * sum_f_R0 b (Nat.div2 n)) (w := fun n => sum_f_R0 a n * sum_f_R0 b n). intros n; rewrite sum_n_Reals. by split. replace (Finite (la * lb)) with (Rbar_mult la lb) by auto. suff H : is_lim_seq (fun n : nat => sum_f_R0 a n * sum_f_R0 b n) (Rbar_mult la lb). apply is_lim_seq_spec in H. apply is_lim_seq_spec. move => eps. case: (H eps) => {H} N H. exists (S (2 * N))%nat => n Hn. apply H. apply le_double. apply le_S_n. apply Nat.le_trans with (1 := Hn). destruct (Nat.Even_or_Odd n) as [He | Ho]. - rewrite {1}(MyNat.Even_double n); [| exact He]. now rewrite Nat.double_twice; apply Nat.le_succ_diag_r. - now rewrite {1}(MyNat.Odd_double n); [| exact Ho]; rewrite Nat.double_twice. apply is_lim_seq_mult'. apply filterlim_ext with (2:=Hla); apply sum_n_Reals. apply filterlim_ext with (2:=Hlb); apply sum_n_Reals. apply is_lim_seq_mult'. apply filterlim_ext with (2:=Hla); apply sum_n_Reals. apply filterlim_ext with (2:=Hlb); apply sum_n_Reals. Qed. Lemma is_series_mult (a b : nat -> R) (la lb : R) : is_series a la -> is_series b lb -> ex_series (fun n => Rabs (a n)) -> ex_series (fun n => Rabs (b n)) -> is_series (fun n => sum_f_R0 (fun k => a k * b (n - k)%nat) n) (la * lb). Proof. move => Hla Hlb Ha Hb. set ap := fun n => (a n + Rabs (a n)) / 2. set am := fun n => - (a n - Rabs (a n)) / 2. set bp := fun n => (b n + Rabs (b n)) / 2. set bm := fun n => - (b n - Rabs (b n)) / 2. have Hap : forall n, 0 <= ap n. move => n ; apply Rdiv_le_0_compat. rewrite Rplus_comm ; apply Rle_minus_l ; rewrite Rminus_0_l. apply Rabs_maj2. by apply Rlt_0_2. assert (Sap : ex_series ap). apply ex_series_scal_r. apply (@ex_series_plus ) => //. by exists la. have Ham : forall n, 0 <= am n. move => n ; apply Rdiv_le_0_compat. rewrite Ropp_minus_distr'. apply (Rminus_le_0 (a _)). by apply Rle_abs. by apply Rlt_0_2. assert (Sam : ex_series am). apply ex_series_scal_r. apply @ex_series_opp. apply @ex_series_minus => //. by exists la. have Hbp : forall n, 0 <= bp n. move => n ; apply Rdiv_le_0_compat. rewrite Rplus_comm ; apply Rle_minus_l ; rewrite Rminus_0_l. apply Rabs_maj2. by apply Rlt_0_2. assert (Sbp : ex_series bp). apply ex_series_scal_r. apply @ex_series_plus => //. by exists lb. have Hbm : forall n, 0 <= bm n. move => n ; apply Rdiv_le_0_compat. rewrite Ropp_minus_distr'. apply (Rminus_le_0 (b _)). by apply Rle_abs. by apply Rlt_0_2. assert (Sbm : ex_series bm). apply ex_series_scal_r. apply @ex_series_opp. apply @ex_series_minus => //. by exists lb. apply is_series_ext with (fun n => sum_f_R0 (fun k : nat => ap k * bp (n - k)%nat) n - sum_f_R0 (fun k : nat => am k * bp (n - k)%nat) n - sum_f_R0 (fun k : nat => ap k * bm (n - k)%nat) n + sum_f_R0 (fun k : nat => am k * bm (n - k)%nat) n). move => n. rewrite -?minus_sum -plus_sum. apply sum_eq => k _. rewrite /ap /am /bp /bm ; field. replace (la*lb) with ((Series ap*Series bp-Series am*Series bp-Series ap*Series bm)+Series am*Series bm). apply @is_series_plus. apply @is_series_minus. apply @is_series_minus. apply is_series_mult_pos => // ; by apply Series_correct. apply is_series_mult_pos => // ; by apply Series_correct. apply is_series_mult_pos => // ; by apply Series_correct. apply is_series_mult_pos => // ; by apply Series_correct. replace (la) with (Series ap - Series am). replace (lb) with (Series bp - Series bm). ring. rewrite -Series_minus // -(is_series_unique _ _ Hlb) ; apply Series_ext => n. rewrite /ap /am /bp /bm ; field. rewrite -Series_minus // -(is_series_unique _ _ Hla) ; apply Series_ext => n. rewrite /ap /am /bp /bm ; field. Qed. (** * D'Alembert criterion *) Lemma ex_series_DAlembert (a : nat -> R) (k : R) : k < 1 -> (forall n, a n <> 0) -> is_lim_seq (fun n => Rabs (a (S n) / a n)) k -> ex_series (fun n => Rabs (a n)). Proof. move => Hk Ha H. have : exists N, forall n, (N <= n)%nat -> Rabs (a (S n) / a n) <= (k+1)/2. apply is_lim_seq_spec in H. case: (fun He => H (mkposreal ((1-k)/2) He)). move: (fun He => is_pos_div_2 (mkposreal (1-k) He)) => /= He ; apply: He. by apply -> Rminus_lt_0. move => {H} /= Hk1 N H. exists N => n Hn. move: (H n Hn) => {} H. apply Rabs_lt_between' in H ; case: H => _ H ; field_simplify in H ; rewrite ?Rdiv_1 in H ; by apply Rlt_le. case => {H} N H. apply ex_series_incr_n with N. apply @ex_series_le with (fun n => Rabs (a N) * ((k+1)/2)^n). move => n. rewrite /norm /= /abs /= Rabs_Rabsolu. rewrite Rmult_comm ; apply Rle_div_l. by apply Rabs_pos_lt. rewrite -Rabs_div. elim: n => [ | n IH]. rewrite Nat.add_0_r /Rdiv Rinv_r. rewrite Rabs_R1 ; by apply Rle_refl. by apply Ha. replace (Rabs (a (N + S n)%nat / a N)) with (Rabs (a (S (N + n))/a (N+n)%nat) * Rabs (a (N + n)%nat / a N)). simpl ; apply Rmult_le_compat. by apply Rabs_pos. by apply Rabs_pos. apply H, Nat.le_add_r. by apply IH. rewrite -Rabs_mult ; apply f_equal. rewrite plus_n_Sm ; field ; split ; by apply Ha. by apply Ha. apply @ex_series_scal_l. set k0 := ((k + 1) / 2). exists (/(1-k0) * (1-k0*0)). apply filterlim_ext with (fun N => / (1 - k0) * (1 - k0 ^ S N)). move => n ; rewrite sum_n_Reals; rewrite tech3. by apply Rmult_comm. unfold k0 ; lra. apply (is_lim_seq_scal_l (fun N0 => (1 - k0 ^ S N0)) (/ (1 - k0)) (Finite (1-k0*0))). apply (is_lim_seq_minus _ _ (Finite 1) (Finite (k0*0))). by apply is_lim_seq_const. simpl pow ; apply (is_lim_seq_scal_l _ _ (Finite 0)). apply (is_lim_seq_geom k0). rewrite Rabs_pos_eq. unfold k0 ; lra. apply Rle_trans with (2 := H N (Nat.le_refl _)) ; by apply Rabs_pos. easy. Qed. Lemma not_ex_series_DAlembert (a : nat -> R) (l : R) : l > 1 -> (forall n, a n <> 0) -> is_lim_seq (fun n => Rabs (a (S n) / a n)) l -> ~ is_lim_seq a 0. Proof. move => Hl Ha Hda Ha0. set k := (l+1)/2. have Hk1 : 1 < k. unfold k ; lra. have : exists N, forall n, (N <= n)%nat -> k <= Rabs (a (S n) / a n). apply is_lim_seq_spec in Hda. case: (fun H => Hda (mkposreal ((l-1)/2) H)) => [ | /= {Hda} H N Hda]. apply Rdiv_lt_0_compat. by apply -> Rminus_lt_0. by apply Rlt_R0_R2. exists N => n Hn. move: (Hda n Hn) => {} Hda. apply Rabs_lt_between' in Hda. replace (k) with (l - (l - 1) / 2) by (unfold k ; field). by apply Rlt_le, Hda. case => N H. apply is_lim_seq_abs_0, (is_lim_seq_incr_n _ N) in Ha0. have : forall n, Rabs (a N) * k ^ n <= Rabs (a (n + N)%nat). elim => /= [ | n IH]. rewrite Rmult_1_r ; by apply Rle_refl. replace (Rabs (a (S (n + N)))) with (Rabs (a (S (n+N)) / a (n+N)%nat) * Rabs (a (n+N)%nat)) by (rewrite -Rabs_mult ; apply f_equal ; by field). replace (Rabs (a N) * (k * k ^ n)) with (k * (Rabs (a N) * k ^ n)) by ring. apply Rmult_le_compat. by apply Rlt_le, Rlt_trans with (1 := Rlt_0_1). apply Rmult_le_pos. by apply Rabs_pos. apply pow_le. by apply Rlt_le, Rlt_trans with (1 := Rlt_0_1). by apply H, MyNat.le_add_l. by apply IH. move => {} H. have : Finite 0 = p_infty. rewrite -(Lim_seq_geom_p k Hk1). apply sym_equal. apply is_lim_seq_unique. apply is_lim_seq_ext with (fun n => / Rabs (a N) * (Rabs (a N) * k ^ n)). move => n ; field ; by apply Rabs_no_R0. rewrite -(Rmult_0_r (/Rabs (a N))). apply (is_lim_seq_scal_l _ _ (Finite 0)). apply is_lim_seq_le_le with (fun _ => 0) (fun n => Rabs (a (n + N)%nat)). move => n ; split. apply Rmult_le_pos. by apply Rabs_pos. apply pow_le. by apply Rlt_le, Rlt_trans with (1 := Rlt_0_1). by apply H. by apply is_lim_seq_const. by apply Ha0. by []. Qed. Lemma partial_summation_R (a b : nat -> R) : (exists M, forall n, norm (sum_n b n) <= M) -> filterlim a eventually (locally 0) -> ex_series (fun n => norm (minus (a (S n)) (a n))) -> ex_series (fun n => scal (a n) (b n)). Proof. set B := fun n => sum_n b n. intros Hb Ha0 Ha. eexists. unfold is_series. replace (@locally R_NormedModule) with (fun x => Rbar_locally (Finite x)) by auto. apply is_lim_seq_ext with (fun N => plus (scal (a N) (B N)) (match N with | O => zero | S N => sum_n (fun n => scal (minus (a n) (a (S n))) (B n)) N end)). case => /= [ | N]. rewrite /B /= !sum_O ; by apply plus_zero_r. rewrite sum_Sn plus_comm. elim: N => /= [ | N IH]. rewrite /B /= !sum_Sn !sum_O /minus !scal_distr_r !scal_distr_l !scal_opp_l. rewrite -!plus_assoc. apply f_equal. rewrite plus_comm -!plus_assoc. rewrite plus_comm -!plus_assoc. rewrite plus_opp_l. by apply plus_zero_r. rewrite !sum_Sn -IH ; clear IH. rewrite /B /= /minus !sum_Sn. generalize (sum_n (fun n : nat => scal (plus (a n) (opp (a (S n)))) (sum_n b n)) N) => /= c. generalize (sum_n b N) => b'. rewrite !scal_distr_r !scal_distr_l -!plus_assoc !scal_opp_l. repeat apply f_equal. repeat rewrite (plus_comm (scal (a (S (S N))) b')) -!plus_assoc. rewrite plus_comm -!plus_assoc plus_opp_r plus_zero_r. by rewrite plus_assoc plus_opp_l plus_zero_l. apply is_lim_seq_plus'. instantiate (1 := 0). apply filterlim_locally => eps. destruct Hb as [M Hb]. eapply filter_imp. intros n Hn. apply @norm_compat1. rewrite /minus opp_zero plus_zero_r. eapply Rle_lt_trans. apply @norm_scal. eapply Rle_lt_trans. apply Rmult_le_compat_l. by apply abs_ge_0. eapply Rle_trans. by apply Hb. apply (Rmax_r 1). apply Rlt_div_r. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. apply Hn. assert (0 < eps / Rmax 1 M). apply Rdiv_lt_0_compat. by apply eps. eapply Rlt_le_trans, Rmax_l. by apply Rlt_0_1. destruct (proj1 (filterlim_locally _ _) Ha0 (mkposreal _ H)) as [N HN]. exists N => n Hn. eapply Rle_lt_trans, HN, Hn. rewrite /minus opp_zero plus_zero_r. by apply Rle_refl. apply is_lim_seq_incr_1. apply (Lim_seq_correct' (fun n : nat => sum_n (fun n0 : nat => scal (minus (a n0) (a (S n0))) (B n0)) n)). case: Hb => M Hb. eapply @ex_series_le. intros n. eapply Rle_trans. apply @norm_scal. apply Rmult_le_compat_l. by apply abs_ge_0. by apply Hb. apply ex_series_scal_r. move: Ha ; apply ex_series_ext => n. by rewrite -norm_opp /minus opp_plus opp_opp plus_comm. Qed. (** * Geometric series *) Lemma is_series_geom (q : R) : Rabs q < 1 -> is_series (fun n => q ^ n) (/ (1-q)). Proof. move => Hq. apply filterlim_ext with (fun n => (1-q^(S n)) / (1-q)). move => n. rewrite sum_n_Reals; rewrite tech3. reflexivity. apply Rlt_not_eq. apply Rle_lt_trans with (2 := Hq). apply Rle_abs. change (is_lim_seq (fun n : nat => (1 - q ^ S n) / (1 - q)) (/(1-q))). replace ((/ (1 - q))) with (real (Rbar_mult (Rbar_minus 1 0) (/ (1 - q)))). unfold Rdiv. apply (is_lim_seq_scal_r (fun n : nat => (1 - q ^ S n)) (/ (1 - q)) (Rbar_minus 1 0)). apply is_lim_seq_minus'. by apply is_lim_seq_const. apply (is_lim_seq_incr_1 (fun n => q^n)). by apply is_lim_seq_geom. simpl; ring. Qed. Lemma ex_series_geom (q : R) : Rabs q < 1 -> ex_series (fun n => q ^ n). Proof. move => Hq. exists (/(1-q)). by apply is_series_geom. Qed. Lemma Series_geom (q : R) : Rabs q < 1 -> Series (fun n => q ^ n) = / (1-q). Proof. move => Hq. apply is_series_unique. by apply is_series_geom. Qed.