From e3adffb860c1a340a6fd1cc2c539958bc97cbc91 Mon Sep 17 00:00:00 2001 From: IshiguroYoshihiro <103252572+IshiguroYoshihiro@users.noreply.github.com> Date: Fri, 22 Apr 2022 16:52:04 +0900 Subject: [PATCH 01/19] start lebesgue stieltjes measure - up to sigma_sub_additive (wip) --- theories/lebesgue_stieltjes_measure.v | 1641 +++++++++++++++++++++++++ 1 file changed, 1641 insertions(+) create mode 100644 theories/lebesgue_stieltjes_measure.v diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v new file mode 100644 index 0000000000..14da226125 --- /dev/null +++ b/theories/lebesgue_stieltjes_measure.v @@ -0,0 +1,1641 @@ +(* -*- company-coq-local-symbols: (("`&`" . ?∩) ("`|`" . ?∪) ("set0" . ?∅)); -*- *) +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. +From mathcomp Require Import finmap fingroup perm rat. +Require Import boolp reals ereal classical_sets signed topology numfun. +Require Import mathcomp_extra functions normedtype. +From HB Require Import structures. +Require Import sequences esum measure fsbigop cardinality set_interval. +Require Import realfun. + +(******************************************************************************) +(* Lebesgue Measure *) +(* *) +(* This file contains a formalization of the Lebesgue measure using the *) +(* Caratheodory's theorem available in measure.v and further develops the *) +(* theory of measurable functions. *) +(* *) +(* Main reference: *) +(* - Daniel Li, Intégration et applications, 2016 *) +(* - Achim Klenke, Probability Theory 2nd edition, 2014 *) +(* *) +(* hlength A == length of the hull of the set of real numbers A *) +(* ocitv == set of open-closed intervals ]x, y] where *) +(* x and y are real numbers *) +(* lebesgue_measure == the Lebesgue measure *) +(* *) +(* ps_infty == inductive definition of the powerset *) +(* {0, {-oo}, {+oo}, {-oo,+oo}} *) +(* emeasurable G == sigma-algebra over \bar R built out of the *) +(* measurables G of a sigma-algebra over R *) +(* elebesgue_measure == the Lebesgue measure extended to \bar R *) +(* *) +(* The modules RGenOInfty, RGenInftyO, RGenCInfty, RGenOpens provide proofs *) +(* of equivalence between the sigma-algebra generated by list of intervals *) +(* and the sigma-algebras generated by open rays, closed rays, and open *) +(* intervals. *) +(* *) +(* The modules ErealGenOInfty and ErealGenCInfty provide proofs of *) +(* equivalence between emeasurable and the sigmaa-algebras generated open *) +(* rays and closed rays. *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Notation right_continuous f := (forall x, f%function @ at_right x --> f%function x). +(* ToDo : right_continuous + left_continuous = continuous *) + +Section hlength. +Local Open Scope ereal_scope. +Variable R : realType. +Variable f : R -> R. +Hypothesis f_monotone : {homo f : x y / (x <= y)%R}. +Hypothesis f_right_continuous : right_continuous f. + +Let g x := if x is r%:E then (f r)%:E else x. + +Let g_monotone : {homo g : x y / (x <= y)%E}. +Proof. +move=> [r||] [l||]//=. +rewrite !lee_fin. +apply f_monotone. + +by rewrite !leey. +by rewrite !leNye. +Qed. + +Implicit Types i j : interval R. +Definition itvs : Type := R. + +Definition hlength (A : set itvs): \bar R := + let i := Rhull A in g i.2 - g i.1. + +Lemma hlength0 : hlength (set0 : set R) = 0. +Proof. by rewrite /hlength Rhull0 /= subee. Qed. + +Lemma hlength_singleton (r : R) : hlength `[r, r] = 0. +Proof. +rewrite /hlength /= asboolT// sup_itvcc//= asboolT//. +by rewrite asboolT inf_itvcc//= ?subee// inE. +Qed. + +Lemma hlength_itv i : hlength [set` i] = if i.2 > i.1 then g i.2 - g i.1 else 0. +Proof. +case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /hlength set_itvK. +rewrite le_eqVlt => /orP[|/lt_ereal_bnd i12]; last first. + rewrite (_ : [set` i] = set0) ?hlength0//. + by apply/eqP/negPn; rewrite -/(neitv _) neitvE -leNgt (ltW i12). +case: i => -[ba a|[|]] [bb b|[|]] //=. +- rewrite /= => /eqP[->{b}]; move: ba bb => -[] []; try + by rewrite set_itvE hlength0. + by rewrite hlength_singleton. +- by move=> _; rewrite set_itvE hlength0. +- by move=> _; rewrite set_itvE hlength0. +Qed. + +Lemma hlength_setT : hlength setT = +oo%E :> \bar R. +Proof. by rewrite /hlength RhullT. Qed. + +Lemma hlength_finite_fin_num i : neitv i -> hlength [set` i] < +oo -> + ((i.1 : \bar R) \is a fin_num) /\ ((i.2 : \bar R) \is a fin_num). +Proof. +move: i => [[ba a|[]] [bb b|[]]] /neitvP //=; do ?by rewrite ?set_itvE ?eqxx. +by move=> _; rewrite hlength_itv /= ltey. +by move=> _; rewrite hlength_itv /= ltNye. +by move=> _; rewrite hlength_itv. +Qed. + +Lemma finite_hlengthE i : neitv i -> hlength [set` i] < +oo -> + hlength [set` i] = (fine (g i.2))%:E - (fine (g i.1))%:E. +Proof. +move=> i0 ioo; have [ri1 ri2] := hlength_finite_fin_num i0 ioo. +rewrite hlength_itv. +rewrite fineK; last first. +rewrite /g. +move: ri2. +case:(ereal_of_itv_bound i.2) => //. + +rewrite fineK; last first. +rewrite /g. +move: ri1. +case:(ereal_of_itv_bound i.1) => //. + +case: ifPn => //. +rewrite -leNgt le_eqVlt => /predU1P[->|]. + rewrite subee//. +rewrite /g. +move: ri1. +case:(ereal_of_itv_bound i.1) => //. + +by move/lt_ereal_bnd/ltW; rewrite leNgt; move: i0 => /neitvP => ->. + +Qed. + +Lemma hlength_infty_bnd b r : + hlength [set` Interval -oo%O (BSide b r)] = +oo :> \bar R. +Proof. by rewrite hlength_itv /= ltNye. Qed. + +Lemma hlength_bnd_infty b r : + hlength [set` Interval (BSide b r) +oo%O] = +oo :> \bar R. +Proof. by rewrite hlength_itv /= ltey. Qed. + +Lemma pinfty_hlength i : hlength [set` i] = +oo -> + (exists s r, i = Interval -oo%O (BSide s r) \/ i = Interval (BSide s r) +oo%O) + \/ i = `]-oo, +oo[. +Proof. +rewrite hlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. +- by case: ifPn. +- by left; exists ba, a; right. +- by left; exists bb, b; left. +- by right. +Qed. + +Lemma hlength_ge0 i : 0 <= hlength [set` i]. +Proof. +rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. +- rewrite suber_ge0//. + move=> /ltW. + move=> /g_monotone. + done. +- by rewrite ltNge leey. +- by case: (i.2 : \bar _) => //= [r _]; rewrite leey. +Qed. +Local Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. + +Lemma hlength_Rhull (A : set R) : hlength [set` Rhull A] = hlength A. +Proof. by rewrite /hlength Rhull_involutive. Qed. + +Lemma le_hlength_itv i j : {subset i <= j} -> hlength [set` i] <= hlength [set` j]. +Proof. +set I := [set` i]; set J := [set` j]. +have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_ge0. +have [J0|/set0P J0] := eqVneq J set0. + by move/subset_itvP; rewrite -/J J0 subset0 -/I => ->. +move=> /subset_itvP ij; apply: lee_sub => /=. + have [ui|ui] := asboolP (has_ubound I). + have [uj /=|uj] := asboolP (has_ubound J); last by rewrite leey. + rewrite lee_fin. + apply f_monotone. + by rewrite le_sup// => r Ir; exists r; split => //; apply: ij. + have [uj /=|//] := asboolP (has_ubound J). + by move: ui; have := subset_has_ubound ij uj. +have [lj /=|lj] := asboolP (has_lbound J); last by rewrite leNye. +have [li /=|li] := asboolP (has_lbound I); last first. + by move: li; have := subset_has_lbound ij lj. +rewrite lee_fin. apply f_monotone. rewrite ler_oppl opprK le_sup// ?has_inf_supN//; last first. + by case: I0 => x Ix; exists (- x)%R, x. +move=> r [r' Ir' <-{r}]; exists (- r')%R. +by split => //; exists r' => //; apply: ij. +Qed. + +Lemma le_hlength : {homo hlength : A B / (A `<=` B) >-> A <= B}. +Proof. +move=> a b /le_Rhull /le_hlength_itv. +by rewrite (hlength_Rhull a) (hlength_Rhull b). +Qed. + +End hlength. +Arguments hlength {R}. +#[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. + +Section itv_semiRingOfSets. +Variable R : realType. +Implicit Types (I J K : set R). +Local Notation itvs := (itvs R). + +Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. + +Lemma is_ocitv a b : ocitv `]a, b]%classic. +Proof. by exists (a, b); split => //=; rewrite in_itv/= andbT. Qed. +Hint Extern 0 (ocitv _) => solve [apply: is_ocitv] : core. + +Lemma ocitv0 : ocitv set0. +Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. +Hint Resolve ocitv0 : core. + +Lemma ocitvP X : ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. +Proof. +split=> [[x _ <-]|[->//|[x xlt ->]]]//. +case: (boolP (x.1 < x.2)) => x12; first by right; exists x. +by left; rewrite set_itv_ge. +Qed. + +Lemma ocitvD : semi_setD_closed ocitv. +Proof. +move=> _ _ [a _ <-] /ocitvP[|[b ltb]] ->. + rewrite setD0; exists [set `]a.1, a.2]%classic]. + by split=> [//|? ->//||? ? -> ->//]; rewrite bigcup_set1. +rewrite setDE setCitv/= setIUr -!set_itvI. +rewrite /Order.meet/= /Order.meet/= /Order.join/= + ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. +have inside : a.1 < c -> d < a.2 -> `]a.1, c] `&` `]d, a.2] = set0. + rewrite -subset0 lt_minr lt_maxl => /andP[a12 ab1] /andP[_ ba2] x /= []. + have b1a2 : b.1 <= a.2 by rewrite ltW// (lt_trans ltb). + have a1b2 : a.1 <= b.2 by rewrite ltW// (lt_trans _ ltb). + rewrite /c /d (min_idPr _)// (max_idPr _)// !in_itv /=. + move=> /andP[a1x xb1] /andP[b2x xa2]. + by have := lt_le_trans b2x xb1; case: ltgtP ltb. +exists ((if a.1 < c then [set `]a.1, c]%classic] else set0) `|` + (if d < a.2 then [set `]d, a.2]%classic] else set0)); split. +- by rewrite finite_setU; do! case: ifP. +- by move=> ? []; case: ifP => ? // ->//=. +- by rewrite bigcup_setU; congr (_ `|` _); + case: ifPn => ?; rewrite ?bigcup_set1 ?bigcup_set0// set_itv_ge. +- move=> I J/=; case: ifP => //= ac; case: ifP => //= da [] // -> []// ->. + by rewrite inside// => -[]. + by rewrite setIC inside// => -[]. +Qed. + +Lemma ocitvI : setI_closed ocitv. +Proof. +move=> _ _ [a _ <-] [b _ <-]; rewrite -set_itvI/=. +rewrite /Order.meet/= /Order.meet /Order.join/= + ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +by rewrite -negb_or le_total/=. +Qed. + +HB.instance Definition _ : isSemiRingOfSets itvs := + @isSemiRingOfSets.Build itvs (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. + +Definition itvs_semiRingOfSets := [the semiRingOfSetsType of itvs]. + +Lemma hlength_ge0' (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) (I : set itvs) : (0 <= hlength f I)%E. +Proof. + rewrite -(hlength0 f). + rewrite le_hlength//. Qed. + +(* Unused *) +(* Lemma hlength_semi_additive2 : semi_additive2 hlength. *) +(* Proof. *) +(* move=> I J /ocitvP[|[a a12]] ->; first by rewrite set0U hlength0 add0e. *) +(* move=> /ocitvP[|[b b12]] ->; first by rewrite setU0 hlength0 adde0. *) +(* rewrite -subset0 => + ab0 => /ocitvP[|[x x12] abx]. *) +(* by rewrite setU_eq0 => -[-> ->]; rewrite setU0 hlength0 adde0. *) +(* rewrite abx !hlength_itv//= ?lte_fin a12 b12 x12/= -!EFinB -EFinD. *) +(* wlog ab1 : a a12 b b12 ab0 abx / a.1 <= b.1 => [hwlog|]. *) +(* have /orP[ab1|ba1] := le_total a.1 b.1; first by apply: hwlog. *) +(* by rewrite [in RHS]addrC; apply: hwlog => //; rewrite (setIC, setUC). *) +(* have := ab0; rewrite subset0 -set_itv_meet/=. *) +(* rewrite /Order.join /Order.meet/= ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). *) +(* rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. *) +(* move=> /eqP/neitvP/=; rewrite bnd_simp/= /d/c (max_idPr _)// => /negP. *) +(* rewrite -leNgt le_minl orbC lt_geF//= => {c} {d} a2b1. *) +(* have ab i j : i \in `]a.1, a.2] -> j \in `]b.1, b.2] -> i <= j. *) +(* by move=> ia jb; rewrite (le_le_trans _ _ a2b1) ?(itvP ia) ?(itvP jb). *) +(* have /(congr1 sup) := abx; rewrite sup_setU// ?sup_itv_bounded// => bx. *) +(* have /(congr1 inf) := abx; rewrite inf_setU// ?inf_itv_bounded// => ax. *) +(* rewrite -{}ax -{x}bx in abx x12 *. *) +(* case: ltgtP a2b1 => // a2b1 _; last first. *) +(* by rewrite a2b1 [in RHS]addrC subrKA. *) +(* exfalso; pose c := (a.2 + b.1) / 2%:R. *) +(* have /predeqP/(_ c)[_ /(_ _)/Box[]] := abx. *) +(* apply: subset_itv_oo_oc; have := mid_in_itvoo a2b1. *) +(* by apply/subitvP; rewrite subitvE ?bnd_simp/= ?ltW. *) +(* apply/not_orP; rewrite /= !in_itv/=. *) +(* by rewrite lt_geF ?midf_lt//= andbF le_gtF ?midf_le//= ltW. *) +(* Qed. *) + +Lemma hlength_semi_additive (f : R -> R) : semi_additive (hlength f). +Proof. +move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. +move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. +rewrite hlength_itv ?lte_fin/= -EFinB. +case: ifPn => a12; last first. + pose I i := `](b i).1, (b i).2]%classic. + rewrite set_itv_ge//= -(bigcup_mkord _ I) /I => /bigcup0P I0. + by under eq_bigr => i _ do rewrite I0//= hlength0; rewrite big1. +set A := `]a1, a2]%classic. +rewrite -bigcup_pred; set P := xpredT; rewrite (eq_bigl P)//. +move: P => P; have [p] := ubnP #|P|; elim: p => // p IHp in P a2 a12 A *. +rewrite ltnS => cP /esym AE. +have : A a2 by rewrite /A /= in_itv/= lexx andbT. +rewrite AE/= => -[i /= Pi] a2bi. +case: (boolP ((b i).1 < (b i).2)) => bi; last by rewrite itv_ge in a2bi. +have {}a2bi : a2 = (b i).2. + apply/eqP; rewrite eq_le (itvP a2bi)/=. + suff: A (b i).2 by move=> /itvP->. + by rewrite AE; exists i=> //=; rewrite in_itv/= lexx andbT. +rewrite {a2}a2bi in a12 A AE *. +rewrite (bigD1 i)//= hlength_itv ?lte_fin/= bi !EFinD -addeA. +congr (_ + _)%E; apply/eqP; rewrite addeC -sube_eq// 1?adde_defC//. +rewrite ?EFinN oppeK addeC; apply/eqP. +case: (eqVneq a1 (b i).1) => a1bi. + rewrite {a1}a1bi in a12 A AE {IHp} *; rewrite subee ?big1// => j. + move=> /andP[Pj Nji]; rewrite hlength_itv ?lte_fin/=; case: ifPn => bj//. + exfalso; have /trivIsetP/(_ j i I I Nji) := Itriv. + pose m := ((b j).1 + (b j).2) / 2%:R. + have mbj : `](b j).1, (b j).2]%classic m. + by rewrite /= !in_itv/= ?(midf_lt, midf_le)//= ltW. + rewrite -subset0 => /(_ m); apply; split=> //. + by suff: A m by []; rewrite AE; exists j => //. +have a1b2 j : P j -> (b j).1 < (b j).2 -> a1 <= (b j).2. + move=> Pj bj; suff /itvP-> : A (b j).2 by []. + by rewrite AE; exists j => //=; rewrite ?in_itv/= bj//=. +have a1b j : P j -> (b j).1 < (b j).2 -> a1 <= (b j).1. + move=> Pj bj; case: ltP=> // bj1a. + suff : A a1 by rewrite /A/= in_itv/= ltxx. + by rewrite AE; exists j; rewrite //= in_itv/= bj1a//= a1b2. +have bbi2 j : P j -> (b j).1 < (b j).2 -> (b j).2 <= (b i).2. + move=> Pj bj; suff /itvP-> : A (b j).2 by []. + by rewrite AE; exists j => //=; rewrite ?in_itv/= bj//=. +apply/IHp. +- by rewrite lt_neqAle a1bi/= a1b. +- rewrite (leq_trans _ cP)// -(cardID (pred1 i) P). + rewrite [X in (_ < X + _)%N](@eq_card _ _ (pred1 i)); last first. + by move=> j; rewrite !inE andbC; case: eqVneq => // ->. + rewrite ?card1 ?ltnS// subset_leq_card//. + by apply/fintype.subsetP => j; rewrite -topredE/= !inE andbC. +apply/seteqP; split=> /= [x [j/= /andP[Pj Nji]]|x/= xabi]. + case: (boolP ((b j).1 < (b j).2)) => bj; last by rewrite itv_ge. + apply: subitvP; rewrite subitvE ?bnd_simp a1b//= leNgt. + have /trivIsetP/(_ j i I I Nji) := Itriv. + rewrite -subset0 => /(_ (b j).2); apply: contra_notN => /= bi1j2. + by rewrite !in_itv/= bj !lexx bi1j2 bbi2. +have: A x. + rewrite /A/= in_itv/= (itvP xabi)/= ltW//. + by rewrite (le_lt_trans _ bi) ?(itvP xabi). +rewrite AE => -[j /= Pj xbj]. +exists j => //=. +apply/andP; split=> //; apply: contraTneq xbj => ->. +by rewrite in_itv/= le_gtF// (itvP xabi). +Qed. + +Canonical hlength_measure (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) : + {additive_measure set itvs -> \bar R} + := AdditiveMeasure (AdditiveMeasure.Axioms (hlength0 f) + (hlength_ge0' f_monotone) (hlength_semi_additive f)). + +Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. + +Lemma hlength_sigma_sub_additive (f:R -> R) (f_monotone:{homo f : x y / (x <= y)%R}) : sigma_sub_additive (hlength f). +Proof. +move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. +move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. +case: ifPn => a12; last first. rewrite nneseries_esum//; last first. + move=> n _. + by apply:hlength_ge0'. + rewrite esum_ge0//. + move=> n _. + by apply:hlength_ge0'. +apply: lee_adde => e. +rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. +apply: le_trans (epsilon_trick _ _ _) => //=; last first. + move=> n . + by apply hlength_ge0'. +have eVn_gt0 n : 0 < e%:num / 2 / (2 ^ n.+1)%:R. + by rewrite divr_gt0// ltr0n// expn_gt0. +have eVn_ge0 n := ltW (eVn_gt0 n). +pose Aoo i : set itvs := + (`]((b i).1), ((b i).2 + e%:num / 2 / (2 ^ i.+1)%:R)[)%classic. +pose Aoc i : set itvs := + (`]((b i).1), ((b i).2 + e%:num / 2 / (2 ^ i.+1)%:R)])%classic. +have: `[a.1 + e%:num / 2, a.2] `<=` \bigcup_i Aoo i. (* <- *) + apply: (@subset_trans _ `]a.1, a.2]). + move=> x; rewrite /= !in_itv /= => /andP[+ -> //]. + by move=> /lt_le_trans-> //; rewrite ltr_addl. + apply: (subset_trans lebig); apply: subset_bigcup => i _; rewrite AE /Aoo/=. + move=> x /=; rewrite !in_itv /= => /andP[-> /le_lt_trans->]//=. + by rewrite ltr_addl. +have := @segment_compact _ (a.1 + e%:num / 2) a.2; rewrite compact_cover. +move=> /[apply]-[i _|X _ Xc]; first by rewrite /Aoo//; apply: interval_open. +have: `](a.1 + e%:num / 2), a.2] `<=` \bigcup_(i in [set` X]) Aoc i. + move=> x /subset_itv_oc_cc /Xc [i /= Xi] Aooix. + by exists i => //; apply: subset_itv_oo_oc Aooix. +have /[apply] := @content_sub_fsum _ _ [additive_measure of (hlength f)] _ [set` X]. +move=> /(_ f_monotone _ _ _)/Box[]//=. apply: le_le_trans. + rewrite hlength_itv ?lte_fin -?EFinD/= -addrA -opprD. + case: ltP. + rewrite lee_fin. + move=> ae.(* *) + apply ler_sub =>//. + rewrite lerr. + rewrite lee_fin. move=> ae. + apply ler_sub =>//. rewrite subr_le0. +rewrite nneseries_esum//; last by move=> *; rewrite adde_ge0//= ?lee_fin. +rewrite esum_ge//; exists X => //; rewrite fsbig_finite// ?set_fsetK//=. +rewrite lee_sum // => i _; rewrite ?AE// !hlength_itv/= ?lte_fin -?EFinD/=. +do !case: ifPn => //= ?; do ?by rewrite ?adde_ge0 ?lee_fin// ?subr_ge0// ?ltW. + by rewrite addrAC. +by rewrite addrAC lee_fin ler_add// subr_le0 leNgt. +Qed. + +Lemma hlength_sigma_finite : sigma_finite [set: itvs] hlength. +Proof. +exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). + apply/esym; rewrite -subTset => /= x _ /=. + exists `|(floor `|x|%R + 1)%R|%N; rewrite //= in_itv/=. + rewrite !natr_absz intr_norm intrD -RfloorE. + suff: `|x| < `|Rfloor `|x| + 1| by rewrite ltr_norml => /andP[-> /ltW->]. + rewrite [ltRHS]ger0_norm//. + by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. + by rewrite addr_ge0// -Rfloor0 le_Rfloor. +by move=> k; split => //; rewrite hlength_itv/= -EFinB; case: ifP; rewrite ltey. +Qed. + +Let gitvs := g_measurableType ocitv. + +Definition lebesgue_measure : {measure set gitvs -> \bar R} := + Hahn_ext_measure hlength_sigma_sub_additive. + +End itv_semiRingOfSets. +Arguments lebesgue_measure {R}. + +Section lebesgue_measure. +Variable R : realType. +Let gitvs := g_measurableType (@ocitv R). + +Lemma lebesgue_measure_unique (mu : {measure set gitvs -> \bar R}) : + (forall X, ocitv X -> hlength X = mu X) -> + forall X, measurable X -> lebesgue_measure X = mu X. +Proof. +move=> muE X mX; apply: Hahn_ext_unique => //=. +- exact: hlength_sigma_sub_additive. +- exact: hlength_sigma_finite. +Qed. + +End lebesgue_measure. + +Section ps_infty. +Context {T : Type}. +Local Open Scope ereal_scope. + +Inductive ps_infty : set \bar T -> Prop := +| ps_infty0 : ps_infty set0 +| ps_ninfty : ps_infty [set -oo] +| ps_pinfty : ps_infty [set +oo] +| ps_inftys : ps_infty [set -oo; +oo]. + +Lemma ps_inftyP (A : set \bar T) : ps_infty A <-> A `<=` [set -oo; +oo]. +Proof. +split => [[]//|Aoo]. +by have [] := subset_set2 Aoo; move=> ->; constructor. +Qed. + +Lemma setCU_Efin (A : set T) (B : set \bar T) : ps_infty B -> + ~` (EFin @` A) `&` ~` B = (EFin @` ~` A) `|` ([set -oo%E; +oo%E] `&` ~` B). +Proof. +move=> ps_inftyB. +have -> : ~` (EFin @` A) = EFin @` (~` A) `|` [set -oo; +oo]%E. + by rewrite EFin_setC setDKU // => x [|] -> -[]. +rewrite setIUl; congr (_ `|` _); rewrite predeqE => -[x| |]; split; try by case. +by move=> [] x' Ax' [] <-{x}; split; [exists x'|case: ps_inftyB => // -[]]. +Qed. + +End ps_infty. + +Section salgebra_ereal. +Variables (R : realType) (G : set (set R)). +Let measurableTypeR := g_measurableType G. +Let measurableR : set (set R) := @measurable measurableTypeR. + +Definition emeasurable : set (set \bar R) := + [set EFin @` A `|` B | A in measurableR & B in ps_infty]. + +Lemma emeasurable0 : emeasurable set0. +Proof. +exists set0; first exact: measurable0. +by exists set0; rewrite ?setU0// ?image_set0//; constructor. +Qed. + +Lemma emeasurableC (X : set \bar R) : emeasurable X -> emeasurable (~` X). +Proof. +move => -[A mA] [B PooB <-]; rewrite setCU setCU_Efin //. +exists (~` A); [exact: measurableC | exists ([set -oo%E; +oo%E] `&` ~` B) => //]. +case: PooB. +- by rewrite setC0 setIT; constructor. +- rewrite setIUl setICr set0U -setDE. + have [_ ->] := @setDidPl (\bar R) [set +oo%E] [set -oo%E]; first by constructor. + by rewrite predeqE => x; split => // -[->]. +- rewrite setIUl setICr setU0 -setDE. + have [_ ->] := @setDidPl (\bar R) [set -oo%E] [set +oo%E]; first by constructor. + by rewrite predeqE => x; split => // -[->]. +- by rewrite setICr; constructor. +Qed. + +Lemma bigcupT_emeasurable (F : (set \bar R)^nat) : + (forall i, emeasurable (F i)) -> emeasurable (\bigcup_i (F i)). +Proof. +move=> mF; pose P := fun i j => measurableR j.1 /\ ps_infty j.2 /\ + F i = [set x%:E | x in j.1] `|` j.2. +have [f fi] : {f : nat -> (set R) * (set \bar R) & forall i, P i (f i) }. + by apply: choice => i; have [x mx [y PSoo'y] xy] := mF i; exists (x, y). +exists (\bigcup_i (f i).1). + by apply: bigcupT_measurable => i; exact: (fi i).1. +exists (\bigcup_i (f i).2). + apply/ps_inftyP => x [n _] fn2x. + have /ps_inftyP : ps_infty(f n).2 by have [_ []] := fi n. + exact. +rewrite [RHS](@eq_bigcupr _ _ _ _ + (fun i => [set x%:E | x in (f i).1] `|` (f i).2)); last first. + by move=> i; have [_ []] := fi i. +rewrite bigcupU; congr (_ `|` _). +rewrite predeqE => i /=; split=> [[r [n _ fn1r <-{i}]]|[n _ [r fn1r <-{i}]]]; + by [exists n => //; exists r | exists r => //; exists n]. +Qed. + +Definition ereal_isMeasurable : isMeasurable (\bar R) := + isMeasurable.Build _ (Pointed.class _) + emeasurable0 emeasurableC bigcupT_emeasurable. + +End salgebra_ereal. + +Section puncture_ereal_itv. +Variable R : realDomainType. +Implicit Types (y : R) (b : bool). +Local Open Scope ereal_scope. + +Lemma punct_eitv_bnd_pinfty b y : [set` Interval (BSide b y%:E) +oo%O] = + EFin @` [set` Interval (BSide b y) +oo%O] `|` [set +oo]. +Proof. +rewrite predeqE => x; split; rewrite /= in_itv andbT. +- move: x => [x| |] yxb; [|by right|by case: b yxb]. + by left; exists x => //; rewrite in_itv /= andbT; case: b yxb. +- move=> [[r]|->]. + + by rewrite in_itv /= andbT => yxb <-; case: b yxb. + + by case: b => /=; rewrite ?(ltey, leey). +Qed. + +Lemma punct_eitv_ninfty_bnd b y : [set` Interval -oo%O (BSide b y%:E)] = + [set -oo%E] `|` EFin @` [set x | x \in Interval -oo%O (BSide b y)]. +Proof. +rewrite predeqE => x; split; rewrite /= in_itv. +- move: x => [x| |] yxb; [|by case: b yxb|by left]. + by right; exists x => //; rewrite in_itv /= andbT; case: b yxb. +- move=> [->|[r]]. + + by case: b => /=; rewrite ?(ltNye, leNye). + + by rewrite in_itv /= => yxb <-; case: b yxb. +Qed. + +Lemma punct_eitv_setTR : range (@EFin R) `|` [set +oo] = [set~ -oo]. +Proof. +rewrite eqEsubset; split => [a [[a' _ <-]|->]|] //. +by move=> [x| |] //= _; [left; exists x|right]. +Qed. + +Lemma punct_eitv_setTL : range (@EFin R) `|` [set -oo] = [set~ +oo]. +Proof. +rewrite eqEsubset; split => [a [[a' _ <-]|->]|] //. +by move=> [x| |] //= _; [left; exists x|right]. +Qed. + +End puncture_ereal_itv. + +Lemma set1_bigcap_oc (R : realType) (r : R) : + [set r] = \bigcap_i `]r - i.+1%:R^-1, r]%classic. +Proof. +apply/seteqP; split=> [x ->|]. + by move=> i _/=; rewrite in_itv/= lexx ltr_subl_addr ltr_addl invr_gt0 ltr0n. +move=> x rx; apply/esym/eqP; rewrite eq_le (itvP (rx 0%N _))// andbT. +apply/ler_addgt0Pl => e e_gt0; rewrite -ler_subl_addl ltW//. +have := rx `|floor e^-1%R|%N I; rewrite /= in_itv => /andP[/le_lt_trans->]//. +rewrite ler_add2l ler_opp2 -lef_pinv ?invrK//; last by rewrite qualifE invr_gt0. +rewrite -addn1 natrD natr_absz ger0_norm ?floor_ge0 ?invr_ge0 1?ltW//. +by rewrite -RfloorE lt_succ_Rfloor. +Qed. + +Section salgebra_R_ssets. +Variable R : realType. + +Definition measurableTypeR := + g_measurableType (@measurable (@itvs_semiRingOfSets R)). + +Definition measurableR : set (set R) := @measurable measurableTypeR. + +HB.instance Definition R_isMeasurable : isMeasurable R := + isMeasurable.Build measurableTypeR (Pointed.class R) + measurable0 (@measurableC _) (@bigcupT_measurable _). +(*HB.instance (Real.sort R) R_isMeasurable.*) + +Lemma measurable_set1 (r : R) : measurable [set r]. +Proof. +rewrite set1_bigcap_oc; apply: bigcap_measurable => k // _. +by apply: sub_sigma_algebra; exact/is_ocitv. +Qed. +#[local] Hint Resolve measurable_set1 : core. + +Lemma measurable_itv (i : interval R) : measurable [set` i]. +Proof. +have moc (a b : R) : measurable `]a, b]%classic. + by apply: sub_sigma_algebra; apply: is_ocitv. +have pooE (x : R) : `]x, +oo[%classic = \bigcup_i `]x, x + i%:R]%classic. + apply/seteqP; split=> y; rewrite /= !in_itv/= andbT; last first. + by move=> [k _ /=] /itvP->. + move=> xy; exists `|ceil (y - x)|%N => //=. + rewrite in_itv/= xy/= -ler_subl_addl !natr_absz/=. + rewrite ger0_norm ?ceil_ge0 ?subr_ge0//; last exact: ltW. + by rewrite -RceilE Rceil_ge. +have mopoo (x : R) : measurable `]x, +oo[%classic. + by rewrite pooE; exact: bigcup_measurable. +have mnooc (x : R) : measurable `]-oo, x]%classic. + by rewrite -setCitvr; exact/measurableC. +have ooE (a b : R) : `]a, b[%classic = `]a, b]%classic `\ b. + case: (boolP (a < b)) => ab; last by rewrite !set_itv_ge ?set0D. + by rewrite -setUitv1// setUDK// => x [->]; rewrite /= in_itv/= ltxx andbF. +have moo (a b : R) : measurable `]a, b[%classic. + by rewrite ooE; exact: measurableD. +have mcc (a b : R) : measurable `[a, b]%classic. + case: (boolP (a <= b)) => ab; last by rewrite set_itv_ge. + by rewrite -setU1itv//; apply/measurableU. +have mco (a b : R) : measurable `[a, b[%classic. + case: (boolP (a < b)) => ab; last by rewrite set_itv_ge. + by rewrite -setU1itv//; apply/measurableU. +have oooE (b : R) : `]-oo, b[%classic = `]-oo, b]%classic `\ b. + by rewrite -setUitv1// setUDK// => x [->]; rewrite /= in_itv/= ltxx. +case: i => [[[] a|[]] [[] b|[]]] => //; do ?by rewrite set_itv_ge. +- by rewrite -setU1itv//; exact/measurableU. +- by rewrite oooE; exact/measurableD. +- by rewrite set_itv_infty_infty. +Qed. + +HB.instance Definition _ := + ereal_isMeasurable (@measurable (@itvs_semiRingOfSets R)). +(* NB: Until we dropped support for Coq 8.12, we were using +HB.instance (\bar (Real.sort R)) + (ereal_isMeasurable (@measurable (@itvs_semiRingOfSets R))). +This was producing a warning but the alternative was failing with Coq 8.12 with + the following message (according to the CI): + # [redundant-canonical-projection,typechecker] + # forall (T : measurableType) (f : T -> R), measurable_fun setT f + # : Prop + # File "./theories/lebesgue_measure.v", line 4508, characters 0-88: + # Error: Anomaly "Uncaught exception Failure("sep_last")." + # Please report at http://coq.inria.fr/bugs/. +*) + +Lemma measurable_EFin (A : set R) : measurableR A -> measurable (EFin @` A). +Proof. +by move=> mA; exists A => //; exists set0; [constructor|rewrite setU0]. +Qed. + +Lemma emeasurable_set1 (x : \bar R) : measurable [set x]. +Proof. +case: x => [r| |]. +- by rewrite -image_set1; apply: measurable_EFin; apply: measurable_set1. +- exists set0 => //; [exists [set +oo%E]; [by constructor|]]. + by rewrite image_set0 set0U. +- exists set0 => //; [exists [set -oo%E]; [by constructor|]]. + by rewrite image_set0 set0U. +Qed. +#[local] Hint Resolve emeasurable_set1 : core. + +Lemma itv_cpinfty_pinfty : `[+oo%E, +oo[%classic = [set +oo%E] :> set (\bar R). +Proof. +rewrite set_itvE predeqE => t; split => /= [|<-//]. +by rewrite lee_pinfty_eq => /eqP. +Qed. + +Lemma itv_opinfty_pinfty : `]+oo%E, +oo[%classic = set0 :> set (\bar R). +Proof. +by rewrite set_itvE predeqE => t; split => //=; apply/negP; rewrite -leNgt leey. +Qed. + +Lemma itv_cninfty_pinfty : `[-oo%E, +oo[%classic = setT :> set (\bar R). +Proof. by rewrite set_itvE predeqE => t; split => //= _; rewrite leNye. Qed. + +Lemma itv_oninfty_pinfty : + `]-oo%E, +oo[%classic = ~` [set -oo]%E :> set (\bar R). +Proof. +rewrite set_itvE predeqE => x; split => /=. +- by move: x => [x| |]; rewrite ?ltxx. +- by move: x => [x h|//|/(_ erefl)]; rewrite ?ltNye. +Qed. + +Lemma emeasurable_itv_bnd_pinfty b (y : \bar R) : + measurable [set` Interval (BSide b y) +oo%O]. +Proof. +move: y => [y| |]. +- exists [set` Interval (BSide b y) +oo%O]; first exact: measurable_itv. + by exists [set +oo%E]; [constructor|rewrite -punct_eitv_bnd_pinfty]. +- by case: b; rewrite ?itv_opinfty_pinfty ?itv_cpinfty_pinfty. +- case: b; first by rewrite itv_cninfty_pinfty. + by rewrite itv_oninfty_pinfty; exact/measurableC. +Qed. + +Lemma emeasurable_itv_ninfty_bnd b (y : \bar R) : + measurable [set` Interval -oo%O (BSide b y)]. +Proof. +by rewrite -setCitvr; exact/measurableC/emeasurable_itv_bnd_pinfty. +Qed. + +Definition elebesgue_measure' : set \bar R -> \bar R := + fun S => lebesgue_measure (fine @` (S `\` [set -oo; +oo]%E)). + +Lemma elebesgue_measure'0 : elebesgue_measure' set0 = 0%E. +Proof. by rewrite /elebesgue_measure' set0D image_set0 measure0. Qed. + +Lemma measurable_fine (X : set \bar R) : measurable X -> + measurable [set fine x | x in X `\` [set -oo; +oo]%E]. +Proof. +case => Y mY [X' [ | <-{X} | <-{X} | <-{X} ]]. +- rewrite setU0 => <-{X}. + rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. + by move=> [x [[x' Yx' <-{x}/= _ <-//]]]. + by move=> Yr; exists r%:E; split => [|[]//]; exists r. +- rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. + move=> [x [[[x' Yx' <- _ <-//]|]]]. + by move=> <-; rewrite not_orP => -[]/(_ erefl). + by move=> Yr; exists r%:E => //; split => [|[]//]; left; exists r. +- rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. + move=> [x [[[x' Yx' <-{x} _ <-//]|]]]. + by move=> ->; rewrite not_orP => -[_]/(_ erefl). + by move=> Yr; exists r%:E => //; split => [|[]//]; left; exists r. +- rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. + by rewrite setDUl setDv setU0 => -[_ [[x' Yx' <-]] _ <-]. + by move=> Yr; exists r%:E => //; split => [|[]//]; left; exists r. +Qed. + +Lemma elebesgue_measure'_ge0 X : (0 <= elebesgue_measure' X)%E. +Proof. exact/measure_ge0. Qed. + +Lemma semi_sigma_additive_elebesgue_measure' : + semi_sigma_additive elebesgue_measure'. +Proof. +move=> /= F mF tF mUF; rewrite /elebesgue_measure'. +rewrite [X in lebesgue_measure X](_ : _ = + \bigcup_n (fine @` (F n `\` [set -oo; +oo]%E))); last first. + rewrite predeqE => r; split. + by move=> [x [[n _ Fnx xoo <-]]]; exists n => //; exists x. + by move=> [n _ [x [Fnx xoo <-{r}]]]; exists x => //; split => //; exists n. +apply: (@measure_semi_sigma_additive _ _ (@lebesgue_measure R) + (fun n => fine @` (F n `\` [set -oo; +oo]%E))). +- move=> n; have := mF n. + move=> [X mX [X' mX']] XX'Fn. + apply: measurable_fine. + rewrite -XX'Fn. + apply: measurableU; first exact: measurable_EFin. + by case: mX' => //; exact: measurableU. +- move=> i j _ _ [x [[a [Fia aoo ax] [b [Fjb boo] bx]]]]. + move: tF => /(_ i j Logic.I Logic.I); apply. + suff ab : a = b by exists a; split => //; rewrite ab. + move: a b {Fia Fjb} aoo boo ax bx. + move=> [a| |] [b| |] /=. + + by move=> _ _ -> ->. + + by move=> _; rewrite not_orP => -[_]/(_ erefl). + + by move=> _; rewrite not_orP => -[]/(_ erefl). + + by rewrite not_orP => -[_]/(_ erefl). + + by rewrite not_orP => -[_]/(_ erefl). + + by rewrite not_orP => -[_]/(_ erefl). + + by rewrite not_orP => -[]/(_ erefl). + + by rewrite not_orP => -[]/(_ erefl). + + by rewrite not_orP => -[]/(_ erefl). +- move: mUF. + rewrite {1}/measurable /emeasurable /= => -[X mX [Y []]] {Y}. + - rewrite setU0 => h. + rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. + move=> -[n _ [x [Fnx xoo <-{r}]]]. + have : (\bigcup_n F n) x by exists n. + by rewrite -h => -[x' Xx' <-]. + have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; exists r. + by exists n => //; exists r%:E => //; split => //; case. + - move=> h. + rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. + move=> -[n _ [x [Fnx xoo <-]]]. + have : (\bigcup_n F n) x by exists n. + by rewrite -h => -[[x' Xx' <-//]|xoo']; move/not_orP : xoo => -[]. + have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; left; exists r. + by exists n => //; exists r%:E => //; split => //; case. + - (* NB: almost the same as the previous one, factorize?*) + move=> h. + rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. + move=> -[n _ [x [Fnx xoo <-]]]. + have : (\bigcup_n F n) x by exists n. + by rewrite -h => -[[x' Xx' <-//]|xoo']; move/not_orP : xoo => -[]. + have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; left; exists r. + by exists n => //; exists r%:E => //; split => //; case. + - move=> h. + rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. + move=> -[n _ [x [Fnx xoo <-]]]. + have : (\bigcup_n F n) x by exists n. + by rewrite -h => -[[x' Xx' <-//]|]. + have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; left; exists r. + by exists n => //; exists r%:E => //; split => //; case. +Qed. + +Definition elebesgue_measure_isMeasure : is_measure elebesgue_measure' := + Measure.Axioms elebesgue_measure'0 elebesgue_measure'_ge0 + semi_sigma_additive_elebesgue_measure'. + +Definition elebesgue_measure : {measure set \bar R -> \bar R} := + Measure.Pack _ elebesgue_measure_isMeasure. + +End salgebra_R_ssets. +#[global] +Hint Extern 0 (measurable [set _]) => solve [apply: measurable_set1| + apply: emeasurable_set1] : core. + +Section measurable_fun_measurable. +Local Open Scope ereal_scope. +Variables (T : measurableType) (R : realType) (D : set T) (f : T -> \bar R). +Hypotheses (mD : measurable D) (mf : measurable_fun D f). +Implicit Types y : \bar R. + +Lemma emeasurable_fun_c_infty y : measurable (D `&` [set x | y <= f x]). +Proof. +by rewrite -preimage_itv_c_infty; exact/mf/emeasurable_itv_bnd_pinfty. +Qed. + +Lemma emeasurable_fun_o_infty y : measurable (D `&` [set x | y < f x]). +Proof. +by rewrite -preimage_itv_o_infty; exact/mf/emeasurable_itv_bnd_pinfty. +Qed. + +Lemma emeasurable_fun_infty_o y : measurable (D `&` [set x | f x < y]). +Proof. +by rewrite -preimage_itv_infty_o; exact/mf/emeasurable_itv_ninfty_bnd. +Qed. + +Lemma emeasurable_fun_infty_c y : measurable (D `&` [set x | f x <= y]). +Proof. +by rewrite -preimage_itv_infty_c; exact/mf/emeasurable_itv_ninfty_bnd. +Qed. + +Lemma emeasurable_fin_num : measurable (D `&` [set x | f x \is a fin_num]). +Proof. +rewrite [X in measurable X](_ : _ = + \bigcup_k (D `&` ([set x | - k%:R%:E <= f x] `&` [set x | f x <= k%:R%:E]))). + apply: bigcupT_measurable => k; rewrite -(setIid D) setIACA. + by apply: measurableI; [exact: emeasurable_fun_c_infty| + exact: emeasurable_fun_infty_c]. +rewrite predeqE => t; split => [/= [Dt ft]|]. + have [ft0|ft0] := leP 0%R (fine (f t)). + exists `|ceil (fine (f t))|%N => //=; split => //; split. + by rewrite -{2}(fineK ft)// lee_fin (le_trans _ ft0)// ler_oppl oppr0. + by rewrite natr_absz ger0_norm ?ceil_ge0// -(fineK ft) lee_fin ceil_ge. + exists `|floor (fine (f t))|%N => //=; split => //; split. + rewrite natr_absz ltr0_norm ?floor_lt0// EFinN. + by rewrite -{2}(fineK ft) lee_fin mulrNz opprK floor_le. + by rewrite -(fineK ft)// lee_fin (le_trans (ltW ft0)). +move=> [n _] [/= Dt [nft fnt]]; split => //; rewrite fin_numElt. +by rewrite (lt_le_trans _ nft) ?ltNye//= (le_lt_trans fnt)// ltey. +Qed. + +Lemma emeasurable_neq y : measurable (D `&` [set x | f x != y]). +Proof. +rewrite (_ : [set x | f x != y] = f @^-1` (setT `\ y)). + exact/mf/measurableD. +rewrite predeqE => t; split; last by rewrite /preimage /= => -[_ /eqP]. +by rewrite /= => ft0; rewrite /preimage /=; split => //; exact/eqP. +Qed. + +End measurable_fun_measurable. + +Module RGenOInfty. +Section rgenoinfty. +Variable R : realType. +Implicit Types x y z : R. + +Definition G := [set A | exists x, A = `]x, +oo[%classic]. +Let T := g_measurableType G. + +Lemma measurable_itv_bnd_infty b x : + @measurable T [set` Interval (BSide b x) +oo%O]. +Proof. +case: b; last by apply: sub_sigma_algebra; eexists; reflexivity. +rewrite itv_c_inftyEbigcap; apply: bigcapT_measurable => k. +by apply: sub_sigma_algebra; eexists; reflexivity. +Qed. + +Lemma measurable_itv_bounded a b x : a != +oo%O -> + @measurable T [set` Interval a (BSide b x)]. +Proof. +case: a => [a r _|[_|//]]. + by rewrite set_itv_splitD; apply: measurableD => //; + exact: measurable_itv_bnd_infty. +by rewrite -setCitvr; apply: measurableC; apply: measurable_itv_bnd_infty. +Qed. + +Lemma measurableE : + @measurable (g_measurableType (measurable : set (set (itvs R)))) = + @measurable T. +Proof. +rewrite eqEsubset; split => A. + apply: smallest_sub; first exact: smallest_sigma_algebra. + by move=> I [x _ <-]; exact: measurable_itv_bounded. +apply: smallest_sub; first exact: smallest_sigma_algebra. +by move=> A' /= [x ->]; exact: measurable_itv. +Qed. + +End rgenoinfty. +End RGenOInfty. + +Module RGenInftyO. +Section rgeninftyo. +Variable R : realType. +Implicit Types x y z : R. + +Definition G := [set A | exists x, A = `]-oo, x[%classic]. +Let T := g_measurableType G. + +Lemma measurable_itv_bnd_infty b x : + @measurable T [set` Interval -oo%O (BSide b x)]. +Proof. +case: b; first by apply sub_sigma_algebra; eexists; reflexivity. +rewrite -setCitvr itv_o_inftyEbigcup; apply/measurableC/bigcupT_measurable => n. +rewrite -setCitvl; apply: measurableC. +by apply: sub_sigma_algebra; eexists; reflexivity. +Qed. + +Lemma measurable_itv_bounded a b x : a != -oo%O -> + @measurable T [set` Interval (BSide b x) a]. +Proof. +case: a => [a r _|[//|_]]. + by rewrite set_itv_splitD; apply/measurableD => //; + rewrite -setCitvl; apply: measurableC; exact: measurable_itv_bnd_infty. +by rewrite -setCitvl; apply: measurableC; apply: measurable_itv_bnd_infty. +Qed. + +Lemma measurableE : + @measurable (g_measurableType (measurable : set (set (itvs R)))) = + @measurable T. +Proof. +rewrite eqEsubset; split => A. + apply: smallest_sub; first exact: smallest_sigma_algebra. + by move=> I [x _ <-]; apply: measurable_itv_bounded. +apply: smallest_sub; first exact: smallest_sigma_algebra. +by move=> A' /= [x ->]; apply: measurable_itv. +Qed. + +End rgeninftyo. +End RGenInftyO. + +Module RGenCInfty. +Section rgencinfty. +Variable R : realType. +Implicit Types x y z : R. + +Definition G : set (set R) := [set A | exists x, A = `[x, +oo[%classic]. +Let T := g_measurableType G. + +Lemma measurable_itv_bnd_infty b x : + @measurable T [set` Interval (BSide b x) +oo%O]. +Proof. +case: b; first by apply: sub_sigma_algebra; exists x; rewrite set_itv_c_infty. +rewrite itv_o_inftyEbigcup; apply: bigcupT_measurable => k. +by apply: sub_sigma_algebra; eexists; reflexivity. +Qed. + +Lemma measurable_itv_bounded a b y : a != +oo%O -> + @measurable T [set` Interval a (BSide b y)]. +Proof. +case: a => [a r _|[_|//]]. + rewrite set_itv_splitD. + by apply: measurableD; apply: measurable_itv_bnd_infty. +by rewrite -setCitvr; apply: measurableC; apply: measurable_itv_bnd_infty. +Qed. + +Lemma measurableE : + @measurable (g_measurableType (measurable : set (set (itvs R)))) = + @measurable T. +Proof. +rewrite eqEsubset; split => A. + apply: smallest_sub; first exact: smallest_sigma_algebra. + by move=> I [x _ <-]; apply: measurable_itv_bounded. +apply: smallest_sub; first exact: smallest_sigma_algebra. +by move=> A' /= [x ->]; apply: measurable_itv. +Qed. + +End rgencinfty. +End RGenCInfty. + +Module RGenOpens. +Section rgenopens. + +Variable R : realType. +Implicit Types x y z : R. + +Definition G := [set A | exists x y, A = `]x, y[%classic]. +Let T := g_measurableType G. + +Local Lemma measurable_itvoo x y : @measurable T `]x, y[%classic. +Proof. by apply sub_sigma_algebra; eexists; eexists; reflexivity. Qed. + +Local Lemma measurable_itv_o_infty x : @measurable T `]x, +oo[%classic. +Proof. +rewrite itv_bnd_inftyEbigcup; apply: bigcupT_measurable => i. +exact: measurable_itvoo. +Qed. + +Lemma measurable_itv_bnd_infty b x : + @measurable T [set` Interval (BSide b x) +oo%O]. +Proof. +case: b; last exact: measurable_itv_o_infty. +rewrite itv_c_inftyEbigcap; apply: bigcapT_measurable => k. +exact: measurable_itv_o_infty. +Qed. + +Lemma measurable_itv_infty_bnd b x : + @measurable T [set` Interval -oo%O (BSide b x)]. +Proof. +by rewrite -setCitvr; apply: measurableC; exact: measurable_itv_bnd_infty. +Qed. + +Lemma measurable_itv_bounded a x b y : + @measurable T [set` Interval (BSide a x) (BSide b y)]. +Proof. +move: a b => [] []; rewrite -[X in measurable X]setCK setCitv; + apply: measurableC; apply: measurableU; try solve[ + exact: measurable_itv_infty_bnd|exact: measurable_itv_bnd_infty]. +Qed. + +Lemma measurableE : + @measurable (g_measurableType (measurable : set (set (itvs R)))) = + @measurable T. +Proof. +rewrite eqEsubset; split => A. + apply: smallest_sub; first exact: smallest_sigma_algebra. + by move=> I [x _ <-]; apply: measurable_itv_bounded. +apply: smallest_sub; first exact: smallest_sigma_algebra. +by move=> A' /= [x [y ->]]; apply: measurable_itv. +Qed. + +End rgenopens. +End RGenOpens. + +Section erealwithrays. +Variable R : realType. +Implicit Types (x y z : \bar R) (r s : R). +Local Open Scope ereal_scope. + +Lemma EFin_itv_bnd_infty b r : EFin @` [set` Interval (BSide b r) +oo%O] = + [set` Interval (BSide b r%:E) +oo%O] `\ +oo. +Proof. +rewrite eqEsubset; split => [x [s /itvP rs <-]|x []]. + split => //=; rewrite in_itv /=. + by case: b in rs *; rewrite /= ?(lee_fin, lte_fin) rs. +move: x => [s|_ /(_ erefl)|] //=; rewrite in_itv /= andbT; last first. + by case: b => /=; rewrite 1?(leNgt,ltNge) 1?(ltNye, leNye). +by case: b => /=; rewrite 1?(lte_fin,lee_fin) => rs _; + exists s => //; rewrite in_itv /= rs. +Qed. + +Lemma EFin_itv r : [set s | r%:E < s%:E] = `]r, +oo[%classic. +Proof. +by rewrite predeqE => s; split => [|]; rewrite /= lte_fin in_itv/= andbT. +Qed. + +Lemma preimage_EFin_setT : @EFin R @^-1` [set x | x \in `]-oo%E, +oo[] = setT. +Proof. +by rewrite set_itvE predeqE => r; split=> // _; rewrite /preimage /= ltNye. +Qed. + +Lemma eitv_c_infty r : `[r%:E, +oo[%classic = + \bigcap_k `](r - k.+1%:R^-1)%:E, +oo[%classic :> set _. +Proof. +rewrite predeqE => x; split=> [|]. +- move: x => [s /=| _ n _|//]. + + rewrite in_itv /= andbT lee_fin => rs n _ /=. + rewrite in_itv /= andbT lte_fin. + by rewrite ltr_subl_addl (le_lt_trans rs)// ltr_addr invr_gt0. + + by rewrite /= in_itv /= andbT ltey. +- move: x => [s| |/(_ 0%N Logic.I)] //=; last by rewrite in_itv /= leey. + move=> h; rewrite in_itv /= lee_fin leNgt andbT; apply/negP. + move=> /ltr_add_invr[k skr]; have {h} := h k Logic.I. + rewrite /= in_itv /= andbT lte_fin ltNge => /negP; apply. + by rewrite -ler_subl_addr opprK ltW. +Qed. + +Lemma eitv_infty_c r : `]-oo, r%:E]%classic = + \bigcap_k `]-oo, (r%:E + k.+1%:R^-1%:E)]%classic :> set _. +Proof. +rewrite predeqE => x; split=> [|]. +- move: x => [s /=|//|_ n _]. + + rewrite in_itv /= lee_fin => sr n _; rewrite /= in_itv /=. + by rewrite -EFinD lee_fin (le_trans sr)// ler_addl invr_ge0. + + by rewrite /= in_itv /= -EFinD leNye. +- move: x => [s|/(_ 0%N Logic.I)//|]/=; rewrite ?in_itv /= ?leNye//. + move=> h; rewrite lee_fin leNgt; apply/negP => /ltr_add_invr[k rks]. + have {h} := h k Logic.I; rewrite /= in_itv /=. + by rewrite -EFinD lee_fin leNgt => /negP; apply. +Qed. + +Lemma eset1_ninfty : + [set -oo] = \bigcap_k `]-oo, (-k%:R%:E)[%classic :> set (\bar R). +Proof. +rewrite eqEsubset; split=> [_ -> i _ |]; first by rewrite /= in_itv /= ltNye. +move=> [r|/(_ O Logic.I)|]//. +move=> /(_ `|floor r|%N Logic.I); rewrite /= in_itv/= ltNge. +rewrite lee_fin; have [r0|r0] := leP 0%R r. + by rewrite (le_trans _ r0) // ler_oppl oppr0 ler0n. +rewrite ler_oppl -abszN natr_absz gtr0_norm; last first. + by rewrite ltr_oppr oppr0 floor_lt0. +by rewrite mulrNz ler_oppl opprK floor_le. +Qed. + +Lemma eset1_pinfty : + [set +oo] = \bigcap_k `]k%:R%:E, +oo[%classic :> set (\bar R). +Proof. +rewrite eqEsubset; split=> [_ -> i _/=|]; first by rewrite in_itv /= ltey. +move=> [r| |/(_ O Logic.I)] // /(_ `|ceil r|%N Logic.I); rewrite /= in_itv /=. +rewrite andbT lte_fin ltNge. +have [r0|r0] := ltP 0%R r; last by rewrite (le_trans r0). +by rewrite natr_absz gtr0_norm // ?ceil_ge// ceil_gt0. +Qed. + +End erealwithrays. + +Module ErealGenOInfty. +Section erealgenoinfty. +Variable R : realType. +Implicit Types (x y z : \bar R) (r s : R). + +Local Open Scope ereal_scope. + +Definition G := [set A : set \bar R | exists x, A = `]x, +oo[%classic]. +Let T := g_measurableType G. + +Lemma measurable_set1_ninfty : @measurable T [set -oo]. +Proof. +rewrite eset1_ninfty; apply: (@bigcapT_measurable T) => i. +rewrite -setCitvr; apply: measurableC; rewrite eitv_c_infty. +apply: bigcapT_measurable => j; apply: sub_sigma_algebra. +by exists (- (i%:R + j.+1%:R^-1))%:E; rewrite opprD. +Qed. + +Lemma measurable_set1_pinfty : @measurable T [set +oo]. +Proof. +rewrite eset1_pinfty; apply: bigcapT_measurable => i. +by apply: sub_sigma_algebra; exists i%:R%:E. +Qed. + +Lemma measurableE : emeasurable (measurable : set (set (itvs R))) = @measurable T. +Proof. +apply/seteqP; split; last first. + apply: smallest_sub. + split; first exact: emeasurable0. + by move=> *; rewrite setTD; exact: emeasurableC. + by move=> *; exact: bigcupT_emeasurable. + move=> _ [x ->]; rewrite /emeasurable /=; move: x => [r| |]. + + exists `]r, +oo[%classic. + rewrite RGenOInfty.measurableE. + exact: RGenOInfty.measurable_itv_bnd_infty. + by exists [set +oo]; [constructor|rewrite -punct_eitv_bnd_pinfty]. + + exists set0 => //. + by exists set0; [constructor|rewrite setU0 itv_opinfty_pinfty image_set0]. + + exists setT => //; exists [set +oo]; first by constructor. + by rewrite itv_oninfty_pinfty punct_eitv_setTR. +move=> A [B mB [C mC]] <-; apply: measurableU; last first. + case: mC; [by []|exact: measurable_set1_ninfty + |exact: measurable_set1_pinfty|]. + - by apply: measurableU; [exact: measurable_set1_ninfty| + exact: measurable_set1_pinfty]. +rewrite RGenOInfty.measurableE in mB. +have smB := smallest_sub _ _ mB. +(* BUG: elim/smB : _. fails !! *) +apply: (smB (@measurable T \o (image^~ EFin))); last first. + move=> _ [r ->]/=; rewrite EFin_itv_bnd_infty; apply: measurableD. + by apply sub_sigma_algebra => /=; exists r%:E. + exact: measurable_set1_pinfty. +split=> /= [|D mD|F mF]; first by rewrite image_set0. +- rewrite setTD EFin_setC; apply: measurableD; first exact: measurableC. + by apply: measurableU; [exact: measurable_set1_ninfty| + exact: measurable_set1_pinfty]. +- by rewrite EFin_bigcup; apply: bigcupT_measurable => i; exact: mF. +Qed. + +End erealgenoinfty. +End ErealGenOInfty. + +Module ErealGenCInfty. +Section erealgencinfty. +Variable R : realType. +Implicit Types (x y z : \bar R) (r s : R). +Local Open Scope ereal_scope. + +Definition G := [set A : set \bar R | exists x, A = `[x, +oo[%classic]. +Let T := g_measurableType G. + +Lemma measurable_set1_ninfty : @measurable T [set -oo]. +Proof. +rewrite eset1_ninfty; apply: bigcapT_measurable=> i; rewrite -setCitvr. +by apply: measurableC; apply: sub_sigma_algebra; exists (- i%:R)%:E. +Qed. + +Lemma measurable_set1_pinfty : @measurable T [set +oo]. +Proof. +apply: sub_sigma_algebra; exists +oo; rewrite predeqE => x; split => [->//|/=]. +by rewrite in_itv /= andbT lee_pinfty_eq => /eqP ->. +Qed. + +Lemma measurableE : emeasurable (measurable : set (set (itvs R))) = @measurable T. +Proof. +apply/seteqP; split; last first. + apply: smallest_sub. + split; first exact: emeasurable0. + by move=> *; rewrite setTD; exact: emeasurableC. + by move=> *; exact: bigcupT_emeasurable. + move=> _ [[r||] ->]/=. + - exists `[r, +oo[%classic. + rewrite RGenOInfty.measurableE. + exact: RGenOInfty.measurable_itv_bnd_infty. + by exists [set +oo]; [constructor | rewrite -punct_eitv_bnd_pinfty]. + - exists set0 => //; exists [set +oo]; first by constructor. + by rewrite image_set0 set0U itv_cpinfty_pinfty. + - exists setT => //; exists [set -oo; +oo]; first by constructor. + by rewrite itv_cninfty_pinfty setUA punct_eitv_setTL setUCl. +move=> _ [A' mA' [C mC]] <-; apply: measurableU; last first. + case: mC; [by []|exact: measurable_set1_ninfty| + exact: measurable_set1_pinfty|]. + by apply: measurableU; [exact: measurable_set1_ninfty| + exact: measurable_set1_pinfty]. +rewrite RGenCInfty.measurableE in mA'. +have smA' := smallest_sub _ _ mA'. +(* BUG: elim/smA' : _. fails !! *) +apply: (smA' (@measurable T \o (image^~ EFin))); last first. + move=> _ [r ->]/=; rewrite EFin_itv_bnd_infty; apply: measurableD. + by apply sub_sigma_algebra => /=; exists r%:E. + exact: measurable_set1_pinfty. +split=> /= [|D mD|F mF]; first by rewrite image_set0. +- rewrite setTD EFin_setC; apply: measurableD; first exact: measurableC. + by apply: measurableU; [exact: measurable_set1_ninfty| + exact: measurable_set1_pinfty]. +- by rewrite EFin_bigcup; apply: bigcupT_measurable => i; exact: mF. +Qed. + +End erealgencinfty. +End ErealGenCInfty. + +Section trace. +Variable (T : Type). +Implicit Types (G : set (set T)) (A D : set T). + +(* intended as a trace sigma-algebra *) +Definition strace G D := [set x `&` D | x in G]. + +Lemma stracexx G D : G D -> strace G D D. +Proof. by rewrite /strace /=; exists D => //; rewrite setIid. Qed. + +Lemma sigma_algebra_strace G D : + sigma_algebra setT G -> sigma_algebra D (strace G D). +Proof. +move=> [G0 GC GU]; split; first by exists set0 => //; rewrite set0I. +- move=> S [A mA ADS]; have mCA := GC _ mA. + have : strace G D (D `&` ~` A). + by rewrite setIC; exists (setT `\` A) => //; rewrite setTD. + rewrite -setDE => trDA. + have DADS : D `\` A = D `\` S by rewrite -ADS !setDE setCI setIUr setICr setU0. + by rewrite DADS in trDA. +- move=> S mS; have /choice[M GM] : forall n, exists A, G A /\ S n = A `&` D. + by move=> n; have [A mA ADSn] := mS n; exists A. + exists (\bigcup_i (M i)); first by apply GU => i; exact: (GM i).1. + by rewrite setI_bigcupl; apply eq_bigcupr => i _; rewrite (GM i).2. +Qed. + +End trace. + +Lemma strace_measurable (T : measurableType) (A : set T) : measurable A -> + strace measurable A `<=` measurable. +Proof. by move=> mA=> _ [C mC <-]; apply: measurableI. Qed. + +(* more properties of measurable functions *) + +Lemma is_interval_measurable (R : realType) (I : set R) : + is_interval I -> measurable I. +Proof. by move/is_intervalP => ->; exact: measurable_itv. Qed. + +Section coutinuous_measurable. +Variable R : realType. + +Lemma open_measurable (U : set R) : open U -> measurable U. +Proof. +move=> /open_bigcup_rat ->; rewrite bigcup_mkcond; apply: bigcupT_measurable_rat. +move=> q; case: ifPn => // qfab; apply: is_interval_measurable => //. +exact: is_interval_bigcup_ointsub. +Qed. + +Lemma continuous_measurable_fun (f : R -> R) : continuous f -> + measurable_fun setT f. +Proof. +move=> /continuousP cf; apply: (measurability (RGenOpens.measurableE R)). +move=> _ [_ [a [b ->] <-]]; rewrite setTI. +by apply: open_measurable; exact/cf/interval_open. +Qed. + +End coutinuous_measurable. + +Section standard_measurable_fun. + +Lemma measurable_fun_normr (R : realType) (D : set R) : + measurable_fun D (@normr _ R). +Proof. +move=> mD; apply: (measurability (RGenOInfty.measurableE R)) => //. +move=> /= _ [_ [x ->] <-]; apply: measurableI => //. +have [x0|x0] := leP 0 x. + rewrite [X in measurable X](_ : _ = `]-oo, (- x)[ `|` `]x, +oo[)%classic. + by apply: measurableU; apply: measurable_itv. + rewrite predeqE => r; split => [|[|]]; rewrite preimage_itv ?in_itv ?andbT/=. + - have [r0|r0] := leP 0 r; [rewrite ger0_norm|rewrite ltr0_norm] => // xr; + rewrite 2!in_itv/=. + + by right; rewrite xr. + + by left; rewrite ltr_oppr. + - move=> rx /=. + by rewrite ler0_norm 1?ltr_oppr// (le_trans (ltW rx))// ler_oppl oppr0. + - by rewrite in_itv /= andbT => xr; rewrite (lt_le_trans _ (ler_norm _)). +rewrite [X in measurable X](_ : _ = setT)// predeqE => r. +by split => // _; rewrite /= in_itv /= andbT (lt_le_trans x0). +Qed. + +End standard_measurable_fun. + +Section measurable_fun_realType. +Variables (T : measurableType) (R : realType). +Implicit Types (D : set T) (f g : T -> R). + +Lemma measurable_funD D f g : + measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \+ g). +Proof. +move=> mf mg mD; apply: (measurability (RGenOInfty.measurableE R)) => //. +move=> /= _ [_ [a ->] <-]; rewrite preimage_itv_o_infty. +rewrite [X in measurable X](_ : _ = \bigcup_(q : rat) + ((D `&` [set x | ratr q < f x]) `&` (D `&` [set x | a - ratr q < g x]))). + apply: bigcupT_measurable_rat => q; apply: measurableI. + - by rewrite -preimage_itv_o_infty; apply: mf => //; apply: measurable_itv. + - by rewrite -preimage_itv_o_infty; apply: mg => //; apply: measurable_itv. +rewrite predeqE => x; split => [|[r _] []/= [Dx rfx]] /= => [[Dx]|[_]]. + rewrite -ltr_subl_addr => /rat_in_itvoo[r]; rewrite inE /= => /itvP h. + exists r => //; rewrite setIACA setIid; split => //; split => /=. + by rewrite h. + by rewrite ltr_subl_addr addrC -ltr_subl_addr h. +by rewrite ltr_subl_addr=> afg; rewrite (lt_le_trans afg)// addrC ler_add2r ltW. +Qed. + +Lemma measurable_funrM D f (k : R) : measurable_fun D f -> + measurable_fun D (fun x => k * f x). +Proof. +apply: (@measurable_fun_comp _ _ _ ( *%R k)). +by apply: continuous_measurable_fun; apply: mulrl_continuous. +Qed. + +Lemma measurable_funN D f : measurable_fun D f -> measurable_fun D (-%R \o f). +Proof. +move=> mf mD; rewrite (_ : _ \o _ = (fun x => - 1 * f x)). + exact: measurable_funrM. +by under eq_fun do rewrite mulN1r. +Qed. + +Lemma measurable_funB D f g : measurable_fun D f -> + measurable_fun D g -> measurable_fun D (f \- g). +Proof. +by move=> ? ? ?; apply: measurable_funD => //; exact: measurable_funN. +Qed. + +Lemma measurable_fun_exprn D n f : + measurable_fun D f -> measurable_fun D (fun x => f x ^+ n). +Proof. +apply: measurable_fun_comp ((@GRing.exp R)^~ n) _ _ _. +by apply: continuous_measurable_fun; apply: exprn_continuous. +Qed. + +Lemma measurable_fun_sqr D f : + measurable_fun D f -> measurable_fun D (fun x => f x ^+ 2). +Proof. exact: measurable_fun_exprn. Qed. + +Lemma measurable_funM D f g : + measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \* g). +Proof. +move=> mf mg mD; rewrite (_ : (_ \* _) = (fun x => 2%:R^-1 * (f x + g x) ^+ 2) + \- (fun x => 2%:R^-1 * (f x ^+ 2)) \- (fun x => 2%:R^-1 * ( g x ^+ 2))). + apply: measurable_funB => //; last first. + by apply: measurable_funrM => //; exact: measurable_fun_sqr. + apply: measurable_funB => //; last first. + by apply: measurable_funrM => //; exact: measurable_fun_sqr. + apply: measurable_funrM => //. + by apply: measurable_fun_sqr => //; exact: measurable_funD. +rewrite funeqE => x /=; rewrite -2!mulrBr sqrrD (addrC (f x ^+ 2)) -addrA. +rewrite -(addrA (f x * g x *+ 2)) -opprB opprK (addrC (g x ^+ 2)) addrK. +by rewrite -(mulr_natr (f x * g x)) -(mulrC 2) mulrA mulVr ?mul1r// unitfE. +Qed. + +Lemma measurable_fun_max D f g : + measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \max g). +Proof. +move=> mf mg mD; apply (measurability (RGenCInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = + (D `&` f @^-1` `[x, +oo[) `|` (D `&` g @^-1` `[x, +oo[)); last first. + rewrite predeqE => t /=; split. + by rewrite /= !in_itv /= !andbT le_maxr => -[Dx /orP[|]]; tauto. + by move=> [|]; rewrite !in_itv/= !andbT le_maxr => -[Dx ->]//; rewrite orbT. +by apply: measurableU; [apply: mf|apply: mg] =>//; apply: measurable_itv. +Qed. + +Lemma measurable_fun_sups D (h : (T -> R)^nat) n : + (forall t, D t -> has_ubound (range (h ^~ t))) -> + (forall m, measurable_fun D (h m)) -> + measurable_fun D (fun x => sups (h ^~ x) n). +Proof. +move=> f_ub mf mD; apply: (measurability (RGenOInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-]; rewrite sups_preimage // setI_bigcupr. +by apply: bigcup_measurable => k /= nk; apply: mf => //; exact: measurable_itv. +Qed. + +Lemma measurable_fun_infs D (h : (T -> R)^nat) n : + (forall t, D t -> has_lbound (range (h ^~ t))) -> + (forall n, measurable_fun D (h n)) -> + measurable_fun D (fun x => infs (h ^~ x) n). +Proof. +move=> lb_f mf mD; apply: (measurability (RGenInftyO.measurableE R)) =>//. +move=> _ [_ [x ->] <-]; rewrite infs_preimage // setI_bigcupr. +by apply: bigcup_measurable => k /= nk; apply: mf => //; exact: measurable_itv. +Qed. + +Lemma measurable_fun_lim_sup D (h : (T -> R)^nat) : + (forall t, D t -> has_ubound (range (h ^~ t))) -> + (forall t, D t -> has_lbound (range (h ^~ t))) -> + (forall n, measurable_fun D (h n)) -> + measurable_fun D (fun x => lim_sup (h ^~ x)). +Proof. +move=> f_ub f_lb mf. +have : {in D, (fun x => inf [set sups (h ^~ x) n | n in [set n | 0 <= n]%N]) + =1 (fun x => lim_sup (h^~ x))}. + move=> t; rewrite inE => Dt; apply/esym/cvg_lim; first exact: Rhausdorff. + rewrite [X in _ --> X](_ : _ = inf (range (sups (h^~t)))). + by apply: cvg_sups_inf; [exact: f_ub|exact: f_lb]. + by congr (inf [set _ | _ in _]); rewrite predeqE. +move/eq_measurable_fun; apply; apply: measurable_fun_infs => //. + move=> t Dt; have [M hM] := f_lb _ Dt; exists M => _ [m /= nm <-]. + rewrite (@le_trans _ _ (h m t)) //; first by apply hM => /=; exists m. + by apply: sup_ub; [exact/has_ubound_sdrop/f_ub|exists m => /=]. +by move=> k; exact: measurable_fun_sups. +Qed. + +Lemma measurable_fun_cvg D (h : (T -> R)^nat) f : + (forall m, measurable_fun D (h m)) -> (forall x, D x -> h ^~ x --> f x) -> + measurable_fun D f. +Proof. +move=> mf_ f_f; have fE x : D x -> f x = lim_sup (h ^~ x). + move=> Dx; have /cvg_lim <-// := @cvg_sups _ (h ^~ x) (f x) (f_f _ Dx). + exact: Rhausdorff. +apply: (@eq_measurable_fun _ _ D (fun x => lim_sup (h ^~ x))). + by move=> x; rewrite inE => Dx; rewrite -fE. +apply: (@measurable_fun_lim_sup _ h) => // t Dt. +- apply/bounded_fun_has_ubound/(@cvg_seq_bounded _ [normedModType R of R^o]). + by apply/cvg_ex; eexists; exact: f_f. +- apply/bounded_fun_has_lbound/(@cvg_seq_bounded _ [normedModType R of R^o]). + by apply/cvg_ex; eexists; exact: f_f. +Qed. + +End measurable_fun_realType. + +Section standard_emeasurable_fun. +Variable R : realType. + +Lemma measurable_fun_EFin (D : set R) : measurable_fun D EFin. +Proof. +move=> mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. +move=> /= _ [_ [x ->]] <-; move: x => [x| |]; apply: measurableI => //. +- by rewrite preimage_itv_o_infty EFin_itv; exact: measurable_itv. +- by rewrite [X in measurable X](_ : _ = set0)// predeqE. +- by rewrite preimage_EFin_setT. +Qed. + +Lemma measurable_fun_abse (D : set (\bar R)) : measurable_fun D abse. +Proof. +move=> mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. +move=> /= _ [_ [x ->] <-]; move: x => [x| |]. +- rewrite [X in _ @^-1` X](punct_eitv_bnd_pinfty _ x) preimage_setU setIUr. + apply: measurableU; last first. + rewrite preimage_abse_pinfty. + by apply: measurableI => //; exact: measurableU. + apply: measurableI => //; exists (normr @^-1` `]x, +oo[%classic). + rewrite -[X in measurable X]setTI. + by apply: measurable_fun_normr => //; exact: measurable_itv. + exists set0; first by constructor. + rewrite setU0 predeqE => -[y| |]; split => /= => -[r]; + rewrite ?/= /= ?in_itv /= ?andbT => xr//. + + by move=> [ry]; exists `|y| => //=; rewrite in_itv/= andbT -ry. + + by move=> [ry]; exists y => //=; rewrite /= in_itv/= andbT -ry. +- by apply: measurableI => //; rewrite itv_opinfty_pinfty preimage_set0. +- apply: measurableI => //; rewrite itv_oninfty_pinfty -preimage_setC. + by apply: measurableC; rewrite preimage_abse_ninfty. +Qed. + +Lemma emeasurable_fun_minus (D : set (\bar R)) : + measurable_fun D (-%E : \bar R -> \bar R). +Proof. +move=> mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-]; rewrite (_ : _ @^-1` _ = `]-oo, (- x)%E]%classic). + by apply: measurableI => //; exact: emeasurable_itv_ninfty_bnd. +by rewrite predeqE => y; rewrite preimage_itv !in_itv/= andbT in_itv lee_oppr. +Qed. + +End standard_emeasurable_fun. +#[global] Hint Extern 0 (measurable_fun _ abse) => + solve [exact: measurable_fun_abse] : core. +#[global] Hint Extern 0 (measurable_fun _ EFin) => + solve [exact: measurable_fun_EFin] : core. + +(* NB: real-valued function *) +Lemma EFin_measurable_fun (T : measurableType) (R : realType) (D : set T) + (g : T -> R) : + measurable_fun D (EFin \o g) <-> measurable_fun D g. +Proof. +split=> [mf mD A mA|]; last by move=> mg; exact: measurable_fun_comp. +rewrite [X in measurable X](_ : _ = D `&` (EFin \o g) @^-1` (EFin @` A)). + by apply: mf => //; exists A => //; exists set0; [constructor|rewrite setU0]. +congr (_ `&` _);rewrite eqEsubset; split=> [|? []/= _ /[swap] -[->//]]. +by move=> ? ?; exact: preimage_image. +Qed. + +Section emeasurable_fun. +Local Open Scope ereal_scope. +Variables (T : measurableType) (R : realType). +Implicit Types (D : set T). + +Lemma measurable_fun_einfs D (f : (T -> \bar R)^nat) : + (forall n, measurable_fun D (f n)) -> + forall n, measurable_fun D (fun x => einfs (f ^~ x) n). +Proof. +move=> mf n mD. +apply: (measurability (ErealGenCInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-]; rewrite einfs_preimage -bigcapIr; last by exists n => /=. +by apply: bigcap_measurable => ? ?; exact/mf/emeasurable_itv_bnd_pinfty. +Qed. + +Lemma measurable_fun_esups D (f : (T -> \bar R)^nat) : + (forall n, measurable_fun D (f n)) -> + forall n, measurable_fun D (fun x => esups (f ^~ x) n). +Proof. +move=> mf n mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-];rewrite esups_preimage setI_bigcupr. +by apply: bigcup_measurable => ? ?; exact/mf/emeasurable_itv_bnd_pinfty. +Qed. + +Lemma emeasurable_fun_max D (f g : T -> \bar R) : + measurable_fun D f -> measurable_fun D g -> + measurable_fun D (fun x => maxe (f x) (g x)). +Proof. +move=> mf mg mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = + (D `&` f @^-1` `[x, +oo[) `|` (D `&` g @^-1` `[x, +oo[)); last first. + rewrite predeqE => t /=; split. + by rewrite !/= /= !in_itv /= !andbT le_maxr => -[Dx /orP[|]]; + tauto. + by move=> [|]; rewrite !/= /= !in_itv/= !andbT le_maxr; + move=> [Dx ->]//; rewrite orbT. +by apply: measurableU; [exact/mf/emeasurable_itv_bnd_pinfty| + exact/mg/emeasurable_itv_bnd_pinfty]. +Qed. + +Lemma emeasurable_fun_funenng D (f : T -> \bar R) : + measurable_fun D f -> measurable_fun D f^\+. +Proof. +by move=> mf; apply: emeasurable_fun_max => //; apply: measurable_fun_cst. +Qed. + +Lemma emeasurable_fun_funennp D (f : T -> \bar R) : + measurable_fun D f -> measurable_fun D f^\-. +Proof. +move=> mf; apply: emeasurable_fun_max => //; last exact: measurable_fun_cst. +by apply: measurable_fun_comp => //; apply: emeasurable_fun_minus. +Qed. + +Lemma emeasurable_fun_min D (f g : T -> \bar R) : + measurable_fun D f -> measurable_fun D g -> + measurable_fun D (fun x => mine (f x) (g x)). +Proof. +move=> mf mg mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. +move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = + (D `&` f @^-1` `[x, +oo[) `&` (D `&` g @^-1` `[x, +oo[)); last first. + rewrite predeqE => t /=; split. + rewrite !/= !in_itv /= !andbT le_minr => -[Dt /andP[xft xgt]]. + tauto. + move=> []; rewrite !/= !in_itv/= !andbT le_minr=> -[Dt xft [_ xgt]]. + by split => //; rewrite xft xgt. +by apply: measurableI; [exact/mf/emeasurable_itv_bnd_pinfty| + exact/mg/emeasurable_itv_bnd_pinfty]. +Qed. + +Lemma measurable_fun_elim_sup D (f : (T -> \bar R)^nat) : + (forall n, measurable_fun D (f n)) -> + measurable_fun D (fun x => elim_sup (f ^~ x)). +Proof. +move=> mf mD; rewrite (_ : (fun _ => _) = + (fun x => ereal_inf [set esups (f^~ x) n | n in [set n | n >= 0]%N])). + by apply: measurable_fun_einfs => // k; exact: measurable_fun_esups. +rewrite funeqE => t; apply/cvg_lim => //. +rewrite [X in _ --> X](_ : _ = ereal_inf (range (esups (f^~t)))). + exact: cvg_esups_inf. +by congr (ereal_inf [set _ | _ in _]); rewrite predeqE. +Qed. + +Lemma emeasurable_fun_cvg D (f_ : (T -> \bar R)^nat) (f : T -> \bar R) : + (forall m, measurable_fun D (f_ m)) -> + (forall x, D x -> f_ ^~ x --> f x) -> measurable_fun D f. +Proof. +move=> mf_ f_f; have fE x : D x -> f x = elim_sup (f_^~ x). + by move=> Dx; have /cvg_lim <-// := @cvg_esups _ (f_^~x) (f x) (f_f x Dx). +apply: (measurable_fun_ext (fun x => elim_sup (f_ ^~ x))) => //. + by move=> x; rewrite inE => Dx; rewrite fE. +exact: measurable_fun_elim_sup. +Qed. + +End emeasurable_fun. +Arguments emeasurable_fun_cvg {T R D} f_. From ab96f2dd5b5eba8e47b1273428d3563bafd64ae3 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 12 May 2022 21:24:16 +0900 Subject: [PATCH 02/19] tentative sketch for sigma_sub_additive --- theories/lebesgue_stieltjes_measure.v | 185 ++++++++++++++------------ 1 file changed, 102 insertions(+), 83 deletions(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 14da226125..803df43f66 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -75,7 +75,7 @@ Qed. Implicit Types i j : interval R. Definition itvs : Type := R. -Definition hlength (A : set itvs): \bar R := +Definition hlength (A : set itvs): \bar R := let i := Rhull A in g i.2 - g i.1. Lemma hlength0 : hlength (set0 : set R) = 0. @@ -111,7 +111,7 @@ move: i => [[ba a|[]] [bb b|[]]] /neitvP //=; do ?by rewrite ?set_itvE ?eqxx. by move=> _; rewrite hlength_itv /= ltey. by move=> _; rewrite hlength_itv /= ltNye. by move=> _; rewrite hlength_itv. -Qed. +Qed. Lemma finite_hlengthE i : neitv i -> hlength [set` i] < +oo -> hlength [set` i] = (fine (g i.2))%:E - (fine (g i.1))%:E. @@ -162,7 +162,7 @@ Lemma hlength_ge0 i : 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. - rewrite suber_ge0//. - move=> /ltW. + move=> /ltW. move=> /g_monotone. done. - by rewrite ltNge leey. @@ -268,41 +268,41 @@ HB.instance Definition _ : isSemiRingOfSets itvs := Definition itvs_semiRingOfSets := [the semiRingOfSetsType of itvs]. -Lemma hlength_ge0' (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) (I : set itvs) : (0 <= hlength f I)%E. -Proof. - rewrite -(hlength0 f). - rewrite le_hlength//. Qed. - -(* Unused *) -(* Lemma hlength_semi_additive2 : semi_additive2 hlength. *) -(* Proof. *) -(* move=> I J /ocitvP[|[a a12]] ->; first by rewrite set0U hlength0 add0e. *) -(* move=> /ocitvP[|[b b12]] ->; first by rewrite setU0 hlength0 adde0. *) -(* rewrite -subset0 => + ab0 => /ocitvP[|[x x12] abx]. *) -(* by rewrite setU_eq0 => -[-> ->]; rewrite setU0 hlength0 adde0. *) -(* rewrite abx !hlength_itv//= ?lte_fin a12 b12 x12/= -!EFinB -EFinD. *) -(* wlog ab1 : a a12 b b12 ab0 abx / a.1 <= b.1 => [hwlog|]. *) -(* have /orP[ab1|ba1] := le_total a.1 b.1; first by apply: hwlog. *) -(* by rewrite [in RHS]addrC; apply: hwlog => //; rewrite (setIC, setUC). *) -(* have := ab0; rewrite subset0 -set_itv_meet/=. *) -(* rewrite /Order.join /Order.meet/= ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). *) -(* rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. *) -(* move=> /eqP/neitvP/=; rewrite bnd_simp/= /d/c (max_idPr _)// => /negP. *) -(* rewrite -leNgt le_minl orbC lt_geF//= => {c} {d} a2b1. *) -(* have ab i j : i \in `]a.1, a.2] -> j \in `]b.1, b.2] -> i <= j. *) -(* by move=> ia jb; rewrite (le_le_trans _ _ a2b1) ?(itvP ia) ?(itvP jb). *) -(* have /(congr1 sup) := abx; rewrite sup_setU// ?sup_itv_bounded// => bx. *) -(* have /(congr1 inf) := abx; rewrite inf_setU// ?inf_itv_bounded// => ax. *) -(* rewrite -{}ax -{x}bx in abx x12 *. *) -(* case: ltgtP a2b1 => // a2b1 _; last first. *) -(* by rewrite a2b1 [in RHS]addrC subrKA. *) -(* exfalso; pose c := (a.2 + b.1) / 2%:R. *) -(* have /predeqP/(_ c)[_ /(_ _)/Box[]] := abx. *) -(* apply: subset_itv_oo_oc; have := mid_in_itvoo a2b1. *) -(* by apply/subitvP; rewrite subitvE ?bnd_simp/= ?ltW. *) -(* apply/not_orP; rewrite /= !in_itv/=. *) -(* by rewrite lt_geF ?midf_lt//= andbF le_gtF ?midf_le//= ltW. *) -(* Qed. *) +Lemma hlength_ge0' (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) + (I : set itvs) : (0 <= hlength f I)%E. +Proof. by rewrite -(hlength0 f) le_hlength. Qed. + +(*Lemma hlength_semi_additive2 (f : R -> R) : + semi_additive2 (hlength f). +Proof. +move=> I J /ocitvP[|[a a12]] ->; first by rewrite set0U hlength0 add0e. +move=> /ocitvP[|[b b12]] ->; first by rewrite setU0 hlength0 adde0. +rewrite -subset0 => + ab0 => /ocitvP[|[x x12] abx]. + by rewrite setU_eq0 => -[-> ->]; rewrite setU0 hlength0 adde0. +rewrite abx !hlength_itv//= ?lte_fin a12 b12 x12/= -!EFinB -EFinD. +wlog ab1 : a a12 b b12 ab0 abx / a.1 <= b.1 => [hwlog|]. + have /orP[ab1|ba1] := le_total a.1 b.1; first by apply: hwlog. + by rewrite [in RHS]addrC; apply: hwlog => //; rewrite (setIC, setUC). +have := ab0; rewrite subset0. + -set_itvI/=. +rewrite /Order.join /Order.meet/= ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. +move=> /eqP/neitvP/=; rewrite bnd_simp/= /d/c (max_idPr _)// => /negP. +rewrite -leNgt le_minl orbC lt_geF//= => {c} {d} a2b1. +have ab i j : i \in `]a.1, a.2] -> j \in `]b.1, b.2] -> i <= j. + by move=> ia jb; rewrite (le_le_trans _ _ a2b1) ?(itvP ia) ?(itvP jb). +have /(congr1 sup) := abx; rewrite sup_setU// ?sup_itv_bounded// => bx. +have /(congr1 inf) := abx; rewrite inf_setU// ?inf_itv_bounded// => ax. +rewrite -{}ax -{x}bx in abx x12 *. +case: ltgtP a2b1 => // a2b1 _; last first. + by rewrite a2b1 [in RHS]addrC subrKA. +exfalso; pose c := (a.2 + b.1) / 2%:R. +have /predeqP/(_ c)[_ /(_ _)/Box[]] := abx. + apply: subset_itv_oo_oc; have := mid_in_itvoo a2b1. + by apply/subitvP; rewrite subitvE ?bnd_simp/= ?ltW. +apply/not_orP; rewrite /= !in_itv/=. +by rewrite lt_geF ?midf_lt//= andbF le_gtF ?midf_le//= ltW. +Qed.*) Lemma hlength_semi_additive (f : R -> R) : semi_additive (hlength f). Proof. @@ -376,57 +376,76 @@ Canonical hlength_measure (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R} Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. -Lemma hlength_sigma_sub_additive (f:R -> R) (f_monotone:{homo f : x y / (x <= y)%R}) : sigma_sub_additive (hlength f). +Lemma hlength_cc (F : R -> R) (a b : R) : a < b -> + hlength F `[a, b]%classic = (F b - F a)%:E. +Proof. +by move=> ab; rewrite hlength_itv/= lte_fin ab EFinN EFinB. +Qed. + +Lemma hlength_semi_additive_helper (F : R -> R) (n : nat) a0 b0 (a b : nat -> R) : + {homo F : x y / x <= y} -> + `[a0, b0] `<=` \big[setU/set0]_(i < n) `] a i, b i[%classic -> + F b0 - F a0 <= \sum_(i < n) (F (b i) - F (a i)). +Proof. +move=> ndF h. +have H1 : (forall k, (k < n)%N -> @measurable itvs_semiRingOfSets `](a k), (b k)[%classic). + move=> k kn. + admit. +have H2 : @measurable itvs_semiRingOfSets `[a0, b0]%classic. + admit. +move/(@content_sub_additive R itvs_semiRingOfSets (@hlength_measure F ndF) + `[a0, b0]%classic (fun x => `](a x), (b x)[%classic) n H1 H2) : h. +rewrite /=. +have -> : hlength F `[a0, b0] = ((F b0) - (F a0))%:E. + rewrite hlength_cc//. + admit. +have -> : (\sum_(k < n) hlength F `](a k), (b k)[ = \sum_(k < n) (F (b k) - F (a k))%:E)%E. + admit. +by rewrite sumEFin. +Admitted. + +Lemma hlength_sigma_sub_additive (f : R -> R) + (f_monotone : {homo f : x y / (x <= y)%R}) : + sigma_sub_additive (hlength f). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. -case: ifPn => a12; last first. rewrite nneseries_esum//; last first. - move=> n _. - by apply:hlength_ge0'. - rewrite esum_ge0//. - move=> n _. - by apply:hlength_ge0'. +case: ifPn => a12; last first. + rewrite nneseries_esum; last first. + by move=> ? _; exact: hlength_ge0'. + by rewrite esum_ge0// => ? _; exact: hlength_ge0'. apply: lee_adde => e. rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. apply: le_trans (epsilon_trick _ _ _) => //=; last first. - move=> n . - by apply hlength_ge0'. -have eVn_gt0 n : 0 < e%:num / 2 / (2 ^ n.+1)%:R. - by rewrite divr_gt0// ltr0n// expn_gt0. -have eVn_ge0 n := ltW (eVn_gt0 n). -pose Aoo i : set itvs := - (`]((b i).1), ((b i).2 + e%:num / 2 / (2 ^ i.+1)%:R)[)%classic. -pose Aoc i : set itvs := - (`]((b i).1), ((b i).2 + e%:num / 2 / (2 ^ i.+1)%:R)])%classic. -have: `[a.1 + e%:num / 2, a.2] `<=` \bigcup_i Aoo i. (* <- *) - apply: (@subset_trans _ `]a.1, a.2]). - move=> x; rewrite /= !in_itv /= => /andP[+ -> //]. - by move=> /lt_le_trans-> //; rewrite ltr_addl. - apply: (subset_trans lebig); apply: subset_bigcup => i _; rewrite AE /Aoo/=. - move=> x /=; rewrite !in_itv /= => /andP[-> /le_lt_trans->]//=. - by rewrite ltr_addl. -have := @segment_compact _ (a.1 + e%:num / 2) a.2; rewrite compact_cover. -move=> /[apply]-[i _|X _ Xc]; first by rewrite /Aoo//; apply: interval_open. -have: `](a.1 + e%:num / 2), a.2] `<=` \bigcup_(i in [set` X]) Aoc i. - move=> x /subset_itv_oc_cc /Xc [i /= Xi] Aooix. - by exists i => //; apply: subset_itv_oo_oc Aooix. -have /[apply] := @content_sub_fsum _ _ [additive_measure of (hlength f)] _ [set` X]. -move=> /(_ f_monotone _ _ _)/Box[]//=. apply: le_le_trans. - rewrite hlength_itv ?lte_fin -?EFinD/= -addrA -opprD. - case: ltP. - rewrite lee_fin. - move=> ae.(* *) - apply ler_sub =>//. - rewrite lerr. - rewrite lee_fin. move=> ae. - apply ler_sub =>//. rewrite subr_le0. -rewrite nneseries_esum//; last by move=> *; rewrite adde_ge0//= ?lee_fin. -rewrite esum_ge//; exists X => //; rewrite fsbig_finite// ?set_fsetK//=. -rewrite lee_sum // => i _; rewrite ?AE// !hlength_itv/= ?lte_fin -?EFinD/=. -do !case: ifPn => //= ?; do ?by rewrite ?adde_ge0 ?lee_fin// ?subr_ge0// ?ltW. - by rewrite addrAC. -by rewrite addrAC lee_fin ler_add// subr_le0 leNgt. -Qed. + by move=> ?; exact: hlength_ge0'. +have [Delta hDelta] : exists Delta, f (a.1 + Delta) <= f a.1 + e%:num / 2. + (* by continuity *) + admit. +have [delta hdelta] : + exists delta : nat -> R, forall i, f ((b i).2 + delta i) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + suff : forall i, exists deltai, f ((b i).2 + deltai) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + by move/choice => -[f' hf']; exists f'. + (* by continuity *) + admit. +have H1 : `[ a.2 + Delta , a.1] `<=` \bigcup_i `](b i).1, (b i).2 + delta i[%classic. + admit. +have [n hn] : exists n, `[ a.1 + Delta , a.2] `<=` \big[setU/set0]_(i < n) `](b i).1, (b i).2 + delta i[%classic. + (* by cover_compact *) + admit. +have H2 : f a.2 - f (a.1 + Delta) <= \sum_(i < n) (f ((b i).2 + delta i) - f (b i).1). + exact: (@hlength_semi_additive_helper f n (a.1 + Delta) a.2 + (fun x => (b x).1) (fun x => (b x).2 + delta x)). +have H3 : (((f a.2 - f (a.1) - e%:num / 2))%:E <= + \sum_(i < n) ((hlength f) ( `](b i).1, (b i).2]%classic)) + + + \sum_(i < n) (f ((b i).2 + delta i)%R - f (b i).2)%:E)%E. + admit. +have H4 : (((f a.2 - f (a.1) - e%:num / 2))%:E <= + \sum_(i < n) ((hlength f) ( `](b i).1, (b i).2]%classic)) + + + (e%:num / 2)%:E)%E. + admit. +Admitted. Lemma hlength_sigma_finite : sigma_finite [set: itvs] hlength. Proof. From 3f5cee0b503a11996b6243f2eee7609e94220815 Mon Sep 17 00:00:00 2001 From: IshiguroYoshihiro <103252572+IshiguroYoshihiro@users.noreply.github.com> Date: Fri, 13 May 2022 17:28:13 +0900 Subject: [PATCH 03/19] progress wrt hlength_sigma_sub_additive - fix intermediate lemma - use continuity hypo --- theories/lebesgue_stieltjes_measure.v | 200 +++++++++++++++++++++----- 1 file changed, 168 insertions(+), 32 deletions(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 803df43f66..56791e24d9 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -376,36 +376,108 @@ Canonical hlength_measure (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R} Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. -Lemma hlength_cc (F : R -> R) (a b : R) : a < b -> - hlength F `[a, b]%classic = (F b - F a)%:E. +Lemma hlength_interval (F : R -> R) (a b : R) (x y : bool): a <= b -> + hlength F [set` (Interval (BSide x a) (BSide y b))] = (F b - F a)%:E. Proof. -by move=> ab; rewrite hlength_itv/= lte_fin ab EFinN EFinB. +move=> ab. +rewrite hlength_itv/= lte_fin lt_neqAle ab andbT. +case: ifPn. + by rewrite EFinN EFinB. +rewrite negbK. +move/eqP ->. +by rewrite subrr. Qed. Lemma hlength_semi_additive_helper (F : R -> R) (n : nat) a0 b0 (a b : nat -> R) : - {homo F : x y / x <= y} -> - `[a0, b0] `<=` \big[setU/set0]_(i < n) `] a i, b i[%classic -> + {homo F : x y / x <= y} -> + (forall i, (i < n)%nat -> (a i <= b i)) -> + `]a0, b0] `<=` \big[setU/set0]_(i < n) `] a i, b i]%classic -> F b0 - F a0 <= \sum_(i < n) (F (b i) - F (a i)). Proof. -move=> ndF h. -have H1 : (forall k, (k < n)%N -> @measurable itvs_semiRingOfSets `](a k), (b k)[%classic). - move=> k kn. - admit. -have H2 : @measurable itvs_semiRingOfSets `[a0, b0]%classic. - admit. +move=> ndF ailtnbi h. +have H1 : (forall k, (k < n)%N -> @measurable itvs_semiRingOfSets `](a k), (b k)]%classic). + by move=> k kn. +have H2 : @measurable itvs_semiRingOfSets `]a0, b0]%classic. + apply is_ocitv. move/(@content_sub_additive R itvs_semiRingOfSets (@hlength_measure F ndF) - `[a0, b0]%classic (fun x => `](a x), (b x)[%classic) n H1 H2) : h. + `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) n H1 H2) : h. rewrite /=. -have -> : hlength F `[a0, b0] = ((F b0) - (F a0))%:E. - rewrite hlength_cc//. - admit. -have -> : (\sum_(k < n) hlength F `](a k), (b k)[ = \sum_(k < n) (F (b k) - F (a k))%:E)%E. - admit. -by rewrite sumEFin. +move=> h. +case (leP a0 b0); last first. + move=> ba. + apply (@le_trans _ _ 0). + rewrite subr_le0. + apply ndF. + by apply ltW. + apply sumr_ge0. + move=> i _. + rewrite subr_ge0. + apply ndF. + by apply ailtnbi. +move=> ab. +move: h. +rewrite hlength_interval//. +move=> h. +rewrite -lee_fin (le_trans h)// -sumEFin. +apply:lee_sum. +move=> i _. +rewrite hlength_interval//. +by apply ailtnbi. +Qed. + +Lemma monotone_right_continuous (a : R) (e : R) (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) (f_right_continuous : (right_continuous f)) : + e > 0 -> exists Delta : {posnum R}, f (a + Delta%:num) <= f a + e. +Proof. +move: e. +move=> _ /posnumP[ e ]. +move:f_right_continuous. +move=> /(_ a). +move/(@cvg_dist _ [normedModType R of R^o]). +move=> /(_ (e%:num)). +move=> /(_ [gt0 of (e%:num)]). +case. +rewrite /=. +move=> _ /posnumP[delta0 ]. +move=> /(_ (a + delta0%:num / 2)). +rewrite /=. +rewrite opprD. +rewrite addrA. +rewrite subrr. +rewrite distrC. +rewrite subr0. +rewrite ger0_norm //. +rewrite ltr_pdivr_mulr//. +rewrite ltr_pmulr//. +rewrite ltr1n. +move=> /(_ erefl). +rewrite ltr_addl. +rewrite divr_gt0//. +move=> /(_ erefl). +rewrite ler0_norm; last first. + rewrite subr_le0. + rewrite f_monotone//. + by rewrite ler_addl. +rewrite opprB. +rewrite ltr_subl_addl. +move=> H. +exists (PosNum [gt0 of (delta0%:num / 2)]). +rewrite /=. +by apply ltW. +Qed. + +Lemma subset_interval' +(a1 a2 b1 b2: R) (xa ya xb yb: bool): b1 <= a1 -> a2 <= b2 -> (xa <= xb)%O -> (yb <= ya)%O -> +[set` (Interval (BSide xa a1) (BSide ya a2))] `<=` [set` (Interval (BSide xb b1) (BSide yb b2))]. +Proof. +Admitted. + +Lemma subset_interval +(a1 a2 b1 b2 : itv_bound R) : (b1 <= a1)%O -> (a2 <= b2)%O -> [set` (Interval a1 a2)] `<=` [set` (Interval b1 b2)]. +Proof. Admitted. Lemma hlength_sigma_sub_additive (f : R -> R) - (f_monotone : {homo f : x y / (x <= y)%R}) : + (f_monotone : {homo f : x y / (x <= y)%R}) (f_right_continuous : right_continuous f) : sigma_sub_additive (hlength f). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. @@ -418,27 +490,92 @@ apply: lee_adde => e. rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. apply: le_trans (epsilon_trick _ _ _) => //=; last first. by move=> ?; exact: hlength_ge0'. -have [Delta hDelta] : exists Delta, f (a.1 + Delta) <= f a.1 + e%:num / 2. +have [Delta hDelta] : exists Delta : {posnum R}, f (a.1 + Delta%:num) <= f a.1 + e%:num / 2. (* by continuity *) - admit. + by apply monotone_right_continuous. + have [delta hdelta] : - exists delta : nat -> R, forall i, f ((b i).2 + delta i) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. - suff : forall i, exists deltai, f ((b i).2 + deltai) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + exists delta : nat -> {posnum R}, forall i, f ((b i).2 + (delta i)%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + suff : forall i, exists deltai : {posnum R}, f ((b i).2 + deltai%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. by move/choice => -[f' hf']; exists f'. (* by continuity *) - admit. -have H1 : `[ a.2 + Delta , a.1] `<=` \bigcup_i `](b i).1, (b i).2 + delta i[%classic. - admit. -have [n hn] : exists n, `[ a.1 + Delta , a.2] `<=` \big[setU/set0]_(i < n) `](b i).1, (b i).2 + delta i[%classic. + move=> i. + apply monotone_right_continuous => //. + rewrite divr_gt0 //. + rewrite exprn_gt0//. + +have H1 : `[ a.1 + Delta%:num , a.2] `<=` \bigcup_i `](b i).1, (b i).2 + (delta i)%:num[%classic. + apply (@subset_trans _ `]a.1, a.2]). + move=> r. + rewrite /=. + rewrite !in_itv/=. + move=> /andP [+ ->]. + rewrite andbT. + apply lt_le_trans. + by rewrite ltr_addl. + apply (subset_trans lebig). + move=> r. + rewrite /bigcup/=. + case. + move=> n _ Anr. + exists n => //. + move: Anr. + rewrite AE /=. + rewrite !in_itv/=. + move=> /andP [-> ]/=. + move/ le_lt_trans. + apply. + by rewrite ltr_addl. +have [n hn] : exists n, `] a.1 + Delta%:num / 2, a.2] `<=` \big[setU/set0]_(i < n) `](b i).1, (b i).2 + (delta i)%:num]%classic. +(* suff : exists n, `[ a.1 + Delta%:num, a.2] `<=` \big[setU/set0]_(i < n) `](b i).1, (b i).2 + (delta i)%:num[%classic. + case=> n hn. + exists n. + apply (@subset_trans _ `[(a.1 + Delta%:num / 4%:R), a.2]). + apply subset_interval => //=. + rewrite bnd_simp. + (*move=> r/=. + rewrite !in_itv/=. + move=> /andP [+ ->]. + rewrite andbT. + move/ ltW. + apply le_trans.*) + rewrite ler_add => //. + (*Unset Printing Notations.*) + rewrite ler_pmul //. + rewrite ler_pinv. + by rewrite ler_nat. + rewrite inE. + rewrite ltr0n. + rewrite andbT. + by rewrite unitf_gt0. + rewrite inE ltr0n andbT. + by rewrite unitf_gt0. + + apply:subset_trans. + apply:subset_trans hn. + apply subset_interval. + + + move=> r/=. +*) (* by cover_compact *) admit. -have H2 : f a.2 - f (a.1 + Delta) <= \sum_(i < n) (f ((b i).2 + delta i) - f (b i).1). - exact: (@hlength_semi_additive_helper f n (a.1 + Delta) a.2 - (fun x => (b x).1) (fun x => (b x).2 + delta x)). + +have H0 : forall n, (b n).1 <= (b n).2. + admit. +have H2 : f a.2 - f (a.1 + Delta%:num) <= \sum_(i < n) (f ((b i).2 + (delta i)%:num) - f (b i).1). + apply: (@hlength_semi_additive_helper f n (a.1 + Delta%:num) a.2 + (fun x => (b x).1) (fun x => (b x).2 + (delta x)%:num)) =>//. + move => i iltnn. + apply (@le_trans _ _ (b i).2). + done. + by rewrite ler_addl. + admit. + have H3 : (((f a.2 - f (a.1) - e%:num / 2))%:E <= \sum_(i < n) ((hlength f) ( `](b i).1, (b i).2]%classic)) + - \sum_(i < n) (f ((b i).2 + delta i)%R - f (b i).2)%:E)%E. + \sum_(i < n) (f ((b i).2 + (delta i)%:num)%R - f (b i).2)%:E)%E. admit. have H4 : (((f a.2 - f (a.1) - e%:num / 2))%:E <= \sum_(i < n) ((hlength f) ( `](b i).1, (b i).2]%classic)) @@ -467,7 +604,6 @@ Definition lebesgue_measure : {measure set gitvs -> \bar R} := End itv_semiRingOfSets. Arguments lebesgue_measure {R}. - Section lebesgue_measure. Variable R : realType. Let gitvs := g_measurableType (@ocitv R). From 9890a3c1e0550ec93c011676641a8cac89b9d39c Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 3 Jun 2022 20:13:36 +0900 Subject: [PATCH 04/19] tentative definition of lebesgue stieltjes measure --- _CoqProject | 1 + theories/lebesgue_measure.v | 62 + theories/lebesgue_stieltjes_measure.v | 1705 +++---------------------- 3 files changed, 265 insertions(+), 1503 deletions(-) diff --git a/_CoqProject b/_CoqProject index 9521968f49..fb6175469e 100644 --- a/_CoqProject +++ b/_CoqProject @@ -32,6 +32,7 @@ theories/nsatz_realtype.v theories/esum.v theories/real_interval.v theories/lebesgue_measure.v +theories/lebesgue_stieltjes_measure.v theories/forms.v theories/derive.v theories/measure.v diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 714117b0c8..0e72a07c48 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -543,6 +543,68 @@ Qed. End puncture_ereal_itv. +Lemma set1_bigcap_oc (R : realType) (r : R) : + [set r] = \bigcap_i `]r - i.+1%:R^-1, r]%classic. +Proof. +apply/seteqP; split=> [x ->|]. + by move=> i _/=; rewrite in_itv/= lexx ltr_subl_addr ltr_addl invr_gt0 ltr0n. +move=> x rx; apply/esym/eqP; rewrite eq_le (itvP (rx 0%N _))// andbT. +apply/ler_addgt0Pl => e e_gt0; rewrite -ler_subl_addl ltW//. +have := rx `|floor e^-1%R|%N I; rewrite /= in_itv => /andP[/le_lt_trans->]//. +rewrite ler_add2l ler_opp2 -lef_pinv ?invrK//; last by rewrite qualifE. +by rewrite -natr1 natr_absz ger0_norm ?floor_ge0 ?invr_ge0 1?ltW// lt_succ_floor. +Qed. + +Lemma itv_bnd_open_bigcup (R : realType) b (r s : R) : + [set` Interval (BSide b r) (BLeft s)] = + \bigcup_n [set` Interval (BSide b r) (BRight (s - n.+1%:R^-1))]. +Proof. +apply/seteqP; split => [x/=|]; last first. + move=> x [n _ /=] /[!in_itv] /andP[-> /le_lt_trans]; apply. + by rewrite ltr_subl_addr ltr_addl invr_gt0 ltr0n. +rewrite in_itv/= => /andP[sx xs]; exists `|ceil ((s - x)^-1)|%N => //=. +rewrite in_itv/= sx/= ler_subr_addl addrC -ler_subr_addl. +rewrite -[in X in _ <= X](invrK (s - x)) ler_pinv. +- rewrite -natr1 natr_absz ger0_norm; last first. + by rewrite ceil_ge0// invr_ge0 subr_ge0 ltW. + by rewrite (@le_trans _ _ (ceil (s - x)^-1)%:~R)// ?ler_addl// ceil_ge. +- by rewrite inE unitfE ltr0n andbT pnatr_eq0. +- by rewrite inE invr_gt0 subr_gt0 xs andbT unitfE invr_eq0 subr_eq0 gt_eqF. +Qed. + +Lemma itv_open_bnd_bigcup (R : realType) b (r s : R) : + [set` Interval (BRight s) (BSide b r)] = + \bigcup_n [set` Interval (BLeft (s + n.+1%:R^-1)) (BSide b r)]. +Proof. +have /(congr1 (fun x => -%R @` x)) := itv_bnd_open_bigcup (~~ b) (- r) (- s). +rewrite opp_itv_bnd_bnd/= !opprK negbK => ->; rewrite image_bigcup. +apply eq_bigcupr => k _; apply/seteqP; split=> [_/= [y ysr] <-|x/= xsr]. + by rewrite oppr_itv/= opprD. +by exists (- x); rewrite ?oppr_itv//= opprK// negbK opprB opprK addrC. +Qed. + +Lemma itv_bnd_infty_bigcup (R : realType) b (x : R) : + [set` Interval (BSide b x) +oo%O] = + \bigcup_i [set` Interval (BSide b x) (BRight (x + i%:R))]. +Proof. +apply/seteqP; split=> y; rewrite /= !in_itv/= andbT; last first. + by move=> [k _ /=]; move: b => [|] /=; rewrite in_itv/= => /andP[//] /ltW. +move=> xy; exists `|ceil (y - x)|%N => //=; rewrite in_itv/= xy/= -ler_subl_addl. +rewrite !natr_absz/= ger0_norm ?ceil_ge0 ?subr_ge0 ?ceil_ge//. +by case: b xy => //= /ltW. +Qed. + +Lemma itv_infty_bnd_bigcup (R : realType) b (x : R) : + [set` Interval -oo%O (BSide b x)] = + \bigcup_i [set` Interval (BLeft (x - i%:R)) (BSide b x)]. +Proof. +have /(congr1 (fun x => -%R @` x)) := itv_bnd_infty_bigcup (~~ b) (- x). +rewrite opp_itv_bnd_infty negbK opprK => ->; rewrite image_bigcup. +apply eq_bigcupr => k _; apply/seteqP; split=> [_ /= -[r rbxk <-]|y/= yxkb]. + by rewrite oppr_itv/= opprB addrC. +by exists (- y); [rewrite oppr_itv/= negbK opprD opprK|rewrite opprK]. +Qed. + Section salgebra_R_ssets. Variable R : realType. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 56791e24d9..1b71827aae 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -9,35 +9,10 @@ Require Import sequences esum measure fsbigop cardinality set_interval. Require Import realfun. (******************************************************************************) -(* Lebesgue Measure *) +(* Lebesgue Stieltjes Measure *) (* *) -(* This file contains a formalization of the Lebesgue measure using the *) -(* Caratheodory's theorem available in measure.v and further develops the *) -(* theory of measurable functions. *) -(* *) -(* Main reference: *) -(* - Daniel Li, Intégration et applications, 2016 *) -(* - Achim Klenke, Probability Theory 2nd edition, 2014 *) -(* *) -(* hlength A == length of the hull of the set of real numbers A *) -(* ocitv == set of open-closed intervals ]x, y] where *) -(* x and y are real numbers *) -(* lebesgue_measure == the Lebesgue measure *) -(* *) -(* ps_infty == inductive definition of the powerset *) -(* {0, {-oo}, {+oo}, {-oo,+oo}} *) -(* emeasurable G == sigma-algebra over \bar R built out of the *) -(* measurables G of a sigma-algebra over R *) -(* elebesgue_measure == the Lebesgue measure extended to \bar R *) -(* *) -(* The modules RGenOInfty, RGenInftyO, RGenCInfty, RGenOpens provide proofs *) -(* of equivalence between the sigma-algebra generated by list of intervals *) -(* and the sigma-algebras generated by open rays, closed rays, and open *) -(* intervals. *) -(* *) -(* The modules ErealGenOInfty and ErealGenCInfty provide proofs of *) -(* equivalence between emeasurable and the sigmaa-algebras generated open *) -(* rays and closed rays. *) +(* This file contains a formalization of the Lebesgue-Stieltjes measure using *) +(* the Extension theorem available in measure.v. *) (* *) (******************************************************************************) @@ -50,33 +25,55 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -Notation right_continuous f := (forall x, f%function @ at_right x --> f%function x). -(* ToDo : right_continuous + left_continuous = continuous *) - -Section hlength. -Local Open Scope ereal_scope. -Variable R : realType. -Variable f : R -> R. -Hypothesis f_monotone : {homo f : x y / (x <= y)%R}. -Hypothesis f_right_continuous : right_continuous f. +(* TODO: move *) +Notation right_continuous f := + (forall x, f%function @ at_right x --> f%function x). -Let g x := if x is r%:E then (f r)%:E else x. +Lemma nondecreasing_right_continuousP (R : realType) (a : R) (e : R) + (f : R -> R) (ndf : {homo f : x y / x <= y}) (rcf : (right_continuous f)) : + e > 0 -> exists d : {posnum R}, f (a + d%:num) <= f a + e. +Proof. +move=> e0; move: rcf => /(_ a)/(@cvg_dist _ [normedModType R of R^o]). +move=> /(_ _ e0)[] _ /posnumP[d] => h. +exists (PosNum [gt0 of (d%:num / 2)]) => //=. +move: h => /(_ (a + d%:num / 2)) /=. +rewrite opprD addrA subrr distrC subr0 ger0_norm //. +rewrite ltr_pdivr_mulr// ltr_pmulr// ltr1n => /(_ erefl). +rewrite ltr_addl divr_gt0// => /(_ erefl). +rewrite ler0_norm; last by rewrite subr_le0 ndf// ler_addl. +by rewrite opprB ltr_subl_addl => fa; exact: ltW. +Qed. -Let g_monotone : {homo g : x y / (x <= y)%E}. +(* TODO: move and use in lebesgue_measure.v? *) +Lemma le_inf (R : realType) (S1 S2 : set R) : + -%R @` S2 `<=` down (-%R @` S1) -> nonempty S2 -> has_inf S1 + -> (inf S1 <= inf S2)%R. Proof. -move=> [r||] [l||]//=. -rewrite !lee_fin. -apply f_monotone. +move=> S21 S12 S1i; rewrite ler_oppl opprK le_sup// ?has_inf_supN//. +exact/nonemptyN. +Qed. + +Definition EFinf {R : numDomainType} (f : R -> R) : \bar R -> \bar R := + fun x => if x is r%:E then (f r)%:E else x. -by rewrite !leey. -by rewrite !leNye. +Lemma nondecreasing_EFinf (R : realDomainType) (f : R -> R) : + {homo f : x y / (x <= y)%R} -> {homo EFinf f : x y / (x <= y)%E}. +Proof. +move=> ndf. +by move=> [r| |] [l| |]//=; rewrite ?leey ?leNye// !lee_fin; exact: ndf. Qed. +Section hlength. +Local Open Scope ereal_scope. +Variables (R : realType) (f : R -> R). +Hypothesis ndf : {homo f : x y / (x <= y)%R}. + +Let g : \bar R -> \bar R := EFinf f. + Implicit Types i j : interval R. Definition itvs : Type := R. -Definition hlength (A : set itvs): \bar R := - let i := Rhull A in g i.2 - g i.1. +Definition hlength (A : set itvs) : \bar R := let i := Rhull A in g i.2 - g i.1. Lemma hlength0 : hlength (set0 : set R) = 0. Proof. by rewrite /hlength Rhull0 /= subee. Qed. @@ -91,7 +88,7 @@ Lemma hlength_itv i : hlength [set` i] = if i.2 > i.1 then g i.2 - g i.1 else 0. Proof. case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /hlength set_itvK. rewrite le_eqVlt => /orP[|/lt_ereal_bnd i12]; last first. - rewrite (_ : [set` i] = set0) ?hlength0//. + rewrite -hlength0; congr (hlength _). by apply/eqP/negPn; rewrite -/(neitv _) neitvE -leNgt (ltW i12). case: i => -[ba a|[|]] [bb b|[|]] //=. - rewrite /= => /eqP[->{b}]; move: ba bb => -[] []; try @@ -116,27 +113,21 @@ Qed. Lemma finite_hlengthE i : neitv i -> hlength [set` i] < +oo -> hlength [set` i] = (fine (g i.2))%:E - (fine (g i.1))%:E. Proof. -move=> i0 ioo; have [ri1 ri2] := hlength_finite_fin_num i0 ioo. -rewrite hlength_itv. +move=> i0 ioo; have [i1f i2f] := hlength_finite_fin_num i0 ioo. rewrite fineK; last first. -rewrite /g. -move: ri2. -case:(ereal_of_itv_bound i.2) => //. - + by rewrite /g; move: i2f; case: (ereal_of_itv_bound i.2). rewrite fineK; last first. -rewrite /g. -move: ri1. -case:(ereal_of_itv_bound i.1) => //. - -case: ifPn => //. -rewrite -leNgt le_eqVlt => /predU1P[->|]. - rewrite subee//. -rewrite /g. -move: ri1. -case:(ereal_of_itv_bound i.1) => //. - + by rewrite /g; move: i1f; case: (ereal_of_itv_bound i.1). +rewrite hlength_itv; case: ifPn => //; rewrite -leNgt le_eqVlt => /predU1P[->|]. + by rewrite subee// /g; move: i1f; case: (ereal_of_itv_bound i.1). by move/lt_ereal_bnd/ltW; rewrite leNgt; move: i0 => /neitvP => ->. +Qed. +Lemma hlength_itv_bnd (a b : R) (x y : bool): (a <= b)%R -> + hlength [set` Interval (BSide x a) (BSide y b)] = (f b - f a)%:E. +Proof. +move=> ab; rewrite hlength_itv/= lte_fin lt_neqAle ab andbT. +by have [-> /=|/= ab'] := eqVneq a b; rewrite ?subrr// EFinN EFinB. Qed. Lemma hlength_infty_bnd b r : @@ -161,10 +152,7 @@ Qed. Lemma hlength_ge0 i : 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. -- rewrite suber_ge0//. - move=> /ltW. - move=> /g_monotone. - done. +- by rewrite suber_ge0// => /ltW /(nondecreasing_EFinf ndf). - by rewrite ltNge leey. - by case: (i.2 : \bar _) => //= [r _]; rewrite leey. Qed. @@ -173,7 +161,8 @@ Local Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. Lemma hlength_Rhull (A : set R) : hlength [set` Rhull A] = hlength A. Proof. by rewrite /hlength Rhull_involutive. Qed. -Lemma le_hlength_itv i j : {subset i <= j} -> hlength [set` i] <= hlength [set` j]. +Lemma le_hlength_itv i j : + {subset i <= j} -> hlength [set` i] <= hlength [set` j]. Proof. set I := [set` i]; set J := [set` j]. have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_ge0. @@ -182,21 +171,19 @@ have [J0|/set0P J0] := eqVneq J set0. move=> /subset_itvP ij; apply: lee_sub => /=. have [ui|ui] := asboolP (has_ubound I). have [uj /=|uj] := asboolP (has_ubound J); last by rewrite leey. - rewrite lee_fin. - apply f_monotone. - by rewrite le_sup// => r Ir; exists r; split => //; apply: ij. + rewrite lee_fin; apply: ndf; apply/le_sup => //. + by move=> r Ir; exists r; split => //; apply: ij. have [uj /=|//] := asboolP (has_ubound J). by move: ui; have := subset_has_ubound ij uj. have [lj /=|lj] := asboolP (has_lbound J); last by rewrite leNye. have [li /=|li] := asboolP (has_lbound I); last first. by move: li; have := subset_has_lbound ij lj. -rewrite lee_fin. apply f_monotone. rewrite ler_oppl opprK le_sup// ?has_inf_supN//; last first. - by case: I0 => x Ix; exists (- x)%R, x. +rewrite lee_fin; apply/ndf/le_inf => //. move=> r [r' Ir' <-{r}]; exists (- r')%R. by split => //; exists r' => //; apply: ij. Qed. -Lemma le_hlength : {homo hlength : A B / (A `<=` B) >-> A <= B}. +Lemma le_hlength : {homo hlength : A B / A `<=` B >-> A <= B}. Proof. move=> a b /le_Rhull /le_hlength_itv. by rewrite (hlength_Rhull a) (hlength_Rhull b). @@ -209,7 +196,7 @@ Arguments hlength {R}. Section itv_semiRingOfSets. Variable R : realType. Implicit Types (I J K : set R). -Local Notation itvs := (itvs R). +Definition ocitv_type : Type := R. Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. @@ -263,48 +250,16 @@ rewrite /Order.meet/= /Order.meet /Order.join/= by rewrite -negb_or le_total/=. Qed. -HB.instance Definition _ : isSemiRingOfSets itvs := - @isSemiRingOfSets.Build itvs (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. +Variable d : measure_display. -Definition itvs_semiRingOfSets := [the semiRingOfSetsType of itvs]. +HB.instance Definition _ := + @isSemiRingOfSets.Build d ocitv_type (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. -Lemma hlength_ge0' (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) - (I : set itvs) : (0 <= hlength f I)%E. -Proof. by rewrite -(hlength0 f) le_hlength. Qed. +Definition itvs_semiRingOfSets := [the semiRingOfSetsType d of ocitv_type]. -(*Lemma hlength_semi_additive2 (f : R -> R) : - semi_additive2 (hlength f). -Proof. -move=> I J /ocitvP[|[a a12]] ->; first by rewrite set0U hlength0 add0e. -move=> /ocitvP[|[b b12]] ->; first by rewrite setU0 hlength0 adde0. -rewrite -subset0 => + ab0 => /ocitvP[|[x x12] abx]. - by rewrite setU_eq0 => -[-> ->]; rewrite setU0 hlength0 adde0. -rewrite abx !hlength_itv//= ?lte_fin a12 b12 x12/= -!EFinB -EFinD. -wlog ab1 : a a12 b b12 ab0 abx / a.1 <= b.1 => [hwlog|]. - have /orP[ab1|ba1] := le_total a.1 b.1; first by apply: hwlog. - by rewrite [in RHS]addrC; apply: hwlog => //; rewrite (setIC, setUC). -have := ab0; rewrite subset0. - -set_itvI/=. -rewrite /Order.join /Order.meet/= ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. -move=> /eqP/neitvP/=; rewrite bnd_simp/= /d/c (max_idPr _)// => /negP. -rewrite -leNgt le_minl orbC lt_geF//= => {c} {d} a2b1. -have ab i j : i \in `]a.1, a.2] -> j \in `]b.1, b.2] -> i <= j. - by move=> ia jb; rewrite (le_le_trans _ _ a2b1) ?(itvP ia) ?(itvP jb). -have /(congr1 sup) := abx; rewrite sup_setU// ?sup_itv_bounded// => bx. -have /(congr1 inf) := abx; rewrite inf_setU// ?inf_itv_bounded// => ax. -rewrite -{}ax -{x}bx in abx x12 *. -case: ltgtP a2b1 => // a2b1 _; last first. - by rewrite a2b1 [in RHS]addrC subrKA. -exfalso; pose c := (a.2 + b.1) / 2%:R. -have /predeqP/(_ c)[_ /(_ _)/Box[]] := abx. - apply: subset_itv_oo_oc; have := mid_in_itvoo a2b1. - by apply/subitvP; rewrite subitvE ?bnd_simp/= ?ltW. -apply/not_orP; rewrite /= !in_itv/=. -by rewrite lt_geF ?midf_lt//= andbF le_gtF ?midf_le//= ltW. -Qed.*) +Variable f : R -> R. -Lemma hlength_semi_additive (f : R -> R) : semi_additive (hlength f). +Lemma hlength_semi_additive : semi_additive (hlength f : set ocitv_type -> _). Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. @@ -369,222 +324,9 @@ apply/andP; split=> //; apply: contraTneq xbj => ->. by rewrite in_itv/= le_gtF// (itvP xabi). Qed. -Canonical hlength_measure (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) : - {additive_measure set itvs -> \bar R} - := AdditiveMeasure (AdditiveMeasure.Axioms (hlength0 f) - (hlength_ge0' f_monotone) (hlength_semi_additive f)). - Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. -Lemma hlength_interval (F : R -> R) (a b : R) (x y : bool): a <= b -> - hlength F [set` (Interval (BSide x a) (BSide y b))] = (F b - F a)%:E. -Proof. -move=> ab. -rewrite hlength_itv/= lte_fin lt_neqAle ab andbT. -case: ifPn. - by rewrite EFinN EFinB. -rewrite negbK. -move/eqP ->. -by rewrite subrr. -Qed. - -Lemma hlength_semi_additive_helper (F : R -> R) (n : nat) a0 b0 (a b : nat -> R) : - {homo F : x y / x <= y} -> - (forall i, (i < n)%nat -> (a i <= b i)) -> - `]a0, b0] `<=` \big[setU/set0]_(i < n) `] a i, b i]%classic -> - F b0 - F a0 <= \sum_(i < n) (F (b i) - F (a i)). -Proof. -move=> ndF ailtnbi h. -have H1 : (forall k, (k < n)%N -> @measurable itvs_semiRingOfSets `](a k), (b k)]%classic). - by move=> k kn. -have H2 : @measurable itvs_semiRingOfSets `]a0, b0]%classic. - apply is_ocitv. -move/(@content_sub_additive R itvs_semiRingOfSets (@hlength_measure F ndF) - `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) n H1 H2) : h. -rewrite /=. -move=> h. -case (leP a0 b0); last first. - move=> ba. - apply (@le_trans _ _ 0). - rewrite subr_le0. - apply ndF. - by apply ltW. - apply sumr_ge0. - move=> i _. - rewrite subr_ge0. - apply ndF. - by apply ailtnbi. -move=> ab. -move: h. -rewrite hlength_interval//. -move=> h. -rewrite -lee_fin (le_trans h)// -sumEFin. -apply:lee_sum. -move=> i _. -rewrite hlength_interval//. -by apply ailtnbi. -Qed. - -Lemma monotone_right_continuous (a : R) (e : R) (f : R -> R) (f_monotone : {homo f : x y / (x <= y)%R}) (f_right_continuous : (right_continuous f)) : - e > 0 -> exists Delta : {posnum R}, f (a + Delta%:num) <= f a + e. -Proof. -move: e. -move=> _ /posnumP[ e ]. -move:f_right_continuous. -move=> /(_ a). -move/(@cvg_dist _ [normedModType R of R^o]). -move=> /(_ (e%:num)). -move=> /(_ [gt0 of (e%:num)]). -case. -rewrite /=. -move=> _ /posnumP[delta0 ]. -move=> /(_ (a + delta0%:num / 2)). -rewrite /=. -rewrite opprD. -rewrite addrA. -rewrite subrr. -rewrite distrC. -rewrite subr0. -rewrite ger0_norm //. -rewrite ltr_pdivr_mulr//. -rewrite ltr_pmulr//. -rewrite ltr1n. -move=> /(_ erefl). -rewrite ltr_addl. -rewrite divr_gt0//. -move=> /(_ erefl). -rewrite ler0_norm; last first. - rewrite subr_le0. - rewrite f_monotone//. - by rewrite ler_addl. -rewrite opprB. -rewrite ltr_subl_addl. -move=> H. -exists (PosNum [gt0 of (delta0%:num / 2)]). -rewrite /=. -by apply ltW. -Qed. - -Lemma subset_interval' -(a1 a2 b1 b2: R) (xa ya xb yb: bool): b1 <= a1 -> a2 <= b2 -> (xa <= xb)%O -> (yb <= ya)%O -> -[set` (Interval (BSide xa a1) (BSide ya a2))] `<=` [set` (Interval (BSide xb b1) (BSide yb b2))]. -Proof. -Admitted. - -Lemma subset_interval -(a1 a2 b1 b2 : itv_bound R) : (b1 <= a1)%O -> (a2 <= b2)%O -> [set` (Interval a1 a2)] `<=` [set` (Interval b1 b2)]. -Proof. -Admitted. - -Lemma hlength_sigma_sub_additive (f : R -> R) - (f_monotone : {homo f : x y / (x <= y)%R}) (f_right_continuous : right_continuous f) : - sigma_sub_additive (hlength f). -Proof. -move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. -move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. -case: ifPn => a12; last first. - rewrite nneseries_esum; last first. - by move=> ? _; exact: hlength_ge0'. - by rewrite esum_ge0// => ? _; exact: hlength_ge0'. -apply: lee_adde => e. -rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. -apply: le_trans (epsilon_trick _ _ _) => //=; last first. - by move=> ?; exact: hlength_ge0'. -have [Delta hDelta] : exists Delta : {posnum R}, f (a.1 + Delta%:num) <= f a.1 + e%:num / 2. - (* by continuity *) - by apply monotone_right_continuous. - -have [delta hdelta] : - exists delta : nat -> {posnum R}, forall i, f ((b i).2 + (delta i)%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. - suff : forall i, exists deltai : {posnum R}, f ((b i).2 + deltai%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. - by move/choice => -[f' hf']; exists f'. - (* by continuity *) - move=> i. - apply monotone_right_continuous => //. - rewrite divr_gt0 //. - rewrite exprn_gt0//. - -have H1 : `[ a.1 + Delta%:num , a.2] `<=` \bigcup_i `](b i).1, (b i).2 + (delta i)%:num[%classic. - apply (@subset_trans _ `]a.1, a.2]). - move=> r. - rewrite /=. - rewrite !in_itv/=. - move=> /andP [+ ->]. - rewrite andbT. - apply lt_le_trans. - by rewrite ltr_addl. - apply (subset_trans lebig). - move=> r. - rewrite /bigcup/=. - case. - move=> n _ Anr. - exists n => //. - move: Anr. - rewrite AE /=. - rewrite !in_itv/=. - move=> /andP [-> ]/=. - move/ le_lt_trans. - apply. - by rewrite ltr_addl. -have [n hn] : exists n, `] a.1 + Delta%:num / 2, a.2] `<=` \big[setU/set0]_(i < n) `](b i).1, (b i).2 + (delta i)%:num]%classic. -(* suff : exists n, `[ a.1 + Delta%:num, a.2] `<=` \big[setU/set0]_(i < n) `](b i).1, (b i).2 + (delta i)%:num[%classic. - case=> n hn. - exists n. - apply (@subset_trans _ `[(a.1 + Delta%:num / 4%:R), a.2]). - apply subset_interval => //=. - rewrite bnd_simp. - (*move=> r/=. - rewrite !in_itv/=. - move=> /andP [+ ->]. - rewrite andbT. - move/ ltW. - apply le_trans.*) - rewrite ler_add => //. - (*Unset Printing Notations.*) - rewrite ler_pmul //. - rewrite ler_pinv. - by rewrite ler_nat. - rewrite inE. - rewrite ltr0n. - rewrite andbT. - by rewrite unitf_gt0. - rewrite inE ltr0n andbT. - by rewrite unitf_gt0. - - apply:subset_trans. - apply:subset_trans hn. - apply subset_interval. - - - move=> r/=. -*) - (* by cover_compact *) - admit. - -have H0 : forall n, (b n).1 <= (b n).2. - admit. -have H2 : f a.2 - f (a.1 + Delta%:num) <= \sum_(i < n) (f ((b i).2 + (delta i)%:num) - f (b i).1). - apply: (@hlength_semi_additive_helper f n (a.1 + Delta%:num) a.2 - (fun x => (b x).1) (fun x => (b x).2 + (delta x)%:num)) =>//. - move => i iltnn. - apply (@le_trans _ _ (b i).2). - done. - by rewrite ler_addl. - admit. - -have H3 : (((f a.2 - f (a.1) - e%:num / 2))%:E <= - \sum_(i < n) ((hlength f) ( `](b i).1, (b i).2]%classic)) - + - \sum_(i < n) (f ((b i).2 + (delta i)%:num)%R - f (b i).2)%:E)%E. - admit. -have H4 : (((f a.2 - f (a.1) - e%:num / 2))%:E <= - \sum_(i < n) ((hlength f) ( `](b i).1, (b i).2]%classic)) - + - (e%:num / 2)%:E)%E. - admit. -Admitted. - -Lemma hlength_sigma_finite : sigma_finite [set: itvs] hlength. +Lemma hlength_sigma_finite : sigma_finite [set: ocitv_type] (hlength f). Proof. exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). apply/esym; rewrite -subTset => /= x _ /=. @@ -594,1203 +336,160 @@ exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). rewrite [ltRHS]ger0_norm//. by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. by rewrite addr_ge0// -Rfloor0 le_Rfloor. -by move=> k; split => //; rewrite hlength_itv/= -EFinB; case: ifP; rewrite ltey. -Qed. - -Let gitvs := g_measurableType ocitv. - -Definition lebesgue_measure : {measure set gitvs -> \bar R} := - Hahn_ext_measure hlength_sigma_sub_additive. - -End itv_semiRingOfSets. -Arguments lebesgue_measure {R}. -Section lebesgue_measure. -Variable R : realType. -Let gitvs := g_measurableType (@ocitv R). - -Lemma lebesgue_measure_unique (mu : {measure set gitvs -> \bar R}) : - (forall X, ocitv X -> hlength X = mu X) -> - forall X, measurable X -> lebesgue_measure X = mu X. -Proof. -move=> muE X mX; apply: Hahn_ext_unique => //=. -- exact: hlength_sigma_sub_additive. -- exact: hlength_sigma_finite. -Qed. - -End lebesgue_measure. - -Section ps_infty. -Context {T : Type}. -Local Open Scope ereal_scope. - -Inductive ps_infty : set \bar T -> Prop := -| ps_infty0 : ps_infty set0 -| ps_ninfty : ps_infty [set -oo] -| ps_pinfty : ps_infty [set +oo] -| ps_inftys : ps_infty [set -oo; +oo]. - -Lemma ps_inftyP (A : set \bar T) : ps_infty A <-> A `<=` [set -oo; +oo]. -Proof. -split => [[]//|Aoo]. -by have [] := subset_set2 Aoo; move=> ->; constructor. -Qed. - -Lemma setCU_Efin (A : set T) (B : set \bar T) : ps_infty B -> - ~` (EFin @` A) `&` ~` B = (EFin @` ~` A) `|` ([set -oo%E; +oo%E] `&` ~` B). -Proof. -move=> ps_inftyB. -have -> : ~` (EFin @` A) = EFin @` (~` A) `|` [set -oo; +oo]%E. - by rewrite EFin_setC setDKU // => x [|] -> -[]. -rewrite setIUl; congr (_ `|` _); rewrite predeqE => -[x| |]; split; try by case. -by move=> [] x' Ax' [] <-{x}; split; [exists x'|case: ps_inftyB => // -[]]. -Qed. - -End ps_infty. - -Section salgebra_ereal. -Variables (R : realType) (G : set (set R)). -Let measurableTypeR := g_measurableType G. -Let measurableR : set (set R) := @measurable measurableTypeR. - -Definition emeasurable : set (set \bar R) := - [set EFin @` A `|` B | A in measurableR & B in ps_infty]. - -Lemma emeasurable0 : emeasurable set0. -Proof. -exists set0; first exact: measurable0. -by exists set0; rewrite ?setU0// ?image_set0//; constructor. -Qed. - -Lemma emeasurableC (X : set \bar R) : emeasurable X -> emeasurable (~` X). -Proof. -move => -[A mA] [B PooB <-]; rewrite setCU setCU_Efin //. -exists (~` A); [exact: measurableC | exists ([set -oo%E; +oo%E] `&` ~` B) => //]. -case: PooB. -- by rewrite setC0 setIT; constructor. -- rewrite setIUl setICr set0U -setDE. - have [_ ->] := @setDidPl (\bar R) [set +oo%E] [set -oo%E]; first by constructor. - by rewrite predeqE => x; split => // -[->]. -- rewrite setIUl setICr setU0 -setDE. - have [_ ->] := @setDidPl (\bar R) [set -oo%E] [set +oo%E]; first by constructor. - by rewrite predeqE => x; split => // -[->]. -- by rewrite setICr; constructor. -Qed. - -Lemma bigcupT_emeasurable (F : (set \bar R)^nat) : - (forall i, emeasurable (F i)) -> emeasurable (\bigcup_i (F i)). -Proof. -move=> mF; pose P := fun i j => measurableR j.1 /\ ps_infty j.2 /\ - F i = [set x%:E | x in j.1] `|` j.2. -have [f fi] : {f : nat -> (set R) * (set \bar R) & forall i, P i (f i) }. - by apply: choice => i; have [x mx [y PSoo'y] xy] := mF i; exists (x, y). -exists (\bigcup_i (f i).1). - by apply: bigcupT_measurable => i; exact: (fi i).1. -exists (\bigcup_i (f i).2). - apply/ps_inftyP => x [n _] fn2x. - have /ps_inftyP : ps_infty(f n).2 by have [_ []] := fi n. - exact. -rewrite [RHS](@eq_bigcupr _ _ _ _ - (fun i => [set x%:E | x in (f i).1] `|` (f i).2)); last first. - by move=> i; have [_ []] := fi i. -rewrite bigcupU; congr (_ `|` _). -rewrite predeqE => i /=; split=> [[r [n _ fn1r <-{i}]]|[n _ [r fn1r <-{i}]]]; - by [exists n => //; exists r | exists r => //; exists n]. -Qed. - -Definition ereal_isMeasurable : isMeasurable (\bar R) := - isMeasurable.Build _ (Pointed.class _) - emeasurable0 emeasurableC bigcupT_emeasurable. - -End salgebra_ereal. - -Section puncture_ereal_itv. -Variable R : realDomainType. -Implicit Types (y : R) (b : bool). -Local Open Scope ereal_scope. - -Lemma punct_eitv_bnd_pinfty b y : [set` Interval (BSide b y%:E) +oo%O] = - EFin @` [set` Interval (BSide b y) +oo%O] `|` [set +oo]. -Proof. -rewrite predeqE => x; split; rewrite /= in_itv andbT. -- move: x => [x| |] yxb; [|by right|by case: b yxb]. - by left; exists x => //; rewrite in_itv /= andbT; case: b yxb. -- move=> [[r]|->]. - + by rewrite in_itv /= andbT => yxb <-; case: b yxb. - + by case: b => /=; rewrite ?(ltey, leey). -Qed. - -Lemma punct_eitv_ninfty_bnd b y : [set` Interval -oo%O (BSide b y%:E)] = - [set -oo%E] `|` EFin @` [set x | x \in Interval -oo%O (BSide b y)]. -Proof. -rewrite predeqE => x; split; rewrite /= in_itv. -- move: x => [x| |] yxb; [|by case: b yxb|by left]. - by right; exists x => //; rewrite in_itv /= andbT; case: b yxb. -- move=> [->|[r]]. - + by case: b => /=; rewrite ?(ltNye, leNye). - + by rewrite in_itv /= => yxb <-; case: b yxb. -Qed. - -Lemma punct_eitv_setTR : range (@EFin R) `|` [set +oo] = [set~ -oo]. -Proof. -rewrite eqEsubset; split => [a [[a' _ <-]|->]|] //. -by move=> [x| |] //= _; [left; exists x|right]. -Qed. - -Lemma punct_eitv_setTL : range (@EFin R) `|` [set -oo] = [set~ +oo]. -Proof. -rewrite eqEsubset; split => [a [[a' _ <-]|->]|] //. -by move=> [x| |] //= _; [left; exists x|right]. -Qed. - -End puncture_ereal_itv. - -Lemma set1_bigcap_oc (R : realType) (r : R) : - [set r] = \bigcap_i `]r - i.+1%:R^-1, r]%classic. -Proof. -apply/seteqP; split=> [x ->|]. - by move=> i _/=; rewrite in_itv/= lexx ltr_subl_addr ltr_addl invr_gt0 ltr0n. -move=> x rx; apply/esym/eqP; rewrite eq_le (itvP (rx 0%N _))// andbT. -apply/ler_addgt0Pl => e e_gt0; rewrite -ler_subl_addl ltW//. -have := rx `|floor e^-1%R|%N I; rewrite /= in_itv => /andP[/le_lt_trans->]//. -rewrite ler_add2l ler_opp2 -lef_pinv ?invrK//; last by rewrite qualifE invr_gt0. -rewrite -addn1 natrD natr_absz ger0_norm ?floor_ge0 ?invr_ge0 1?ltW//. -by rewrite -RfloorE lt_succ_Rfloor. +by move=> k; split => //; rewrite hlength_itv /= -EFinB; case: ifP; rewrite ltey. Qed. -Section salgebra_R_ssets. -Variable R : realType. - -Definition measurableTypeR := - g_measurableType (@measurable (@itvs_semiRingOfSets R)). - -Definition measurableR : set (set R) := @measurable measurableTypeR. - -HB.instance Definition R_isMeasurable : isMeasurable R := - isMeasurable.Build measurableTypeR (Pointed.class R) - measurable0 (@measurableC _) (@bigcupT_measurable _). -(*HB.instance (Real.sort R) R_isMeasurable.*) +Hypothesis ndf : {homo f : x y / (x <= y)%R}. -Lemma measurable_set1 (r : R) : measurable [set r]. -Proof. -rewrite set1_bigcap_oc; apply: bigcap_measurable => k // _. -by apply: sub_sigma_algebra; exact/is_ocitv. -Qed. -#[local] Hint Resolve measurable_set1 : core. - -Lemma measurable_itv (i : interval R) : measurable [set` i]. -Proof. -have moc (a b : R) : measurable `]a, b]%classic. - by apply: sub_sigma_algebra; apply: is_ocitv. -have pooE (x : R) : `]x, +oo[%classic = \bigcup_i `]x, x + i%:R]%classic. - apply/seteqP; split=> y; rewrite /= !in_itv/= andbT; last first. - by move=> [k _ /=] /itvP->. - move=> xy; exists `|ceil (y - x)|%N => //=. - rewrite in_itv/= xy/= -ler_subl_addl !natr_absz/=. - rewrite ger0_norm ?ceil_ge0 ?subr_ge0//; last exact: ltW. - by rewrite -RceilE Rceil_ge. -have mopoo (x : R) : measurable `]x, +oo[%classic. - by rewrite pooE; exact: bigcup_measurable. -have mnooc (x : R) : measurable `]-oo, x]%classic. - by rewrite -setCitvr; exact/measurableC. -have ooE (a b : R) : `]a, b[%classic = `]a, b]%classic `\ b. - case: (boolP (a < b)) => ab; last by rewrite !set_itv_ge ?set0D. - by rewrite -setUitv1// setUDK// => x [->]; rewrite /= in_itv/= ltxx andbF. -have moo (a b : R) : measurable `]a, b[%classic. - by rewrite ooE; exact: measurableD. -have mcc (a b : R) : measurable `[a, b]%classic. - case: (boolP (a <= b)) => ab; last by rewrite set_itv_ge. - by rewrite -setU1itv//; apply/measurableU. -have mco (a b : R) : measurable `[a, b[%classic. - case: (boolP (a < b)) => ab; last by rewrite set_itv_ge. - by rewrite -setU1itv//; apply/measurableU. -have oooE (b : R) : `]-oo, b[%classic = `]-oo, b]%classic `\ b. - by rewrite -setUitv1// setUDK// => x [->]; rewrite /= in_itv/= ltxx. -case: i => [[[] a|[]] [[] b|[]]] => //; do ?by rewrite set_itv_ge. -- by rewrite -setU1itv//; exact/measurableU. -- by rewrite oooE; exact/measurableD. -- by rewrite set_itv_infty_infty. -Qed. +Lemma hlength_ge0' (I : set ocitv_type) : (0 <= hlength f I)%E. +Proof. by rewrite -(hlength0 f) le_hlength. Qed. HB.instance Definition _ := - ereal_isMeasurable (@measurable (@itvs_semiRingOfSets R)). -(* NB: Until we dropped support for Coq 8.12, we were using -HB.instance (\bar (Real.sort R)) - (ereal_isMeasurable (@measurable (@itvs_semiRingOfSets R))). -This was producing a warning but the alternative was failing with Coq 8.12 with - the following message (according to the CI): - # [redundant-canonical-projection,typechecker] - # forall (T : measurableType) (f : T -> R), measurable_fun setT f - # : Prop - # File "./theories/lebesgue_measure.v", line 4508, characters 0-88: - # Error: Anomaly "Uncaught exception Failure("sep_last")." - # Please report at http://coq.inria.fr/bugs/. -*) - -Lemma measurable_EFin (A : set R) : measurableR A -> measurable (EFin @` A). -Proof. -by move=> mA; exists A => //; exists set0; [constructor|rewrite setU0]. -Qed. - -Lemma emeasurable_set1 (x : \bar R) : measurable [set x]. -Proof. -case: x => [r| |]. -- by rewrite -image_set1; apply: measurable_EFin; apply: measurable_set1. -- exists set0 => //; [exists [set +oo%E]; [by constructor|]]. - by rewrite image_set0 set0U. -- exists set0 => //; [exists [set -oo%E]; [by constructor|]]. - by rewrite image_set0 set0U. -Qed. -#[local] Hint Resolve emeasurable_set1 : core. - -Lemma itv_cpinfty_pinfty : `[+oo%E, +oo[%classic = [set +oo%E] :> set (\bar R). -Proof. -rewrite set_itvE predeqE => t; split => /= [|<-//]. -by rewrite lee_pinfty_eq => /eqP. -Qed. - -Lemma itv_opinfty_pinfty : `]+oo%E, +oo[%classic = set0 :> set (\bar R). -Proof. -by rewrite set_itvE predeqE => t; split => //=; apply/negP; rewrite -leNgt leey. -Qed. - -Lemma itv_cninfty_pinfty : `[-oo%E, +oo[%classic = setT :> set (\bar R). -Proof. by rewrite set_itvE predeqE => t; split => //= _; rewrite leNye. Qed. - -Lemma itv_oninfty_pinfty : - `]-oo%E, +oo[%classic = ~` [set -oo]%E :> set (\bar R). -Proof. -rewrite set_itvE predeqE => x; split => /=. -- by move: x => [x| |]; rewrite ?ltxx. -- by move: x => [x h|//|/(_ erefl)]; rewrite ?ltNye. -Qed. - -Lemma emeasurable_itv_bnd_pinfty b (y : \bar R) : - measurable [set` Interval (BSide b y) +oo%O]. -Proof. -move: y => [y| |]. -- exists [set` Interval (BSide b y) +oo%O]; first exact: measurable_itv. - by exists [set +oo%E]; [constructor|rewrite -punct_eitv_bnd_pinfty]. -- by case: b; rewrite ?itv_opinfty_pinfty ?itv_cpinfty_pinfty. -- case: b; first by rewrite itv_cninfty_pinfty. - by rewrite itv_oninfty_pinfty; exact/measurableC. -Qed. - -Lemma emeasurable_itv_ninfty_bnd b (y : \bar R) : - measurable [set` Interval -oo%O (BSide b y)]. -Proof. -by rewrite -setCitvr; exact/measurableC/emeasurable_itv_bnd_pinfty. -Qed. - -Definition elebesgue_measure' : set \bar R -> \bar R := - fun S => lebesgue_measure (fine @` (S `\` [set -oo; +oo]%E)). - -Lemma elebesgue_measure'0 : elebesgue_measure' set0 = 0%E. -Proof. by rewrite /elebesgue_measure' set0D image_set0 measure0. Qed. - -Lemma measurable_fine (X : set \bar R) : measurable X -> - measurable [set fine x | x in X `\` [set -oo; +oo]%E]. -Proof. -case => Y mY [X' [ | <-{X} | <-{X} | <-{X} ]]. -- rewrite setU0 => <-{X}. - rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. - by move=> [x [[x' Yx' <-{x}/= _ <-//]]]. - by move=> Yr; exists r%:E; split => [|[]//]; exists r. -- rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. - move=> [x [[[x' Yx' <- _ <-//]|]]]. - by move=> <-; rewrite not_orP => -[]/(_ erefl). - by move=> Yr; exists r%:E => //; split => [|[]//]; left; exists r. -- rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. - move=> [x [[[x' Yx' <-{x} _ <-//]|]]]. - by move=> ->; rewrite not_orP => -[_]/(_ erefl). - by move=> Yr; exists r%:E => //; split => [|[]//]; left; exists r. -- rewrite [X in measurable X](_ : _ = Y) // predeqE => r; split. - by rewrite setDUl setDv setU0 => -[_ [[x' Yx' <-]] _ <-]. - by move=> Yr; exists r%:E => //; split => [|[]//]; left; exists r. -Qed. - -Lemma elebesgue_measure'_ge0 X : (0 <= elebesgue_measure' X)%E. -Proof. exact/measure_ge0. Qed. - -Lemma semi_sigma_additive_elebesgue_measure' : - semi_sigma_additive elebesgue_measure'. -Proof. -move=> /= F mF tF mUF; rewrite /elebesgue_measure'. -rewrite [X in lebesgue_measure X](_ : _ = - \bigcup_n (fine @` (F n `\` [set -oo; +oo]%E))); last first. - rewrite predeqE => r; split. - by move=> [x [[n _ Fnx xoo <-]]]; exists n => //; exists x. - by move=> [n _ [x [Fnx xoo <-{r}]]]; exists x => //; split => //; exists n. -apply: (@measure_semi_sigma_additive _ _ (@lebesgue_measure R) - (fun n => fine @` (F n `\` [set -oo; +oo]%E))). -- move=> n; have := mF n. - move=> [X mX [X' mX']] XX'Fn. - apply: measurable_fine. - rewrite -XX'Fn. - apply: measurableU; first exact: measurable_EFin. - by case: mX' => //; exact: measurableU. -- move=> i j _ _ [x [[a [Fia aoo ax] [b [Fjb boo] bx]]]]. - move: tF => /(_ i j Logic.I Logic.I); apply. - suff ab : a = b by exists a; split => //; rewrite ab. - move: a b {Fia Fjb} aoo boo ax bx. - move=> [a| |] [b| |] /=. - + by move=> _ _ -> ->. - + by move=> _; rewrite not_orP => -[_]/(_ erefl). - + by move=> _; rewrite not_orP => -[]/(_ erefl). - + by rewrite not_orP => -[_]/(_ erefl). - + by rewrite not_orP => -[_]/(_ erefl). - + by rewrite not_orP => -[_]/(_ erefl). - + by rewrite not_orP => -[]/(_ erefl). - + by rewrite not_orP => -[]/(_ erefl). - + by rewrite not_orP => -[]/(_ erefl). -- move: mUF. - rewrite {1}/measurable /emeasurable /= => -[X mX [Y []]] {Y}. - - rewrite setU0 => h. - rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. - move=> -[n _ [x [Fnx xoo <-{r}]]]. - have : (\bigcup_n F n) x by exists n. - by rewrite -h => -[x' Xx' <-]. - have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; exists r. - by exists n => //; exists r%:E => //; split => //; case. - - move=> h. - rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. - move=> -[n _ [x [Fnx xoo <-]]]. - have : (\bigcup_n F n) x by exists n. - by rewrite -h => -[[x' Xx' <-//]|xoo']; move/not_orP : xoo => -[]. - have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; left; exists r. - by exists n => //; exists r%:E => //; split => //; case. - - (* NB: almost the same as the previous one, factorize?*) - move=> h. - rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. - move=> -[n _ [x [Fnx xoo <-]]]. - have : (\bigcup_n F n) x by exists n. - by rewrite -h => -[[x' Xx' <-//]|xoo']; move/not_orP : xoo => -[]. - have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; left; exists r. - by exists n => //; exists r%:E => //; split => //; case. - - move=> h. - rewrite [X in measurable X](_ : _ = X) // predeqE => r; split => [|Xr]. - move=> -[n _ [x [Fnx xoo <-]]]. - have : (\bigcup_n F n) x by exists n. - by rewrite -h => -[[x' Xx' <-//]|]. - have [n _ Fnr] : (\bigcup_n F n) r%:E by rewrite -h; left; exists r. - by exists n => //; exists r%:E => //; split => //; case. -Qed. - -Definition elebesgue_measure_isMeasure : is_measure elebesgue_measure' := - Measure.Axioms elebesgue_measure'0 elebesgue_measure'_ge0 - semi_sigma_additive_elebesgue_measure'. - -Definition elebesgue_measure : {measure set \bar R -> \bar R} := - Measure.Pack _ elebesgue_measure_isMeasure. - -End salgebra_R_ssets. -#[global] -Hint Extern 0 (measurable [set _]) => solve [apply: measurable_set1| - apply: emeasurable_set1] : core. - -Section measurable_fun_measurable. -Local Open Scope ereal_scope. -Variables (T : measurableType) (R : realType) (D : set T) (f : T -> \bar R). -Hypotheses (mD : measurable D) (mf : measurable_fun D f). -Implicit Types y : \bar R. - -Lemma emeasurable_fun_c_infty y : measurable (D `&` [set x | y <= f x]). -Proof. -by rewrite -preimage_itv_c_infty; exact/mf/emeasurable_itv_bnd_pinfty. -Qed. - -Lemma emeasurable_fun_o_infty y : measurable (D `&` [set x | y < f x]). -Proof. -by rewrite -preimage_itv_o_infty; exact/mf/emeasurable_itv_bnd_pinfty. -Qed. - -Lemma emeasurable_fun_infty_o y : measurable (D `&` [set x | f x < y]). -Proof. -by rewrite -preimage_itv_infty_o; exact/mf/emeasurable_itv_ninfty_bnd. -Qed. - -Lemma emeasurable_fun_infty_c y : measurable (D `&` [set x | f x <= y]). -Proof. -by rewrite -preimage_itv_infty_c; exact/mf/emeasurable_itv_ninfty_bnd. -Qed. - -Lemma emeasurable_fin_num : measurable (D `&` [set x | f x \is a fin_num]). -Proof. -rewrite [X in measurable X](_ : _ = - \bigcup_k (D `&` ([set x | - k%:R%:E <= f x] `&` [set x | f x <= k%:R%:E]))). - apply: bigcupT_measurable => k; rewrite -(setIid D) setIACA. - by apply: measurableI; [exact: emeasurable_fun_c_infty| - exact: emeasurable_fun_infty_c]. -rewrite predeqE => t; split => [/= [Dt ft]|]. - have [ft0|ft0] := leP 0%R (fine (f t)). - exists `|ceil (fine (f t))|%N => //=; split => //; split. - by rewrite -{2}(fineK ft)// lee_fin (le_trans _ ft0)// ler_oppl oppr0. - by rewrite natr_absz ger0_norm ?ceil_ge0// -(fineK ft) lee_fin ceil_ge. - exists `|floor (fine (f t))|%N => //=; split => //; split. - rewrite natr_absz ltr0_norm ?floor_lt0// EFinN. - by rewrite -{2}(fineK ft) lee_fin mulrNz opprK floor_le. - by rewrite -(fineK ft)// lee_fin (le_trans (ltW ft0)). -move=> [n _] [/= Dt [nft fnt]]; split => //; rewrite fin_numElt. -by rewrite (lt_le_trans _ nft) ?ltNye//= (le_lt_trans fnt)// ltey. -Qed. - -Lemma emeasurable_neq y : measurable (D `&` [set x | f x != y]). -Proof. -rewrite (_ : [set x | f x != y] = f @^-1` (setT `\ y)). - exact/mf/measurableD. -rewrite predeqE => t; split; last by rewrite /preimage /= => -[_ /eqP]. -by rewrite /= => ft0; rewrite /preimage /=; split => //; exact/eqP. -Qed. - -End measurable_fun_measurable. - -Module RGenOInfty. -Section rgenoinfty. -Variable R : realType. -Implicit Types x y z : R. - -Definition G := [set A | exists x, A = `]x, +oo[%classic]. -Let T := g_measurableType G. - -Lemma measurable_itv_bnd_infty b x : - @measurable T [set` Interval (BSide b x) +oo%O]. -Proof. -case: b; last by apply: sub_sigma_algebra; eexists; reflexivity. -rewrite itv_c_inftyEbigcap; apply: bigcapT_measurable => k. -by apply: sub_sigma_algebra; eexists; reflexivity. -Qed. - -Lemma measurable_itv_bounded a b x : a != +oo%O -> - @measurable T [set` Interval a (BSide b x)]. -Proof. -case: a => [a r _|[_|//]]. - by rewrite set_itv_splitD; apply: measurableD => //; - exact: measurable_itv_bnd_infty. -by rewrite -setCitvr; apply: measurableC; apply: measurable_itv_bnd_infty. -Qed. - -Lemma measurableE : - @measurable (g_measurableType (measurable : set (set (itvs R)))) = - @measurable T. -Proof. -rewrite eqEsubset; split => A. - apply: smallest_sub; first exact: smallest_sigma_algebra. - by move=> I [x _ <-]; exact: measurable_itv_bounded. -apply: smallest_sub; first exact: smallest_sigma_algebra. -by move=> A' /= [x ->]; exact: measurable_itv. -Qed. - -End rgenoinfty. -End RGenOInfty. - -Module RGenInftyO. -Section rgeninftyo. -Variable R : realType. -Implicit Types x y z : R. - -Definition G := [set A | exists x, A = `]-oo, x[%classic]. -Let T := g_measurableType G. - -Lemma measurable_itv_bnd_infty b x : - @measurable T [set` Interval -oo%O (BSide b x)]. + isAdditiveMeasure.Build _ R _ (hlength f : set ocitv_type -> _) + hlength_ge0' hlength_semi_additive. + +Lemma hlength_content_sub_fsum (D : {fset nat}) a0 b0 + (a b : nat -> R) : (forall i, i \in D -> a i <= b i) -> + `]a0, b0] `<=` \big[setU/set0]_(i <- D) `] a i, b i]%classic -> + f b0 - f a0 <= \sum_(i <- D) (f (b i) - f (a i)). +Proof. +move=> Dab h; have [ab|ab] := leP a0 b0; last first. + apply (@le_trans _ _ 0); first by rewrite subr_le0 ndf// ltW. + by rewrite big_seq sumr_ge0// => i iD; rewrite subr_ge0 ndf// Dab. +have mab k : + [set` D] k -> @measurable d itvs_semiRingOfSets `]a k, b k]%classic by []. +move: h; rewrite -bigcup_fset. +move/(@content_sub_fsum d R _ + [the additive_measure _ _ of hlength f : set ocitv_type -> _] _ [set` D] + `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) (finite_fset D) mab + (is_ocitv _ _)) => /=. +rewrite hlength_itv_bnd// -lee_fin => /le_trans; apply. +rewrite -sumEFin fsbig_finite//= set_fsetK// big_seq [in X in (_ <= X)%E]big_seq. +by apply: lee_sum => i iD; rewrite hlength_itv_bnd// Dab. +Qed. + +Lemma hlength_sigma_sub_additive (rcf : right_continuous f) : + sigma_sub_additive (hlength f : set ocitv_type -> _). Proof. -case: b; first by apply sub_sigma_algebra; eexists; reflexivity. -rewrite -setCitvr itv_o_inftyEbigcup; apply/measurableC/bigcupT_measurable => n. -rewrite -setCitvl; apply: measurableC. -by apply: sub_sigma_algebra; eexists; reflexivity. -Qed. - -Lemma measurable_itv_bounded a b x : a != -oo%O -> - @measurable T [set` Interval (BSide b x) a]. -Proof. -case: a => [a r _|[//|_]]. - by rewrite set_itv_splitD; apply/measurableD => //; - rewrite -setCitvl; apply: measurableC; exact: measurable_itv_bnd_infty. -by rewrite -setCitvl; apply: measurableC; apply: measurable_itv_bnd_infty. -Qed. - -Lemma measurableE : - @measurable (g_measurableType (measurable : set (set (itvs R)))) = - @measurable T. -Proof. -rewrite eqEsubset; split => A. - apply: smallest_sub; first exact: smallest_sigma_algebra. - by move=> I [x _ <-]; apply: measurable_itv_bounded. -apply: smallest_sub; first exact: smallest_sigma_algebra. -by move=> A' /= [x ->]; apply: measurable_itv. -Qed. - -End rgeninftyo. -End RGenInftyO. - -Module RGenCInfty. -Section rgencinfty. -Variable R : realType. -Implicit Types x y z : R. - -Definition G : set (set R) := [set A | exists x, A = `[x, +oo[%classic]. -Let T := g_measurableType G. - -Lemma measurable_itv_bnd_infty b x : - @measurable T [set` Interval (BSide b x) +oo%O]. -Proof. -case: b; first by apply: sub_sigma_algebra; exists x; rewrite set_itv_c_infty. -rewrite itv_o_inftyEbigcup; apply: bigcupT_measurable => k. -by apply: sub_sigma_algebra; eexists; reflexivity. -Qed. - -Lemma measurable_itv_bounded a b y : a != +oo%O -> - @measurable T [set` Interval a (BSide b y)]. -Proof. -case: a => [a r _|[_|//]]. - rewrite set_itv_splitD. - by apply: measurableD; apply: measurable_itv_bnd_infty. -by rewrite -setCitvr; apply: measurableC; apply: measurable_itv_bnd_infty. -Qed. - -Lemma measurableE : - @measurable (g_measurableType (measurable : set (set (itvs R)))) = - @measurable T. -Proof. -rewrite eqEsubset; split => A. - apply: smallest_sub; first exact: smallest_sigma_algebra. - by move=> I [x _ <-]; apply: measurable_itv_bounded. -apply: smallest_sub; first exact: smallest_sigma_algebra. -by move=> A' /= [x ->]; apply: measurable_itv. -Qed. - -End rgencinfty. -End RGenCInfty. - -Module RGenOpens. -Section rgenopens. - -Variable R : realType. -Implicit Types x y z : R. - -Definition G := [set A | exists x y, A = `]x, y[%classic]. -Let T := g_measurableType G. - -Local Lemma measurable_itvoo x y : @measurable T `]x, y[%classic. -Proof. by apply sub_sigma_algebra; eexists; eexists; reflexivity. Qed. - -Local Lemma measurable_itv_o_infty x : @measurable T `]x, +oo[%classic. -Proof. -rewrite itv_bnd_inftyEbigcup; apply: bigcupT_measurable => i. -exact: measurable_itvoo. -Qed. - -Lemma measurable_itv_bnd_infty b x : - @measurable T [set` Interval (BSide b x) +oo%O]. -Proof. -case: b; last exact: measurable_itv_o_infty. -rewrite itv_c_inftyEbigcap; apply: bigcapT_measurable => k. -exact: measurable_itv_o_infty. -Qed. - -Lemma measurable_itv_infty_bnd b x : - @measurable T [set` Interval -oo%O (BSide b x)]. -Proof. -by rewrite -setCitvr; apply: measurableC; exact: measurable_itv_bnd_infty. -Qed. - -Lemma measurable_itv_bounded a x b y : - @measurable T [set` Interval (BSide a x) (BSide b y)]. -Proof. -move: a b => [] []; rewrite -[X in measurable X]setCK setCitv; - apply: measurableC; apply: measurableU; try solve[ - exact: measurable_itv_infty_bnd|exact: measurable_itv_bnd_infty]. -Qed. - -Lemma measurableE : - @measurable (g_measurableType (measurable : set (set (itvs R)))) = - @measurable T. -Proof. -rewrite eqEsubset; split => A. - apply: smallest_sub; first exact: smallest_sigma_algebra. - by move=> I [x _ <-]; apply: measurable_itv_bounded. -apply: smallest_sub; first exact: smallest_sigma_algebra. -by move=> A' /= [x [y ->]]; apply: measurable_itv. -Qed. - -End rgenopens. -End RGenOpens. - -Section erealwithrays. -Variable R : realType. -Implicit Types (x y z : \bar R) (r s : R). -Local Open Scope ereal_scope. - -Lemma EFin_itv_bnd_infty b r : EFin @` [set` Interval (BSide b r) +oo%O] = - [set` Interval (BSide b r%:E) +oo%O] `\ +oo. -Proof. -rewrite eqEsubset; split => [x [s /itvP rs <-]|x []]. - split => //=; rewrite in_itv /=. - by case: b in rs *; rewrite /= ?(lee_fin, lte_fin) rs. -move: x => [s|_ /(_ erefl)|] //=; rewrite in_itv /= andbT; last first. - by case: b => /=; rewrite 1?(leNgt,ltNge) 1?(ltNye, leNye). -by case: b => /=; rewrite 1?(lte_fin,lee_fin) => rs _; - exists s => //; rewrite in_itv /= rs. -Qed. - -Lemma EFin_itv r : [set s | r%:E < s%:E] = `]r, +oo[%classic. -Proof. -by rewrite predeqE => s; split => [|]; rewrite /= lte_fin in_itv/= andbT. -Qed. - -Lemma preimage_EFin_setT : @EFin R @^-1` [set x | x \in `]-oo%E, +oo[] = setT. -Proof. -by rewrite set_itvE predeqE => r; split=> // _; rewrite /preimage /= ltNye. -Qed. - -Lemma eitv_c_infty r : `[r%:E, +oo[%classic = - \bigcap_k `](r - k.+1%:R^-1)%:E, +oo[%classic :> set _. -Proof. -rewrite predeqE => x; split=> [|]. -- move: x => [s /=| _ n _|//]. - + rewrite in_itv /= andbT lee_fin => rs n _ /=. - rewrite in_itv /= andbT lte_fin. - by rewrite ltr_subl_addl (le_lt_trans rs)// ltr_addr invr_gt0. - + by rewrite /= in_itv /= andbT ltey. -- move: x => [s| |/(_ 0%N Logic.I)] //=; last by rewrite in_itv /= leey. - move=> h; rewrite in_itv /= lee_fin leNgt andbT; apply/negP. - move=> /ltr_add_invr[k skr]; have {h} := h k Logic.I. - rewrite /= in_itv /= andbT lte_fin ltNge => /negP; apply. - by rewrite -ler_subl_addr opprK ltW. -Qed. - -Lemma eitv_infty_c r : `]-oo, r%:E]%classic = - \bigcap_k `]-oo, (r%:E + k.+1%:R^-1%:E)]%classic :> set _. -Proof. -rewrite predeqE => x; split=> [|]. -- move: x => [s /=|//|_ n _]. - + rewrite in_itv /= lee_fin => sr n _; rewrite /= in_itv /=. - by rewrite -EFinD lee_fin (le_trans sr)// ler_addl invr_ge0. - + by rewrite /= in_itv /= -EFinD leNye. -- move: x => [s|/(_ 0%N Logic.I)//|]/=; rewrite ?in_itv /= ?leNye//. - move=> h; rewrite lee_fin leNgt; apply/negP => /ltr_add_invr[k rks]. - have {h} := h k Logic.I; rewrite /= in_itv /=. - by rewrite -EFinD lee_fin leNgt => /negP; apply. -Qed. - -Lemma eset1_ninfty : - [set -oo] = \bigcap_k `]-oo, (-k%:R%:E)[%classic :> set (\bar R). -Proof. -rewrite eqEsubset; split=> [_ -> i _ |]; first by rewrite /= in_itv /= ltNye. -move=> [r|/(_ O Logic.I)|]//. -move=> /(_ `|floor r|%N Logic.I); rewrite /= in_itv/= ltNge. -rewrite lee_fin; have [r0|r0] := leP 0%R r. - by rewrite (le_trans _ r0) // ler_oppl oppr0 ler0n. -rewrite ler_oppl -abszN natr_absz gtr0_norm; last first. - by rewrite ltr_oppr oppr0 floor_lt0. -by rewrite mulrNz ler_oppl opprK floor_le. -Qed. - -Lemma eset1_pinfty : - [set +oo] = \bigcap_k `]k%:R%:E, +oo[%classic :> set (\bar R). -Proof. -rewrite eqEsubset; split=> [_ -> i _/=|]; first by rewrite in_itv /= ltey. -move=> [r| |/(_ O Logic.I)] // /(_ `|ceil r|%N Logic.I); rewrite /= in_itv /=. -rewrite andbT lte_fin ltNge. -have [r0|r0] := ltP 0%R r; last by rewrite (le_trans r0). -by rewrite natr_absz gtr0_norm // ?ceil_ge// ceil_gt0. -Qed. - -End erealwithrays. - -Module ErealGenOInfty. -Section erealgenoinfty. -Variable R : realType. -Implicit Types (x y z : \bar R) (r s : R). - -Local Open Scope ereal_scope. - -Definition G := [set A : set \bar R | exists x, A = `]x, +oo[%classic]. -Let T := g_measurableType G. - -Lemma measurable_set1_ninfty : @measurable T [set -oo]. -Proof. -rewrite eset1_ninfty; apply: (@bigcapT_measurable T) => i. -rewrite -setCitvr; apply: measurableC; rewrite eitv_c_infty. -apply: bigcapT_measurable => j; apply: sub_sigma_algebra. -by exists (- (i%:R + j.+1%:R^-1))%:E; rewrite opprD. -Qed. - -Lemma measurable_set1_pinfty : @measurable T [set +oo]. -Proof. -rewrite eset1_pinfty; apply: bigcapT_measurable => i. -by apply: sub_sigma_algebra; exists i%:R%:E. -Qed. - -Lemma measurableE : emeasurable (measurable : set (set (itvs R))) = @measurable T. -Proof. -apply/seteqP; split; last first. - apply: smallest_sub. - split; first exact: emeasurable0. - by move=> *; rewrite setTD; exact: emeasurableC. - by move=> *; exact: bigcupT_emeasurable. - move=> _ [x ->]; rewrite /emeasurable /=; move: x => [r| |]. - + exists `]r, +oo[%classic. - rewrite RGenOInfty.measurableE. - exact: RGenOInfty.measurable_itv_bnd_infty. - by exists [set +oo]; [constructor|rewrite -punct_eitv_bnd_pinfty]. - + exists set0 => //. - by exists set0; [constructor|rewrite setU0 itv_opinfty_pinfty image_set0]. - + exists setT => //; exists [set +oo]; first by constructor. - by rewrite itv_oninfty_pinfty punct_eitv_setTR. -move=> A [B mB [C mC]] <-; apply: measurableU; last first. - case: mC; [by []|exact: measurable_set1_ninfty - |exact: measurable_set1_pinfty|]. - - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. -rewrite RGenOInfty.measurableE in mB. -have smB := smallest_sub _ _ mB. -(* BUG: elim/smB : _. fails !! *) -apply: (smB (@measurable T \o (image^~ EFin))); last first. - move=> _ [r ->]/=; rewrite EFin_itv_bnd_infty; apply: measurableD. - by apply sub_sigma_algebra => /=; exists r%:E. - exact: measurable_set1_pinfty. -split=> /= [|D mD|F mF]; first by rewrite image_set0. -- rewrite setTD EFin_setC; apply: measurableD; first exact: measurableC. - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. -- by rewrite EFin_bigcup; apply: bigcupT_measurable => i; exact: mF. -Qed. - -End erealgenoinfty. -End ErealGenOInfty. - -Module ErealGenCInfty. -Section erealgencinfty. -Variable R : realType. -Implicit Types (x y z : \bar R) (r s : R). -Local Open Scope ereal_scope. - -Definition G := [set A : set \bar R | exists x, A = `[x, +oo[%classic]. -Let T := g_measurableType G. - -Lemma measurable_set1_ninfty : @measurable T [set -oo]. -Proof. -rewrite eset1_ninfty; apply: bigcapT_measurable=> i; rewrite -setCitvr. -by apply: measurableC; apply: sub_sigma_algebra; exists (- i%:R)%:E. -Qed. - -Lemma measurable_set1_pinfty : @measurable T [set +oo]. -Proof. -apply: sub_sigma_algebra; exists +oo; rewrite predeqE => x; split => [->//|/=]. -by rewrite in_itv /= andbT lee_pinfty_eq => /eqP ->. -Qed. - -Lemma measurableE : emeasurable (measurable : set (set (itvs R))) = @measurable T. -Proof. -apply/seteqP; split; last first. - apply: smallest_sub. - split; first exact: emeasurable0. - by move=> *; rewrite setTD; exact: emeasurableC. - by move=> *; exact: bigcupT_emeasurable. - move=> _ [[r||] ->]/=. - - exists `[r, +oo[%classic. - rewrite RGenOInfty.measurableE. - exact: RGenOInfty.measurable_itv_bnd_infty. - by exists [set +oo]; [constructor | rewrite -punct_eitv_bnd_pinfty]. - - exists set0 => //; exists [set +oo]; first by constructor. - by rewrite image_set0 set0U itv_cpinfty_pinfty. - - exists setT => //; exists [set -oo; +oo]; first by constructor. - by rewrite itv_cninfty_pinfty setUA punct_eitv_setTL setUCl. -move=> _ [A' mA' [C mC]] <-; apply: measurableU; last first. - case: mC; [by []|exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty|]. - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. -rewrite RGenCInfty.measurableE in mA'. -have smA' := smallest_sub _ _ mA'. -(* BUG: elim/smA' : _. fails !! *) -apply: (smA' (@measurable T \o (image^~ EFin))); last first. - move=> _ [r ->]/=; rewrite EFin_itv_bnd_infty; apply: measurableD. - by apply sub_sigma_algebra => /=; exists r%:E. - exact: measurable_set1_pinfty. -split=> /= [|D mD|F mF]; first by rewrite image_set0. -- rewrite setTD EFin_setC; apply: measurableD; first exact: measurableC. - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. -- by rewrite EFin_bigcup; apply: bigcupT_measurable => i; exact: mF. -Qed. - -End erealgencinfty. -End ErealGenCInfty. - -Section trace. -Variable (T : Type). -Implicit Types (G : set (set T)) (A D : set T). - -(* intended as a trace sigma-algebra *) -Definition strace G D := [set x `&` D | x in G]. - -Lemma stracexx G D : G D -> strace G D D. -Proof. by rewrite /strace /=; exists D => //; rewrite setIid. Qed. - -Lemma sigma_algebra_strace G D : - sigma_algebra setT G -> sigma_algebra D (strace G D). -Proof. -move=> [G0 GC GU]; split; first by exists set0 => //; rewrite set0I. -- move=> S [A mA ADS]; have mCA := GC _ mA. - have : strace G D (D `&` ~` A). - by rewrite setIC; exists (setT `\` A) => //; rewrite setTD. - rewrite -setDE => trDA. - have DADS : D `\` A = D `\` S by rewrite -ADS !setDE setCI setIUr setICr setU0. - by rewrite DADS in trDA. -- move=> S mS; have /choice[M GM] : forall n, exists A, G A /\ S n = A `&` D. - by move=> n; have [A mA ADSn] := mS n; exists A. - exists (\bigcup_i (M i)); first by apply GU => i; exact: (GM i).1. - by rewrite setI_bigcupl; apply eq_bigcupr => i _; rewrite (GM i).2. -Qed. - -End trace. - -Lemma strace_measurable (T : measurableType) (A : set T) : measurable A -> - strace measurable A `<=` measurable. -Proof. by move=> mA=> _ [C mC <-]; apply: measurableI. Qed. - -(* more properties of measurable functions *) - -Lemma is_interval_measurable (R : realType) (I : set R) : - is_interval I -> measurable I. -Proof. by move/is_intervalP => ->; exact: measurable_itv. Qed. - -Section coutinuous_measurable. -Variable R : realType. - -Lemma open_measurable (U : set R) : open U -> measurable U. -Proof. -move=> /open_bigcup_rat ->; rewrite bigcup_mkcond; apply: bigcupT_measurable_rat. -move=> q; case: ifPn => // qfab; apply: is_interval_measurable => //. -exact: is_interval_bigcup_ointsub. -Qed. - -Lemma continuous_measurable_fun (f : R -> R) : continuous f -> - measurable_fun setT f. -Proof. -move=> /continuousP cf; apply: (measurability (RGenOpens.measurableE R)). -move=> _ [_ [a [b ->] <-]]; rewrite setTI. -by apply: open_measurable; exact/cf/interval_open. -Qed. - -End coutinuous_measurable. - -Section standard_measurable_fun. - -Lemma measurable_fun_normr (R : realType) (D : set R) : - measurable_fun D (@normr _ R). -Proof. -move=> mD; apply: (measurability (RGenOInfty.measurableE R)) => //. -move=> /= _ [_ [x ->] <-]; apply: measurableI => //. -have [x0|x0] := leP 0 x. - rewrite [X in measurable X](_ : _ = `]-oo, (- x)[ `|` `]x, +oo[)%classic. - by apply: measurableU; apply: measurable_itv. - rewrite predeqE => r; split => [|[|]]; rewrite preimage_itv ?in_itv ?andbT/=. - - have [r0|r0] := leP 0 r; [rewrite ger0_norm|rewrite ltr0_norm] => // xr; - rewrite 2!in_itv/=. - + by right; rewrite xr. - + by left; rewrite ltr_oppr. - - move=> rx /=. - by rewrite ler0_norm 1?ltr_oppr// (le_trans (ltW rx))// ler_oppl oppr0. - - by rewrite in_itv /= andbT => xr; rewrite (lt_le_trans _ (ler_norm _)). -rewrite [X in measurable X](_ : _ = setT)// predeqE => r. -by split => // _; rewrite /= in_itv /= andbT (lt_le_trans x0). -Qed. - -End standard_measurable_fun. - -Section measurable_fun_realType. -Variables (T : measurableType) (R : realType). -Implicit Types (D : set T) (f g : T -> R). - -Lemma measurable_funD D f g : - measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \+ g). -Proof. -move=> mf mg mD; apply: (measurability (RGenOInfty.measurableE R)) => //. -move=> /= _ [_ [a ->] <-]; rewrite preimage_itv_o_infty. -rewrite [X in measurable X](_ : _ = \bigcup_(q : rat) - ((D `&` [set x | ratr q < f x]) `&` (D `&` [set x | a - ratr q < g x]))). - apply: bigcupT_measurable_rat => q; apply: measurableI. - - by rewrite -preimage_itv_o_infty; apply: mf => //; apply: measurable_itv. - - by rewrite -preimage_itv_o_infty; apply: mg => //; apply: measurable_itv. -rewrite predeqE => x; split => [|[r _] []/= [Dx rfx]] /= => [[Dx]|[_]]. - rewrite -ltr_subl_addr => /rat_in_itvoo[r]; rewrite inE /= => /itvP h. - exists r => //; rewrite setIACA setIid; split => //; split => /=. - by rewrite h. - by rewrite ltr_subl_addr addrC -ltr_subl_addr h. -by rewrite ltr_subl_addr=> afg; rewrite (lt_le_trans afg)// addrC ler_add2r ltW. -Qed. - -Lemma measurable_funrM D f (k : R) : measurable_fun D f -> - measurable_fun D (fun x => k * f x). -Proof. -apply: (@measurable_fun_comp _ _ _ ( *%R k)). -by apply: continuous_measurable_fun; apply: mulrl_continuous. -Qed. - -Lemma measurable_funN D f : measurable_fun D f -> measurable_fun D (-%R \o f). -Proof. -move=> mf mD; rewrite (_ : _ \o _ = (fun x => - 1 * f x)). - exact: measurable_funrM. -by under eq_fun do rewrite mulN1r. -Qed. - -Lemma measurable_funB D f g : measurable_fun D f -> - measurable_fun D g -> measurable_fun D (f \- g). -Proof. -by move=> ? ? ?; apply: measurable_funD => //; exact: measurable_funN. -Qed. - -Lemma measurable_fun_exprn D n f : - measurable_fun D f -> measurable_fun D (fun x => f x ^+ n). -Proof. -apply: measurable_fun_comp ((@GRing.exp R)^~ n) _ _ _. -by apply: continuous_measurable_fun; apply: exprn_continuous. -Qed. - -Lemma measurable_fun_sqr D f : - measurable_fun D f -> measurable_fun D (fun x => f x ^+ 2). -Proof. exact: measurable_fun_exprn. Qed. - -Lemma measurable_funM D f g : - measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \* g). -Proof. -move=> mf mg mD; rewrite (_ : (_ \* _) = (fun x => 2%:R^-1 * (f x + g x) ^+ 2) - \- (fun x => 2%:R^-1 * (f x ^+ 2)) \- (fun x => 2%:R^-1 * ( g x ^+ 2))). - apply: measurable_funB => //; last first. - by apply: measurable_funrM => //; exact: measurable_fun_sqr. - apply: measurable_funB => //; last first. - by apply: measurable_funrM => //; exact: measurable_fun_sqr. - apply: measurable_funrM => //. - by apply: measurable_fun_sqr => //; exact: measurable_funD. -rewrite funeqE => x /=; rewrite -2!mulrBr sqrrD (addrC (f x ^+ 2)) -addrA. -rewrite -(addrA (f x * g x *+ 2)) -opprB opprK (addrC (g x ^+ 2)) addrK. -by rewrite -(mulr_natr (f x * g x)) -(mulrC 2) mulrA mulVr ?mul1r// unitfE. -Qed. - -Lemma measurable_fun_max D f g : - measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \max g). -Proof. -move=> mf mg mD; apply (measurability (RGenCInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = - (D `&` f @^-1` `[x, +oo[) `|` (D `&` g @^-1` `[x, +oo[)); last first. - rewrite predeqE => t /=; split. - by rewrite /= !in_itv /= !andbT le_maxr => -[Dx /orP[|]]; tauto. - by move=> [|]; rewrite !in_itv/= !andbT le_maxr => -[Dx ->]//; rewrite orbT. -by apply: measurableU; [apply: mf|apply: mg] =>//; apply: measurable_itv. -Qed. - -Lemma measurable_fun_sups D (h : (T -> R)^nat) n : - (forall t, D t -> has_ubound (range (h ^~ t))) -> - (forall m, measurable_fun D (h m)) -> - measurable_fun D (fun x => sups (h ^~ x) n). -Proof. -move=> f_ub mf mD; apply: (measurability (RGenOInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite sups_preimage // setI_bigcupr. -by apply: bigcup_measurable => k /= nk; apply: mf => //; exact: measurable_itv. -Qed. - -Lemma measurable_fun_infs D (h : (T -> R)^nat) n : - (forall t, D t -> has_lbound (range (h ^~ t))) -> - (forall n, measurable_fun D (h n)) -> - measurable_fun D (fun x => infs (h ^~ x) n). -Proof. -move=> lb_f mf mD; apply: (measurability (RGenInftyO.measurableE R)) =>//. -move=> _ [_ [x ->] <-]; rewrite infs_preimage // setI_bigcupr. -by apply: bigcup_measurable => k /= nk; apply: mf => //; exact: measurable_itv. -Qed. - -Lemma measurable_fun_lim_sup D (h : (T -> R)^nat) : - (forall t, D t -> has_ubound (range (h ^~ t))) -> - (forall t, D t -> has_lbound (range (h ^~ t))) -> - (forall n, measurable_fun D (h n)) -> - measurable_fun D (fun x => lim_sup (h ^~ x)). -Proof. -move=> f_ub f_lb mf. -have : {in D, (fun x => inf [set sups (h ^~ x) n | n in [set n | 0 <= n]%N]) - =1 (fun x => lim_sup (h^~ x))}. - move=> t; rewrite inE => Dt; apply/esym/cvg_lim; first exact: Rhausdorff. - rewrite [X in _ --> X](_ : _ = inf (range (sups (h^~t)))). - by apply: cvg_sups_inf; [exact: f_ub|exact: f_lb]. - by congr (inf [set _ | _ in _]); rewrite predeqE. -move/eq_measurable_fun; apply; apply: measurable_fun_infs => //. - move=> t Dt; have [M hM] := f_lb _ Dt; exists M => _ [m /= nm <-]. - rewrite (@le_trans _ _ (h m t)) //; first by apply hM => /=; exists m. - by apply: sup_ub; [exact/has_ubound_sdrop/f_ub|exists m => /=]. -by move=> k; exact: measurable_fun_sups. -Qed. - -Lemma measurable_fun_cvg D (h : (T -> R)^nat) f : - (forall m, measurable_fun D (h m)) -> (forall x, D x -> h ^~ x --> f x) -> - measurable_fun D f. -Proof. -move=> mf_ f_f; have fE x : D x -> f x = lim_sup (h ^~ x). - move=> Dx; have /cvg_lim <-// := @cvg_sups _ (h ^~ x) (f x) (f_f _ Dx). - exact: Rhausdorff. -apply: (@eq_measurable_fun _ _ D (fun x => lim_sup (h ^~ x))). - by move=> x; rewrite inE => Dx; rewrite -fE. -apply: (@measurable_fun_lim_sup _ h) => // t Dt. -- apply/bounded_fun_has_ubound/(@cvg_seq_bounded _ [normedModType R of R^o]). - by apply/cvg_ex; eexists; exact: f_f. -- apply/bounded_fun_has_lbound/(@cvg_seq_bounded _ [normedModType R of R^o]). - by apply/cvg_ex; eexists; exact: f_f. -Qed. - -End measurable_fun_realType. - -Section standard_emeasurable_fun. -Variable R : realType. - -Lemma measurable_fun_EFin (D : set R) : measurable_fun D EFin. -Proof. -move=> mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. -move=> /= _ [_ [x ->]] <-; move: x => [x| |]; apply: measurableI => //. -- by rewrite preimage_itv_o_infty EFin_itv; exact: measurable_itv. -- by rewrite [X in measurable X](_ : _ = set0)// predeqE. -- by rewrite preimage_EFin_setT. -Qed. - -Lemma measurable_fun_abse (D : set (\bar R)) : measurable_fun D abse. -Proof. -move=> mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. -move=> /= _ [_ [x ->] <-]; move: x => [x| |]. -- rewrite [X in _ @^-1` X](punct_eitv_bnd_pinfty _ x) preimage_setU setIUr. - apply: measurableU; last first. - rewrite preimage_abse_pinfty. - by apply: measurableI => //; exact: measurableU. - apply: measurableI => //; exists (normr @^-1` `]x, +oo[%classic). - rewrite -[X in measurable X]setTI. - by apply: measurable_fun_normr => //; exact: measurable_itv. - exists set0; first by constructor. - rewrite setU0 predeqE => -[y| |]; split => /= => -[r]; - rewrite ?/= /= ?in_itv /= ?andbT => xr//. - + by move=> [ry]; exists `|y| => //=; rewrite in_itv/= andbT -ry. - + by move=> [ry]; exists y => //=; rewrite /= in_itv/= andbT -ry. -- by apply: measurableI => //; rewrite itv_opinfty_pinfty preimage_set0. -- apply: measurableI => //; rewrite itv_oninfty_pinfty -preimage_setC. - by apply: measurableC; rewrite preimage_abse_ninfty. -Qed. - -Lemma emeasurable_fun_minus (D : set (\bar R)) : - measurable_fun D (-%E : \bar R -> \bar R). -Proof. -move=> mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite (_ : _ @^-1` _ = `]-oo, (- x)%E]%classic). - by apply: measurableI => //; exact: emeasurable_itv_ninfty_bnd. -by rewrite predeqE => y; rewrite preimage_itv !in_itv/= andbT in_itv lee_oppr. -Qed. +move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. +move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. +case: ifPn => a12; last first. + rewrite nneseries_esum; last by move=> ? _; exact: hlength_ge0'. + by rewrite esum_ge0// => ? _; exact: hlength_ge0'. +wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. + move=> /= h. + set A' := fun n => if (b n).1 >= (b n).2 then set0 else A n. + set b' := fun n => if (b n).1 >= (b n).2 then (0, 0) else b n. + rewrite [X in (_ <= X)%E](_ : _ = \sum_(n k. + rewrite /= /A' AE; case: ifPn => // bn. + by rewrite set_itv_ge//= bnd_simp -leNgt. + apply (h b'). + - move=> k; rewrite /A'; case: ifPn => // bk. + by rewrite set_itv_ge//= bnd_simp -leNgt /b' bk. + - by rewrite AE /b' (negbTE bk). + - apply: (subset_trans lebig); apply subset_bigcup => k _. + rewrite /A' AE; case: ifPn => bk //. + by rewrite subset0 set_itv_ge//= bnd_simp -leNgt. + - by move=> k; rewrite /b'; case: ifPn => //; rewrite -ltNge => /ltW. +apply: lee_adde => e. +rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. +apply: le_trans (epsilon_trick _ _ _) => //=. +have [c ce] := nondecreasing_right_continuousP a.1 ndf rcf [gt0 of e%:num / 2]. +have [D De] : exists D : nat -> {posnum R}, forall i, + f ((b i).2 + (D i)%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + suff : forall i, exists di : {posnum R}, + f ((b i).2 + di%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + by move/choice => -[g hg]; exists g. + move=> k; apply nondecreasing_right_continuousP => //. + by rewrite divr_gt0 // exprn_gt0. +have acbd : `[ a.1 + c%:num / 2, a.2] `<=` \bigcup_i `](b i).1, (b i).2 + (D i)%:num[%classic. + apply (@subset_trans _ `]a.1, a.2]). + move=> r; rewrite /= !in_itv/= => /andP [+ ->]. + by rewrite andbT; apply: lt_le_trans; rewrite ltr_addl. + apply (subset_trans lebig) => r [n _ Anr]; exists n => //. + move: Anr; rewrite AE /= !in_itv/= => /andP [->]/= /le_lt_trans. + by apply; rewrite ltr_addl. +have := @segment_compact _ (a.1 + c%:num / 2) a.2; rewrite compact_cover. +have obd k : [set: nat] k-> open `](b k).1, ((b k).2 + (D k)%:num)[%classic. + by move=> _; exact: interval_open. +move=> /(_ _ _ _ obd acbd){obd acbd}. +case=> X _ acXbd. +rewrite -EFinD. +apply: (@le_trans _ _ (\sum_(i <- X) (hlength f `](b i).1, (b i).2]%classic) + + \sum_(i <- X) (f ((b i).2 + (D i)%:num)%R - f (b i).2)%:E)%E). + apply: (@le_trans _ _ (f a.2 - f (a.1 + c%:num / 2))%:E). + rewrite lee_fin -addrA -opprD ler_sub// (le_trans _ ce)// ndf//. + by rewrite ler_add2l ler_pdivr_mulr// ler_pmulr// ler1n. + apply: (@le_trans _ _ (\sum_(i <- X) (f ((b i).2 + (D i)%:num) - f (b i).1)%:E)%E). + rewrite sumEFin lee_fin hlength_content_sub_fsum//. + by move=> k kX; rewrite (@le_trans _ _ (b k).2)// ler_addl. + apply: subset_trans. + exact/(subset_trans _ acXbd)/subset_itv_oc_cc. + move=> x [k kX] kx; rewrite -bigcup_fset; exists k => //. + by move: x kx; exact: subset_itv_oo_oc. + rewrite addeC -big_split/=; apply: lee_sum => k _. + by rewrite !(EFinB, hlength_itv_bnd)// addeA subeK. +rewrite -big_split/= nneseries_esum//; last first. + by move=> k _; rewrite adde_ge0// hlength_ge0'. +rewrite esum_ge//; exists X => //. +rewrite big_seq [in X in (_ <= X)%E]big_seq; apply: lee_sum => k kX. +by rewrite AE lee_add2l// lee_fin ler_subl_addl natrX De. +Qed. + +Let gitvs := [the measurableType _ of salgebraType ocitv]. + +Definition lebesgue_stieltjes_measure := + Hahn_ext [the additive_measure _ _ of hlength f : set ocitv_type -> _ ]. -End standard_emeasurable_fun. -#[global] Hint Extern 0 (measurable_fun _ abse) => - solve [exact: measurable_fun_abse] : core. -#[global] Hint Extern 0 (measurable_fun _ EFin) => - solve [exact: measurable_fun_EFin] : core. +End itv_semiRingOfSets. +Arguments lebesgue_stieltjes_measure {R}. -(* NB: real-valued function *) -Lemma EFin_measurable_fun (T : measurableType) (R : realType) (D : set T) - (g : T -> R) : - measurable_fun D (EFin \o g) <-> measurable_fun D g. -Proof. -split=> [mf mD A mA|]; last by move=> mg; exact: measurable_fun_comp. -rewrite [X in measurable X](_ : _ = D `&` (EFin \o g) @^-1` (EFin @` A)). - by apply: mf => //; exists A => //; exists set0; [constructor|rewrite setU0]. -congr (_ `&` _);rewrite eqEsubset; split=> [|? []/= _ /[swap] -[->//]]. -by move=> ? ?; exact: preimage_image. -Qed. +Section lebesgue_stieltjes_measure_itv. +Variables (d : measure_display) (R : realType) (f : R -> R). +Hypotheses (ndf : {homo f : x y / x <= y}) (rcf : right_continuous f). -Section emeasurable_fun. -Local Open Scope ereal_scope. -Variables (T : measurableType) (R : realType). -Implicit Types (D : set T). +Let m := lebesgue_stieltjes_measure d f ndf. -Lemma measurable_fun_einfs D (f : (T -> \bar R)^nat) : - (forall n, measurable_fun D (f n)) -> - forall n, measurable_fun D (fun x => einfs (f ^~ x) n). -Proof. -move=> mf n mD. -apply: (measurability (ErealGenCInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite einfs_preimage -bigcapIr; last by exists n => /=. -by apply: bigcap_measurable => ? ?; exact/mf/emeasurable_itv_bnd_pinfty. -Qed. +Let g : \bar R -> \bar R := EFinf f. -Lemma measurable_fun_esups D (f : (T -> \bar R)^nat) : - (forall n, measurable_fun D (f n)) -> - forall n, measurable_fun D (fun x => esups (f ^~ x) n). +Let lebesgue_stieltjes_measure_itvoc (a b : R) : + (m `]a, b] = hlength f `]a, b])%classic. Proof. -move=> mf n mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-];rewrite esups_preimage setI_bigcupr. -by apply: bigcup_measurable => ? ?; exact/mf/emeasurable_itv_bnd_pinfty. +rewrite /m /lebesgue_stieltjes_measure /= /Hahn_ext measurable_mu_extE//; last first. + by exists (a, b). +exact: hlength_sigma_sub_additive. Qed. -Lemma emeasurable_fun_max D (f g : T -> \bar R) : - measurable_fun D f -> measurable_fun D g -> - measurable_fun D (fun x => maxe (f x) (g x)). +Lemma set1Ebigcap (x : R) : [set x] = \bigcap_k `](x - k.+1%:R^-1)%R, x]%classic. Proof. -move=> mf mg mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = - (D `&` f @^-1` `[x, +oo[) `|` (D `&` g @^-1` `[x, +oo[)); last first. - rewrite predeqE => t /=; split. - by rewrite !/= /= !in_itv /= !andbT le_maxr => -[Dx /orP[|]]; - tauto. - by move=> [|]; rewrite !/= /= !in_itv/= !andbT le_maxr; - move=> [Dx ->]//; rewrite orbT. -by apply: measurableU; [exact/mf/emeasurable_itv_bnd_pinfty| - exact/mg/emeasurable_itv_bnd_pinfty]. -Qed. +apply/seteqP; split => [_ -> k _ /=|]. + by rewrite in_itv/= lexx andbT ltr_subl_addl ltr_addr invr_gt0. +move=> y h; apply/eqP/negPn/negP => yx. +red in h. +simpl in h. +Admitted. -Lemma emeasurable_fun_funenng D (f : T -> \bar R) : - measurable_fun D f -> measurable_fun D f^\+. +Let lebesgue_stieltjes_measure_set1 (a : R) : + m [set a] = ((f a)%:E - (lim (f @ at_left a))%:E)%E. Proof. -by move=> mf; apply: emeasurable_fun_max => //; apply: measurable_fun_cst. -Qed. +rewrite (set1Ebigcap a). +Admitted. -Lemma emeasurable_fun_funennp D (f : T -> \bar R) : - measurable_fun D f -> measurable_fun D f^\-. +Let lebesgue_stieltjes_measure_itvoo (a b : R) : a <= b -> + m `]a, b[%classic = ((lim (f @ at_left b))%:E - (f a)%:E)%E. Proof. -move=> mf; apply: emeasurable_fun_max => //; last exact: measurable_fun_cst. -by apply: measurable_fun_comp => //; apply: emeasurable_fun_minus. -Qed. +Admitted. -Lemma emeasurable_fun_min D (f g : T -> \bar R) : - measurable_fun D f -> measurable_fun D g -> - measurable_fun D (fun x => mine (f x) (g x)). +Let lebesgue_stieltjes_measure_itvcc (a b : R) : a <= b -> + m `[a, b]%classic = ((f b)%:E - (lim (f @ at_left a))%:E)%E. Proof. -move=> mf mg mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = - (D `&` f @^-1` `[x, +oo[) `&` (D `&` g @^-1` `[x, +oo[)); last first. - rewrite predeqE => t /=; split. - rewrite !/= !in_itv /= !andbT le_minr => -[Dt /andP[xft xgt]]. - tauto. - move=> []; rewrite !/= !in_itv/= !andbT le_minr=> -[Dt xft [_ xgt]]. - by split => //; rewrite xft xgt. -by apply: measurableI; [exact/mf/emeasurable_itv_bnd_pinfty| - exact/mg/emeasurable_itv_bnd_pinfty]. -Qed. +Admitted. -Lemma measurable_fun_elim_sup D (f : (T -> \bar R)^nat) : - (forall n, measurable_fun D (f n)) -> - measurable_fun D (fun x => elim_sup (f ^~ x)). +Let lebesgue_stieltjes_measure_itvco (a b : R) : a <= b -> + m `[a, b[%classic = ((lim (f @ at_left b))%:E - (lim (f @ at_left a))%:E)%E. Proof. -move=> mf mD; rewrite (_ : (fun _ => _) = - (fun x => ereal_inf [set esups (f^~ x) n | n in [set n | n >= 0]%N])). - by apply: measurable_fun_einfs => // k; exact: measurable_fun_esups. -rewrite funeqE => t; apply/cvg_lim => //. -rewrite [X in _ --> X](_ : _ = ereal_inf (range (esups (f^~t)))). - exact: cvg_esups_inf. -by congr (ereal_inf [set _ | _ in _]); rewrite predeqE. -Qed. +Admitted. -Lemma emeasurable_fun_cvg D (f_ : (T -> \bar R)^nat) (f : T -> \bar R) : - (forall m, measurable_fun D (f_ m)) -> - (forall x, D x -> f_ ^~ x --> f x) -> measurable_fun D f. -Proof. -move=> mf_ f_f; have fE x : D x -> f x = elim_sup (f_^~ x). - by move=> Dx; have /cvg_lim <-// := @cvg_esups _ (f_^~x) (f x) (f_f x Dx). -apply: (measurable_fun_ext (fun x => elim_sup (f_ ^~ x))) => //. - by move=> x; rewrite inE => Dx; rewrite fE. -exact: measurable_fun_elim_sup. -Qed. -End emeasurable_fun. -Arguments emeasurable_fun_cvg {T R D} f_. +End lebesgue_stieltjes_measure_itv. From 50cda6f94573b903982f64d53fc423f97ade0afc Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 28 Aug 2022 12:36:10 +0900 Subject: [PATCH 05/19] cumulative function with HB Co-authored-by: brun@itu.dk Co-authored-by: Takafumi Saikawa --- theories/lebesgue_stieltjes_measure.v | 154 ++++++++++++++------------ 1 file changed, 81 insertions(+), 73 deletions(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 1b71827aae..665d527f5d 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -29,21 +29,50 @@ Local Open Scope ring_scope. Notation right_continuous f := (forall x, f%function @ at_right x --> f%function x). -Lemma nondecreasing_right_continuousP (R : realType) (a : R) (e : R) - (f : R -> R) (ndf : {homo f : x y / x <= y}) (rcf : (right_continuous f)) : +Lemma right_continuousW (R : numFieldType) (f : R -> R) : + continuous f -> right_continuous f. +Proof. by move=> cf x; apply: cvg_within_filter; exact/cf. Qed. + +HB.mixin Record isCumulative (R : numFieldType) (f : R -> R) := { + cumulative_is_nondecreasing : {homo f : x y / x <= y} ; + cumulative_is_right_continuous : right_continuous f }. + +#[short(type=cumulative)] +HB.structure Definition Cumulative (R : numFieldType) := + { f of isCumulative R f }. + +Arguments cumulative_is_nondecreasing {R} _. +Arguments cumulative_is_right_continuous {R} _. + +Lemma nondecreasing_right_continuousP (R : numFieldType) (a : R) (e : R) + (f : cumulative R) : e > 0 -> exists d : {posnum R}, f (a + d%:num) <= f a + e. Proof. -move=> e0; move: rcf => /(_ a)/(@cvg_dist _ [normedModType R of R^o]). +move=> e0; move: (cumulative_is_right_continuous f). +move=> /(_ a)/(@cvg_dist _ [normedModType R of R^o]). move=> /(_ _ e0)[] _ /posnumP[d] => h. exists (PosNum [gt0 of (d%:num / 2)]) => //=. move: h => /(_ (a + d%:num / 2)) /=. rewrite opprD addrA subrr distrC subr0 ger0_norm //. rewrite ltr_pdivr_mulr// ltr_pmulr// ltr1n => /(_ erefl). rewrite ltr_addl divr_gt0// => /(_ erefl). -rewrite ler0_norm; last by rewrite subr_le0 ndf// ler_addl. +rewrite ler0_norm; last first. + by rewrite subr_le0 (cumulative_is_nondecreasing f)// ler_addl. by rewrite opprB ltr_subl_addl => fa; exact: ltW. Qed. +Section id_is_cumulative. +Variable R : realType. + +Let id_nd : {homo @idfun R : x y / x <= y}. +Proof. by []. Qed. + +Let id_rc : right_continuous (@idfun R). +Proof. by apply/right_continuousW => x; exact: cvg_id. Qed. + +HB.instance Definition _ := isCumulative.Build R idfun id_nd id_rc. +End id_is_cumulative. + (* TODO: move and use in lebesgue_measure.v? *) Lemma le_inf (R : realType) (S1 S2 : set R) : -%R @` S2 `<=` down (-%R @` S1) -> nonempty S2 -> has_inf S1 @@ -66,8 +95,6 @@ Qed. Section hlength. Local Open Scope ereal_scope. Variables (R : realType) (f : R -> R). -Hypothesis ndf : {homo f : x y / (x <= y)%R}. - Let g : \bar R -> \bar R := EFinf f. Implicit Types i j : interval R. @@ -149,7 +176,7 @@ rewrite hlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. - by right. Qed. -Lemma hlength_ge0 i : 0 <= hlength [set` i]. +Lemma hlength_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. - by rewrite suber_ge0// => /ltW /(nondecreasing_EFinf ndf). @@ -161,7 +188,7 @@ Local Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. Lemma hlength_Rhull (A : set R) : hlength [set` Rhull A] = hlength A. Proof. by rewrite /hlength Rhull_involutive. Qed. -Lemma le_hlength_itv i j : +Lemma le_hlength_itv (ndf : {homo f : x y / (x <= y)%R}) i j : {subset i <= j} -> hlength [set` i] <= hlength [set` j]. Proof. set I := [set` i]; set J := [set` j]. @@ -183,9 +210,10 @@ move=> r [r' Ir' <-{r}]; exists (- r')%R. by split => //; exists r' => //; apply: ij. Qed. -Lemma le_hlength : {homo hlength : A B / A `<=` B >-> A <= B}. +Lemma le_hlength (ndf : {homo f : x y / (x <= y)%R}) : + {homo hlength : A B / A `<=` B >-> A <= B}. Proof. -move=> a b /le_Rhull /le_hlength_itv. +move=> a b /le_Rhull /(le_hlength_itv ndf). by rewrite (hlength_Rhull a) (hlength_Rhull b). Qed. @@ -208,7 +236,8 @@ Lemma ocitv0 : ocitv set0. Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. Hint Resolve ocitv0 : core. -Lemma ocitvP X : ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. +Lemma ocitvP X : + ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. Proof. split=> [[x _ <-]|[->//|[x xlt ->]]]//. case: (boolP (x.1 < x.2)) => x12; first by right; exists x. @@ -252,14 +281,13 @@ Qed. Variable d : measure_display. -HB.instance Definition _ := - @isSemiRingOfSets.Build d ocitv_type (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. +HB.instance Definition _ := @isSemiRingOfSets.Build d ocitv_type + (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. Definition itvs_semiRingOfSets := [the semiRingOfSetsType d of ocitv_type]. -Variable f : R -> R. - -Lemma hlength_semi_additive : semi_additive (hlength f : set ocitv_type -> _). +Lemma hlength_semi_additive (f : R -> R) : + semi_additive (hlength f : set ocitv_type -> _). Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. @@ -326,7 +354,8 @@ Qed. Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. -Lemma hlength_sigma_finite : sigma_finite [set: ocitv_type] (hlength f). +Lemma hlength_sigma_finite (f : R -> R) : + sigma_finite [set: ocitv_type] (hlength f). Proof. exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). apply/esym; rewrite -subTset => /= x _ /=. @@ -336,26 +365,30 @@ exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). rewrite [ltRHS]ger0_norm//. by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. by rewrite addr_ge0// -Rfloor0 le_Rfloor. -by move=> k; split => //; rewrite hlength_itv /= -EFinB; case: ifP; rewrite ltey. +move=> k; split => //; rewrite hlength_itv /= -EFinB. +by case: ifP; rewrite ltey. Qed. -Hypothesis ndf : {homo f : x y / (x <= y)%R}. - -Lemma hlength_ge0' (I : set ocitv_type) : (0 <= hlength f I)%E. -Proof. by rewrite -(hlength0 f) le_hlength. Qed. +Lemma hlength_ge0' (f : cumulative R) (I : set ocitv_type) : + (0 <= hlength f I)%E. +Proof. +by rewrite -(hlength0 f) le_hlength//; exact: cumulative_is_nondecreasing. +Qed. -HB.instance Definition _ := +HB.instance Definition _ (f : cumulative R) := isAdditiveMeasure.Build _ R _ (hlength f : set ocitv_type -> _) - hlength_ge0' hlength_semi_additive. + (hlength_ge0' f) (hlength_semi_additive f). -Lemma hlength_content_sub_fsum (D : {fset nat}) a0 b0 +Lemma hlength_content_sub_fsum (f : cumulative R) (D : {fset nat}) a0 b0 (a b : nat -> R) : (forall i, i \in D -> a i <= b i) -> `]a0, b0] `<=` \big[setU/set0]_(i <- D) `] a i, b i]%classic -> f b0 - f a0 <= \sum_(i <- D) (f (b i) - f (a i)). Proof. move=> Dab h; have [ab|ab] := leP a0 b0; last first. - apply (@le_trans _ _ 0); first by rewrite subr_le0 ndf// ltW. - by rewrite big_seq sumr_ge0// => i iD; rewrite subr_ge0 ndf// Dab. + apply (@le_trans _ _ 0). + by rewrite subr_le0 cumulative_is_nondecreasing// ltW. + rewrite big_seq sumr_ge0// => i iD. + by rewrite subr_ge0 cumulative_is_nondecreasing// Dab. have mab k : [set` D] k -> @measurable d itvs_semiRingOfSets `]a k, b k]%classic by []. move: h; rewrite -bigcup_fset. @@ -368,7 +401,7 @@ rewrite -sumEFin fsbig_finite//= set_fsetK// big_seq [in X in (_ <= X)%E]big_seq by apply: lee_sum => i iD; rewrite hlength_itv_bnd// Dab. Qed. -Lemma hlength_sigma_sub_additive (rcf : right_continuous f) : +Lemma hlength_sigma_sub_additive (f : cumulative R) : sigma_sub_additive (hlength f : set ocitv_type -> _). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. @@ -381,7 +414,7 @@ wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. set A' := fun n => if (b n).1 >= (b n).2 then set0 else A n. set b' := fun n => if (b n).1 >= (b n).2 then (0, 0) else b n. rewrite [X in (_ <= X)%E](_ : _ = \sum_(n k. + apply: (@eq_eseries _ (hlength f \o A) (hlength f \o A')) => k. rewrite /= /A' AE; case: ifPn => // bn. by rewrite set_itv_ge//= bnd_simp -leNgt. apply (h b'). @@ -395,7 +428,7 @@ wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. apply: lee_adde => e. rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. apply: le_trans (epsilon_trick _ _ _) => //=. -have [c ce] := nondecreasing_right_continuousP a.1 ndf rcf [gt0 of e%:num / 2]. +have [c ce] := nondecreasing_right_continuousP a.1 f [gt0 of e%:num / 2]. have [D De] : exists D : nat -> {posnum R}, forall i, f ((b i).2 + (D i)%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. suff : forall i, exists di : {posnum R}, @@ -403,7 +436,8 @@ have [D De] : exists D : nat -> {posnum R}, forall i, by move/choice => -[g hg]; exists g. move=> k; apply nondecreasing_right_continuousP => //. by rewrite divr_gt0 // exprn_gt0. -have acbd : `[ a.1 + c%:num / 2, a.2] `<=` \bigcup_i `](b i).1, (b i).2 + (D i)%:num[%classic. +have acbd : `[ a.1 + c%:num / 2, a.2] `<=` + \bigcup_i `](b i).1, (b i).2 + (D i)%:num[%classic. apply (@subset_trans _ `]a.1, a.2]). move=> r; rewrite /= !in_itv/= => /andP [+ ->]. by rewrite andbT; apply: lt_le_trans; rewrite ltr_addl. @@ -417,11 +451,13 @@ move=> /(_ _ _ _ obd acbd){obd acbd}. case=> X _ acXbd. rewrite -EFinD. apply: (@le_trans _ _ (\sum_(i <- X) (hlength f `](b i).1, (b i).2]%classic) + - \sum_(i <- X) (f ((b i).2 + (D i)%:num)%R - f (b i).2)%:E)%E). + \sum_(i <- X) (f ((b i).2 + (D i)%:num)%R - f (b i).2)%:E)%E). apply: (@le_trans _ _ (f a.2 - f (a.1 + c%:num / 2))%:E). - rewrite lee_fin -addrA -opprD ler_sub// (le_trans _ ce)// ndf//. + rewrite lee_fin -addrA -opprD ler_sub// (le_trans _ ce)//. + rewrite cumulative_is_nondecreasing//. by rewrite ler_add2l ler_pdivr_mulr// ler_pmulr// ler1n. - apply: (@le_trans _ _ (\sum_(i <- X) (f ((b i).2 + (D i)%:num) - f (b i).1)%:E)%E). + apply: (@le_trans _ _ + (\sum_(i <- X) (f ((b i).2 + (D i)%:num) - f (b i).1)%:E)%E). rewrite sumEFin lee_fin hlength_content_sub_fsum//. by move=> k kX; rewrite (@le_trans _ _ (b k).2)// ler_addl. apply: subset_trans. @@ -432,64 +468,36 @@ apply: (@le_trans _ _ (\sum_(i <- X) (hlength f `](b i).1, (b i).2]%classic) + by rewrite !(EFinB, hlength_itv_bnd)// addeA subeK. rewrite -big_split/= nneseries_esum//; last first. by move=> k _; rewrite adde_ge0// hlength_ge0'. -rewrite esum_ge//; exists X => //. +rewrite esum_ge//; exists [set` X] => //; rewrite fsbig_finite//= set_fsetK. rewrite big_seq [in X in (_ <= X)%E]big_seq; apply: lee_sum => k kX. by rewrite AE lee_add2l// lee_fin ler_subl_addl natrX De. Qed. Let gitvs := [the measurableType _ of salgebraType ocitv]. -Definition lebesgue_stieltjes_measure := +Definition lebesgue_stieltjes_measure (f : cumulative R) := Hahn_ext [the additive_measure _ _ of hlength f : set ocitv_type -> _ ]. End itv_semiRingOfSets. Arguments lebesgue_stieltjes_measure {R}. Section lebesgue_stieltjes_measure_itv. -Variables (d : measure_display) (R : realType) (f : R -> R). -Hypotheses (ndf : {homo f : x y / x <= y}) (rcf : right_continuous f). +Variables (d : measure_display) (R : realType) (f : cumulative R). -Let m := lebesgue_stieltjes_measure d f ndf. +Let m := lebesgue_stieltjes_measure d f. Let g : \bar R -> \bar R := EFinf f. Let lebesgue_stieltjes_measure_itvoc (a b : R) : (m `]a, b] = hlength f `]a, b])%classic. Proof. -rewrite /m /lebesgue_stieltjes_measure /= /Hahn_ext measurable_mu_extE//; last first. - by exists (a, b). -exact: hlength_sigma_sub_additive. +rewrite /m /lebesgue_stieltjes_measure /= /Hahn_ext measurable_mu_extE//. + exact: hlength_sigma_sub_additive. +by exists (a, b). Qed. -Lemma set1Ebigcap (x : R) : [set x] = \bigcap_k `](x - k.+1%:R^-1)%R, x]%classic. -Proof. -apply/seteqP; split => [_ -> k _ /=|]. - by rewrite in_itv/= lexx andbT ltr_subl_addl ltr_addr invr_gt0. -move=> y h; apply/eqP/negPn/negP => yx. -red in h. -simpl in h. -Admitted. - -Let lebesgue_stieltjes_measure_set1 (a : R) : - m [set a] = ((f a)%:E - (lim (f @ at_left a))%:E)%E. -Proof. -rewrite (set1Ebigcap a). -Admitted. - -Let lebesgue_stieltjes_measure_itvoo (a b : R) : a <= b -> - m `]a, b[%classic = ((lim (f @ at_left b))%:E - (f a)%:E)%E. -Proof. -Admitted. - -Let lebesgue_stieltjes_measure_itvcc (a b : R) : a <= b -> - m `[a, b]%classic = ((f b)%:E - (lim (f @ at_left a))%:E)%E. -Proof. -Admitted. - -Let lebesgue_stieltjes_measure_itvco (a b : R) : a <= b -> - m `[a, b[%classic = ((lim (f @ at_left b))%:E - (lim (f @ at_left a))%:E)%E. -Proof. -Admitted. - - End lebesgue_stieltjes_measure_itv. + +Example lebesgue_measure d (R : realType) + : set [the measurableType (d.-measurable).-sigma of salgebraType (d.-measurable)] -> \bar R := + lebesgue_stieltjes_measure _ [the cumulative _ of @idfun R]. From 97867e70733c51c2d933610563a28693c641ce24 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 5 Jan 2023 16:02:33 +0900 Subject: [PATCH 06/19] upd and complete --- theories/lebesgue_stieltjes_measure.v | 40 +++++++++++++++++++-------- 1 file changed, 29 insertions(+), 11 deletions(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 665d527f5d..a6315b5654 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -5,7 +5,7 @@ From mathcomp Require Import finmap fingroup perm rat. Require Import boolp reals ereal classical_sets signed topology numfun. Require Import mathcomp_extra functions normedtype. From HB Require Import structures. -Require Import sequences esum measure fsbigop cardinality set_interval. +Require Import sequences esum measure fsbigop cardinality real_interval. Require Import realfun. (******************************************************************************) @@ -49,7 +49,7 @@ Lemma nondecreasing_right_continuousP (R : numFieldType) (a : R) (e : R) e > 0 -> exists d : {posnum R}, f (a + d%:num) <= f a + e. Proof. move=> e0; move: (cumulative_is_right_continuous f). -move=> /(_ a)/(@cvg_dist _ [normedModType R of R^o]). +move=> /(_ a)/(@cvgr_dist_lt _ [normedModType R of R^o]). move=> /(_ _ e0)[] _ /posnumP[d] => h. exists (PosNum [gt0 of (d%:num / 2)]) => //=. move: h => /(_ (a + d%:num / 2)) /=. @@ -132,7 +132,7 @@ Lemma hlength_finite_fin_num i : neitv i -> hlength [set` i] < +oo -> ((i.1 : \bar R) \is a fin_num) /\ ((i.2 : \bar R) \is a fin_num). Proof. move: i => [[ba a|[]] [bb b|[]]] /neitvP //=; do ?by rewrite ?set_itvE ?eqxx. -by move=> _; rewrite hlength_itv /= ltey. +by move=> _; rewrite hlength_itv /= ltry. by move=> _; rewrite hlength_itv /= ltNye. by move=> _; rewrite hlength_itv. Qed. @@ -150,7 +150,7 @@ rewrite hlength_itv; case: ifPn => //; rewrite -leNgt le_eqVlt => /predU1P[->|]. by move/lt_ereal_bnd/ltW; rewrite leNgt; move: i0 => /neitvP => ->. Qed. -Lemma hlength_itv_bnd (a b : R) (x y : bool): (a <= b)%R -> +Lemma hlength_itv_bnd (a b : R) (x y : bool) : (a <= b)%R -> hlength [set` Interval (BSide x a) (BSide y b)] = (f b - f a)%:E. Proof. move=> ab; rewrite hlength_itv/= lte_fin lt_neqAle ab andbT. @@ -357,7 +357,7 @@ Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. Lemma hlength_sigma_finite (f : R -> R) : sigma_finite [set: ocitv_type] (hlength f). Proof. -exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). +exists (fun k => `](- k%:R), k%:R]%classic). apply/esym; rewrite -subTset => /= x _ /=. exists `|(floor `|x|%R + 1)%R|%N; rewrite //= in_itv/=. rewrite !natr_absz intr_norm intrD -RfloorE. @@ -438,10 +438,10 @@ have [D De] : exists D : nat -> {posnum R}, forall i, by rewrite divr_gt0 // exprn_gt0. have acbd : `[ a.1 + c%:num / 2, a.2] `<=` \bigcup_i `](b i).1, (b i).2 + (D i)%:num[%classic. - apply (@subset_trans _ `]a.1, a.2]). + apply: (@subset_trans _ `]a.1, a.2]). move=> r; rewrite /= !in_itv/= => /andP [+ ->]. by rewrite andbT; apply: lt_le_trans; rewrite ltr_addl. - apply (subset_trans lebig) => r [n _ Anr]; exists n => //. + apply: (subset_trans lebig) => r [n _ Anr]; exists n => //. move: Anr; rewrite AE /= !in_itv/= => /andP [->]/= /le_lt_trans. by apply; rewrite ltr_addl. have := @segment_compact _ (a.1 + c%:num / 2) a.2; rewrite compact_cover. @@ -478,20 +478,38 @@ Let gitvs := [the measurableType _ of salgebraType ocitv]. Definition lebesgue_stieltjes_measure (f : cumulative R) := Hahn_ext [the additive_measure _ _ of hlength f : set ocitv_type -> _ ]. +Let lebesgue_stieltjes_measure0 (f : cumulative R) : + lebesgue_stieltjes_measure f set0 = 0%E. +Proof. by []. Qed. + +Let lebesgue_stieltjes_measure_ge0 (f : cumulative R) : + forall x, (0 <= lebesgue_stieltjes_measure f x)%E. +Proof. exact: measure.Hahn_ext_ge0. Qed. + +Let lebesgue_stietjes_measure_semi_sigma_additive (f : cumulative R) : + semi_sigma_additive (lebesgue_stieltjes_measure f). +Proof. exact/measure.Hahn_ext_sigma_additive/hlength_sigma_sub_additive. Qed. + +HB.instance Definition _ (f : cumulative R) := isMeasure.Build _ _ _ + (lebesgue_stieltjes_measure f) + (lebesgue_stieltjes_measure0 f) + (lebesgue_stieltjes_measure_ge0 f) + (@lebesgue_stietjes_measure_semi_sigma_additive f). + End itv_semiRingOfSets. Arguments lebesgue_stieltjes_measure {R}. Section lebesgue_stieltjes_measure_itv. Variables (d : measure_display) (R : realType) (f : cumulative R). -Let m := lebesgue_stieltjes_measure d f. +Let m := [the measure _ _ of lebesgue_stieltjes_measure d f]. Let g : \bar R -> \bar R := EFinf f. Let lebesgue_stieltjes_measure_itvoc (a b : R) : (m `]a, b] = hlength f `]a, b])%classic. Proof. -rewrite /m /lebesgue_stieltjes_measure /= /Hahn_ext measurable_mu_extE//. +rewrite /m/= /lebesgue_stieltjes_measure /= /Hahn_ext measurable_mu_extE//. exact: hlength_sigma_sub_additive. by exists (a, b). Qed. @@ -499,5 +517,5 @@ Qed. End lebesgue_stieltjes_measure_itv. Example lebesgue_measure d (R : realType) - : set [the measurableType (d.-measurable).-sigma of salgebraType (d.-measurable)] -> \bar R := - lebesgue_stieltjes_measure _ [the cumulative _ of @idfun R]. + : {measure set [the measurableType (d.-measurable).-sigma of salgebraType (d.-measurable)] -> \bar R} := + [the measure _ _ of lebesgue_stieltjes_measure _ [the cumulative _ of @idfun R]]. From 35a1bfb77cef428fa61c0451128cde1fee8c1972 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 25 Feb 2023 18:32:52 +0900 Subject: [PATCH 07/19] upd --- theories/lebesgue_stieltjes_measure.v | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index a6315b5654..825cfcef27 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -376,7 +376,7 @@ by rewrite -(hlength0 f) le_hlength//; exact: cumulative_is_nondecreasing. Qed. HB.instance Definition _ (f : cumulative R) := - isAdditiveMeasure.Build _ R _ (hlength f : set ocitv_type -> _) + isContent.Build _ _ R (hlength f : set ocitv_type -> _) (hlength_ge0' f) (hlength_semi_additive f). Lemma hlength_content_sub_fsum (f : cumulative R) (D : {fset nat}) a0 b0 @@ -393,7 +393,7 @@ have mab k : [set` D] k -> @measurable d itvs_semiRingOfSets `]a k, b k]%classic by []. move: h; rewrite -bigcup_fset. move/(@content_sub_fsum d R _ - [the additive_measure _ _ of hlength f : set ocitv_type -> _] _ [set` D] + [the content _ _ of hlength f : set ocitv_type -> _] _ [set` D] `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) (finite_fset D) mab (is_ocitv _ _)) => /=. rewrite hlength_itv_bnd// -lee_fin => /le_trans; apply. @@ -414,7 +414,7 @@ wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. set A' := fun n => if (b n).1 >= (b n).2 then set0 else A n. set b' := fun n => if (b n).1 >= (b n).2 then (0, 0) else b n. rewrite [X in (_ <= X)%E](_ : _ = \sum_(n k. + apply: (@eq_eseriesr _ (hlength f \o A) (hlength f \o A')) => k. rewrite /= /A' AE; case: ifPn => // bn. by rewrite set_itv_ge//= bnd_simp -leNgt. apply (h b'). @@ -476,7 +476,7 @@ Qed. Let gitvs := [the measurableType _ of salgebraType ocitv]. Definition lebesgue_stieltjes_measure (f : cumulative R) := - Hahn_ext [the additive_measure _ _ of hlength f : set ocitv_type -> _ ]. + Hahn_ext [the content _ _ of hlength f : set ocitv_type -> _ ]. Let lebesgue_stieltjes_measure0 (f : cumulative R) : lebesgue_stieltjes_measure f set0 = 0%E. From 11dc66f1427e49ecafc5798de67ef9e94d21d0c5 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 15 Mar 2023 00:22:46 +0900 Subject: [PATCH 08/19] EFinf is actually er_map --- theories/Make | 1 + theories/lebesgue_stieltjes_measure.v | 21 +++++++++------------ 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/theories/Make b/theories/Make index cd6285c45a..4cf4ff2c66 100644 --- a/theories/Make +++ b/theories/Make @@ -30,6 +30,7 @@ numfun.v lebesgue_integral.v hoelder.v probability.v +lebesgue_stieltjes_measure.v summability.v signed.v itv.v diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 825cfcef27..48d5ea8e20 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -2,11 +2,11 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat. -Require Import boolp reals ereal classical_sets signed topology numfun. -Require Import mathcomp_extra functions normedtype. From HB Require Import structures. -Require Import sequences esum measure fsbigop cardinality real_interval. -Require Import realfun. +From mathcomp.classical Require Import mathcomp_extra boolp classical_sets. +From mathcomp.classical Require Import functions fsbigop cardinality. +Require Import reals ereal signed topology numfun normedtype sequences esum. +Require Import real_interval measure realfun. (******************************************************************************) (* Lebesgue Stieltjes Measure *) @@ -82,11 +82,8 @@ move=> S21 S12 S1i; rewrite ler_oppl opprK le_sup// ?has_inf_supN//. exact/nonemptyN. Qed. -Definition EFinf {R : numDomainType} (f : R -> R) : \bar R -> \bar R := - fun x => if x is r%:E then (f r)%:E else x. - -Lemma nondecreasing_EFinf (R : realDomainType) (f : R -> R) : - {homo f : x y / (x <= y)%R} -> {homo EFinf f : x y / (x <= y)%E}. +Lemma nondecreasing_er_map (R : realDomainType) (f : R -> R) : + {homo f : x y / (x <= y)%R} -> {homo er_map f : x y / (x <= y)%E}. Proof. move=> ndf. by move=> [r| |] [l| |]//=; rewrite ?leey ?leNye// !lee_fin; exact: ndf. @@ -95,7 +92,7 @@ Qed. Section hlength. Local Open Scope ereal_scope. Variables (R : realType) (f : R -> R). -Let g : \bar R -> \bar R := EFinf f. +Let g : \bar R -> \bar R := er_map f. Implicit Types i j : interval R. Definition itvs : Type := R. @@ -179,7 +176,7 @@ Qed. Lemma hlength_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. -- by rewrite suber_ge0// => /ltW /(nondecreasing_EFinf ndf). +- by rewrite suber_ge0// => /ltW /(nondecreasing_er_map ndf). - by rewrite ltNge leey. - by case: (i.2 : \bar _) => //= [r _]; rewrite leey. Qed. @@ -504,7 +501,7 @@ Variables (d : measure_display) (R : realType) (f : cumulative R). Let m := [the measure _ _ of lebesgue_stieltjes_measure d f]. -Let g : \bar R -> \bar R := EFinf f. +Let g : \bar R -> \bar R := er_map f. Let lebesgue_stieltjes_measure_itvoc (a b : R) : (m `]a, b] = hlength f `]a, b])%classic. From 3d7835e106da56c0efcbc97f3789a22923e1dd59 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 26 May 2023 09:24:18 +0900 Subject: [PATCH 09/19] use Content_SubSigmaAdditive_isMeasure.Build --- theories/lebesgue_stieltjes_measure.v | 27 ++++++--------------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 48d5ea8e20..57c8a9d8fe 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -472,26 +472,12 @@ Qed. Let gitvs := [the measurableType _ of salgebraType ocitv]. -Definition lebesgue_stieltjes_measure (f : cumulative R) := - Hahn_ext [the content _ _ of hlength f : set ocitv_type -> _ ]. +HB.instance Definition _ (f : cumulative R) := Content_SubSigmaAdditive_isMeasure.Build _ _ _ + (hlength f : set ocitv_type -> _) (hlength_sigma_sub_additive f). -Let lebesgue_stieltjes_measure0 (f : cumulative R) : - lebesgue_stieltjes_measure f set0 = 0%E. -Proof. by []. Qed. - -Let lebesgue_stieltjes_measure_ge0 (f : cumulative R) : - forall x, (0 <= lebesgue_stieltjes_measure f x)%E. -Proof. exact: measure.Hahn_ext_ge0. Qed. - -Let lebesgue_stietjes_measure_semi_sigma_additive (f : cumulative R) : - semi_sigma_additive (lebesgue_stieltjes_measure f). -Proof. exact/measure.Hahn_ext_sigma_additive/hlength_sigma_sub_additive. Qed. - -HB.instance Definition _ (f : cumulative R) := isMeasure.Build _ _ _ - (lebesgue_stieltjes_measure f) - (lebesgue_stieltjes_measure0 f) - (lebesgue_stieltjes_measure_ge0 f) - (@lebesgue_stietjes_measure_semi_sigma_additive f). +Definition lebesgue_stieltjes_measure (f : cumulative R) := measure_extension + [the measure _ _ of hlength f : set ocitv_type -> _ ]. +HB.instance Definition _ (f : cumulative R) := Measure.on (lebesgue_stieltjes_measure f). End itv_semiRingOfSets. Arguments lebesgue_stieltjes_measure {R}. @@ -506,8 +492,7 @@ Let g : \bar R -> \bar R := er_map f. Let lebesgue_stieltjes_measure_itvoc (a b : R) : (m `]a, b] = hlength f `]a, b])%classic. Proof. -rewrite /m/= /lebesgue_stieltjes_measure /= /Hahn_ext measurable_mu_extE//. - exact: hlength_sigma_sub_additive. +rewrite /m/= /lebesgue_stieltjes_measure /= /measure_extension measurable_mu_extE//. by exists (a, b). Qed. From 41773f340be590c2db71dcb8e3e7dcd19a29c7dc Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 6 Jun 2023 17:21:04 +0900 Subject: [PATCH 10/19] rebase --- theories/probability.v | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/theories/probability.v b/theories/probability.v index aa7ca3d16c..4507d78bd8 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -4,8 +4,9 @@ From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. From mathcomp Require Import cardinality. From HB Require Import structures. -Require Import reals ereal signed topology normedtype sequences esum measure. -Require Import exp numfun lebesgue_measure lebesgue_integral. +From mathcomp.classical Require Import functions cardinality. +Require Import reals ereal signed topology normedtype sequences exp esum. +Require Import measure numfun lebesgue_measure lebesgue_integral. (******************************************************************************) (* Probability (experimental) *) From 4614f3c7287b5507dcbc0828f6489a85000bd44f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 12 Jun 2023 19:10:05 +0900 Subject: [PATCH 11/19] put lebesgue_measure proof in module --- theories/lebesgue_measure.v | 127 ++++--------- theories/lebesgue_stieltjes_measure.v | 261 ++++++++++++-------------- 2 files changed, 163 insertions(+), 225 deletions(-) diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 0e72a07c48..b5a6336b34 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -6,6 +6,7 @@ From mathcomp Require Import cardinality fsbigop. Require Import reals ereal signed topology numfun normedtype. From HB Require Import structures. Require Import sequences esum measure real_interval realfun exp. +Require Import lebesgue_stieltjes_measure. (******************************************************************************) (* Lebesgue Measure *) @@ -49,82 +50,16 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -Reserved Notation "R .-ocitv" (at level 1, format "R .-ocitv"). -Reserved Notation "R .-ocitv.-measurable" - (at level 2, format "R .-ocitv.-measurable"). - -Section itv_semiRingOfSets. -Variable R : realType. -Implicit Types (I J K : set R). -Definition ocitv_type : Type := R. - -Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. - -Lemma is_ocitv a b : ocitv `]a, b]%classic. -Proof. by exists (a, b); split => //=; rewrite in_itv/= andbT. Qed. -Hint Extern 0 (ocitv _) => solve [apply: is_ocitv] : core. - -Lemma ocitv0 : ocitv set0. -Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. -Hint Resolve ocitv0 : core. - -Lemma ocitvP X : ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. -Proof. -split=> [[x _ <-]|[->//|[x xlt ->]]]//. -case: (boolP (x.1 < x.2)) => x12; first by right; exists x. -by left; rewrite set_itv_ge. -Qed. - -Lemma ocitvD : semi_setD_closed ocitv. -Proof. -move=> _ _ [a _ <-] /ocitvP[|[b ltb]] ->. - rewrite setD0; exists [set `]a.1, a.2]%classic]. - by split=> [//|? ->//||? ? -> ->//]; rewrite bigcup_set1. -rewrite setDE setCitv/= setIUr -!set_itvI. -rewrite /Order.meet/= /Order.meet/= /Order.join/= - ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. -have inside : a.1 < c -> d < a.2 -> `]a.1, c] `&` `]d, a.2] = set0. - rewrite -subset0 lt_minr lt_maxl => /andP[a12 ab1] /andP[_ ba2] x /= []. - have b1a2 : b.1 <= a.2 by rewrite ltW// (lt_trans ltb). - have a1b2 : a.1 <= b.2 by rewrite ltW// (lt_trans _ ltb). - rewrite /c /d (min_idPr _)// (max_idPr _)// !in_itv /=. - move=> /andP[a1x xb1] /andP[b2x xa2]. - by have := lt_le_trans b2x xb1; case: ltgtP ltb. -exists ((if a.1 < c then [set `]a.1, c]%classic] else set0) `|` - (if d < a.2 then [set `]d, a.2]%classic] else set0)); split. -- by rewrite finite_setU; do! case: ifP. -- by move=> ? []; case: ifP => ? // ->//=. -- by rewrite bigcup_setU; congr (_ `|` _); - case: ifPn => ?; rewrite ?bigcup_set1 ?bigcup_set0// set_itv_ge. -- move=> I J/=; case: ifP => //= ac; case: ifP => //= da [] // -> []// ->. - by rewrite inside// => -[]. - by rewrite setIC inside// => -[]. -Qed. - -Lemma ocitvI : setI_closed ocitv. -Proof. -move=> _ _ [a _ <-] [b _ <-]; rewrite -set_itvI/=. -rewrite /Order.meet/= /Order.meet /Order.join/= - ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -by rewrite -negb_or le_total/=. -Qed. - -Definition ocitv_display : Type -> measure_display. Proof. exact. Qed. - -HB.instance Definition _ := - @isSemiRingOfSets.Build (ocitv_display R) - ocitv_type (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. - -Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. -Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type))) : - classical_set_scope. +(* direct construction of the Lebesgue measure *) +Module LebesgueMeasure. Section hlength. +Context {R : realType}. Local Open Scope ereal_scope. Implicit Types i j : interval R. -Definition hlength (A : set ocitv_type) : \bar R := let i := Rhull A in i.2 - i.1. +Definition hlength (A : set (ocitv_type R)) : \bar R := + let i := Rhull A in i.2 - i.1. Lemma hlength0 : hlength (set0 : set R) = 0. Proof. by rewrite /hlength Rhull0 /= subee. Qed. @@ -230,7 +165,7 @@ Lemma hlength_ge0 I : (0 <= hlength I)%E. Proof. by rewrite -hlength0 le_hlength. Qed. End hlength. -#[local] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. +#[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. (* Unused *) (* Lemma hlength_semi_additive2 : semi_additive2 hlength. *) @@ -263,6 +198,11 @@ End hlength. (* by rewrite lt_geF ?midf_lt//= andbF le_gtF ?midf_le//= ltW. *) (* Qed. *) +Section hlength_extension. +Context {R : realType}. + +Notation hlength := (@hlength R). + Lemma hlength_semi_additive : semi_additive hlength. Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. @@ -334,7 +274,7 @@ HB.instance Definition _ := isContent.Build _ _ R Hint Extern 0 ((_ .-ocitv).-measurable _) => solve [apply: is_ocitv] : core. Lemma hlength_sigma_sub_additive : - sigma_sub_additive (hlength : set ocitv_type -> _). + sigma_sub_additive (hlength : set (ocitv_type R) -> _). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. @@ -345,9 +285,9 @@ apply: le_trans (epsilon_trick _ _ _) => //=. have eVn_gt0 n : 0 < e%:num / 2 / (2 ^ n.+1)%:R. by rewrite divr_gt0// ltr0n// expn_gt0. have eVn_ge0 n := ltW (eVn_gt0 n). -pose Aoo i : set ocitv_type := +pose Aoo i : set (ocitv_type R) := `](b i).1, (b i).2 + e%:num / 2 / (2 ^ i.+1)%:R[%classic. -pose Aoc i : set ocitv_type := +pose Aoc i : set (ocitv_type R) := `](b i).1, (b i).2 + e%:num / 2 / (2 ^ i.+1)%:R]%classic. have: `[a.1 + e%:num / 2, a.2] `<=` \bigcup_i Aoo i. apply: (@subset_trans _ `]a.1, a.2]). @@ -362,7 +302,7 @@ have: `](a.1 + e%:num / 2), a.2] `<=` \bigcup_(i in [set` X]) Aoc i. move=> x /subset_itv_oc_cc /Xc [i /= Xi] Aooix. by exists i => //; apply: subset_itv_oo_oc Aooix. have /[apply] := @content_sub_fsum _ _ _ - [the content _ _ of hlength : set ocitv_type -> _] _ [set` X]. + [the content _ _ of hlength : set (ocitv_type R) -> _] _ [set` X]. move=> /(_ _ _ _)/Box[]//=; apply: le_le_trans. rewrite hlength_itv ?lte_fin -?EFinD/= -addrA -opprD. by case: ltP => //; rewrite lee_fin subr_le0. @@ -378,7 +318,7 @@ Qed. HB.instance Definition _ := Content_SubSigmaAdditive_isMeasure.Build _ _ _ hlength hlength_sigma_sub_additive. -Lemma hlength_sigma_finite : sigma_finite setT (hlength : set ocitv_type -> _). +Lemma hlength_sigma_finite : sigma_finite setT (hlength : set (ocitv_type R) -> _). Proof. exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic); first by rewrite bigcup_itvT. by move=> k; split => //; rewrite hlength_itv/= -EFinB; case: ifP; rewrite ltry. @@ -400,16 +340,20 @@ Arguments hlength {R}. #[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. Arguments lebesgue_measure {R}. -Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. -Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type R))) : - classical_set_scope. +End LebesgueMeasure. + +Definition lebesgue_measure {R : realType} : + set [the measurableType _.-sigma of + salgebraType R.-ocitv.-measurable] -> \bar R := + [the measure _ _ of lebesgue_stieltjes_measure [the cumulative _ of idfun]]. +HB.instance Definition _ (R : realType) := Measure.on (@lebesgue_measure R). Section lebesgue_measure. Variable R : realType. Let gitvs := [the measurableType _ of salgebraType (@ocitv R)]. Lemma lebesgue_measure_unique (mu : {measure set gitvs -> \bar R}) : - (forall X, ocitv X -> hlength X = mu X) -> + (forall X, ocitv X -> hlength [the cumulative _ of idfun] X = mu X) -> forall X, measurable X -> lebesgue_measure X = mu X. Proof. move=> muE X mX; apply: measure_extension_unique => //. @@ -861,10 +805,11 @@ Section lebesgue_measure_itv. Variable R : realType. Let lebesgue_measure_itvoc (a b : R) : - (lebesgue_measure (`]a, b] : set R) = hlength `]a, b])%classic. + (lebesgue_measure (`]a, b] : set R) = + hlength [the cumulative _ of idfun] `]a, b])%classic. Proof. -rewrite /lebesgue_measure/= /measure_extension measurable_mu_extE//. -by exists (a, b). +rewrite /lebesgue_measure/= /lebesgue_stieltjes_measure/= /measure_extension/=. +by rewrite measurable_mu_extE//; exact: is_ocitv. Qed. Let lebesgue_measure_itvoo_subr1 (a : R) : @@ -905,7 +850,8 @@ by rewrite in_itv/= => + xa; rewrite xa ltxx andbF. Qed. Let lebesgue_measure_itvoo (a b : R) : - (lebesgue_measure (`]a, b[ : set R) = hlength `]a, b[)%classic. + (lebesgue_measure (`]a, b[ : set R) = + hlength [the cumulative _ of idfun] `]a, b[)%classic. Proof. have [ab|ba] := ltP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoc a b. @@ -915,7 +861,8 @@ rewrite 2!hlength_itv => <-; rewrite -setUitv1// measureU//. Qed. Let lebesgue_measure_itvcc (a b : R) : - (lebesgue_measure (`[a, b] : set R) = hlength `[a, b])%classic. + (lebesgue_measure (`[a, b] : set R) = + hlength [the cumulative _ of idfun] `[a, b])%classic. Proof. have [ab|ba] := leP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoc a b. @@ -925,7 +872,8 @@ rewrite 2!hlength_itv => <-; rewrite -setU1itv// measureU//. Qed. Let lebesgue_measure_itvco (a b : R) : - (lebesgue_measure (`[a, b[ : set R) = hlength `[a, b[)%classic. + (lebesgue_measure (`[a, b[ : set R) = + hlength [the cumulative _ of idfun] `[a, b[)%classic. Proof. have [ab|ba] := ltP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoo a b. @@ -936,7 +884,7 @@ Qed. Let lebesgue_measure_itv_bnd (x y : bool) (a b : R) : lebesgue_measure ([set` Interval (BSide x a) (BSide y b)] : set R) = - hlength [set` Interval (BSide x a) (BSide y b)]. + hlength [the cumulative _ of idfun] [set` Interval (BSide x a) (BSide y b)]. Proof. by move: x y => [|] [|]; [exact: lebesgue_measure_itvco | exact: lebesgue_measure_itvcc | exact: lebesgue_measure_itvoo | @@ -980,7 +928,8 @@ by rewrite subee// add0e. Qed. Lemma lebesgue_measure_itv (i : interval R) : - lebesgue_measure ([set` i] : set R) = hlength [set` i]. + lebesgue_measure ([set` i] : set R) = + hlength [the cumulative _ of idfun] [set` i]. Proof. move: i => [[x a|[|]]] [y b|[|]]; first exact: lebesgue_measure_itv_bnd. - by rewrite set_itvE ?measure0. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 57c8a9d8fe..827e760fd6 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -25,6 +25,79 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +Reserved Notation "R .-ocitv" (at level 1, format "R .-ocitv"). +Reserved Notation "R .-ocitv.-measurable" + (at level 2, format "R .-ocitv.-measurable"). + +Section itv_semiRingOfSets. +Variable R : realType. +Implicit Types (I J K : set R). +Definition ocitv_type : Type := R. + +Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. + +Lemma is_ocitv a b : ocitv `]a, b]%classic. +Proof. by exists (a, b); split => //=; rewrite in_itv/= andbT. Qed. +Hint Extern 0 (ocitv _) => solve [apply: is_ocitv] : core. + +Lemma ocitv0 : ocitv set0. +Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. +Hint Resolve ocitv0 : core. + +Lemma ocitvP X : ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. +Proof. +split=> [[x _ <-]|[->//|[x xlt ->]]]//. +case: (boolP (x.1 < x.2)) => x12; first by right; exists x. +by left; rewrite set_itv_ge. +Qed. + +Lemma ocitvD : semi_setD_closed ocitv. +Proof. +move=> _ _ [a _ <-] /ocitvP[|[b ltb]] ->. + rewrite setD0; exists [set `]a.1, a.2]%classic]. + by split=> [//|? ->//||? ? -> ->//]; rewrite bigcup_set1. +rewrite setDE setCitv/= setIUr -!set_itvI. +rewrite /Order.meet/= /Order.meet/= /Order.join/= + ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. +have inside : a.1 < c -> d < a.2 -> `]a.1, c] `&` `]d, a.2] = set0. + rewrite -subset0 lt_minr lt_maxl => /andP[a12 ab1] /andP[_ ba2] x /= []. + have b1a2 : b.1 <= a.2 by rewrite ltW// (lt_trans ltb). + have a1b2 : a.1 <= b.2 by rewrite ltW// (lt_trans _ ltb). + rewrite /c /d (min_idPr _)// (max_idPr _)// !in_itv /=. + move=> /andP[a1x xb1] /andP[b2x xa2]. + by have := lt_le_trans b2x xb1; case: ltgtP ltb. +exists ((if a.1 < c then [set `]a.1, c]%classic] else set0) `|` + (if d < a.2 then [set `]d, a.2]%classic] else set0)); split. +- by rewrite finite_setU; do! case: ifP. +- by move=> ? []; case: ifP => ? // ->//=. +- by rewrite bigcup_setU; congr (_ `|` _); + case: ifPn => ?; rewrite ?bigcup_set1 ?bigcup_set0// set_itv_ge. +- move=> I J/=; case: ifP => //= ac; case: ifP => //= da [] // -> []// ->. + by rewrite inside// => -[]. + by rewrite setIC inside// => -[]. +Qed. + +Lemma ocitvI : setI_closed ocitv. +Proof. +move=> _ _ [a _ <-] [b _ <-]; rewrite -set_itvI/=. +rewrite /Order.meet/= /Order.meet /Order.join/= + ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +by rewrite -negb_or le_total/=. +Qed. + +Definition ocitv_display : Type -> measure_display. Proof. exact. Qed. + +HB.instance Definition _ := + @isSemiRingOfSets.Build (ocitv_display R) + ocitv_type (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. + +End itv_semiRingOfSets. + +Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. +Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type R))) : + classical_set_scope. + (* TODO: move *) Notation right_continuous f := (forall x, f%function @ at_right x --> f%function x). @@ -90,14 +163,15 @@ by move=> [r| |] [l| |]//=; rewrite ?leey ?leNye// !lee_fin; exact: ndf. Qed. Section hlength. +Context {R : realType}. +Variable (f : R -> R). Local Open Scope ereal_scope. -Variables (R : realType) (f : R -> R). -Let g : \bar R -> \bar R := er_map f. - Implicit Types i j : interval R. -Definition itvs : Type := R. -Definition hlength (A : set itvs) : \bar R := let i := Rhull A in g i.2 - g i.1. +Let g : \bar R -> \bar R := er_map f. + +Definition hlength (A : set (ocitv_type R)) : \bar R := + let i := Rhull A in g i.2 - g i.1. Lemma hlength0 : hlength (set0 : set R) = 0. Proof. by rewrite /hlength Rhull0 /= subee. Qed. @@ -108,6 +182,9 @@ rewrite /hlength /= asboolT// sup_itvcc//= asboolT//. by rewrite asboolT inf_itvcc//= ?subee// inE. Qed. +Lemma hlength_setT : hlength setT = +oo%E :> \bar R. +Proof. by rewrite /hlength RhullT. Qed. + Lemma hlength_itv i : hlength [set` i] = if i.2 > i.1 then g i.2 - g i.1 else 0. Proof. case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /hlength set_itvK. @@ -122,9 +199,6 @@ case: i => -[ba a|[|]] [bb b|[|]] //=. - by move=> _; rewrite set_itvE hlength0. Qed. -Lemma hlength_setT : hlength setT = +oo%E :> \bar R. -Proof. by rewrite /hlength RhullT. Qed. - Lemma hlength_finite_fin_num i : neitv i -> hlength [set` i] < +oo -> ((i.1 : \bar R) \is a fin_num) /\ ((i.2 : \bar R) \is a fin_num). Proof. @@ -173,14 +247,14 @@ rewrite hlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. - by right. Qed. -Lemma hlength_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : 0 <= hlength [set` i]. +Lemma hlength_itv_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : + 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. - by rewrite suber_ge0// => /ltW /(nondecreasing_er_map ndf). - by rewrite ltNge leey. - by case: (i.2 : \bar _) => //= [r _]; rewrite leey. Qed. -Local Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. Lemma hlength_Rhull (A : set R) : hlength [set` Rhull A] = hlength A. Proof. by rewrite /hlength Rhull_involutive. Qed. @@ -189,7 +263,7 @@ Lemma le_hlength_itv (ndf : {homo f : x y / (x <= y)%R}) i j : {subset i <= j} -> hlength [set` i] <= hlength [set` j]. Proof. set I := [set` i]; set J := [set` j]. -have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_ge0. +have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_itv_ge0. have [J0|/set0P J0] := eqVneq J set0. by move/subset_itvP; rewrite -/J J0 subset0 -/I => ->. move=> /subset_itvP ij; apply: lee_sub => /=. @@ -215,76 +289,11 @@ by rewrite (hlength_Rhull a) (hlength_Rhull b). Qed. End hlength. -Arguments hlength {R}. -#[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. -Section itv_semiRingOfSets. -Variable R : realType. -Implicit Types (I J K : set R). -Definition ocitv_type : Type := R. +Section hlength_extension. +Context {R : realType}. -Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. - -Lemma is_ocitv a b : ocitv `]a, b]%classic. -Proof. by exists (a, b); split => //=; rewrite in_itv/= andbT. Qed. -Hint Extern 0 (ocitv _) => solve [apply: is_ocitv] : core. - -Lemma ocitv0 : ocitv set0. -Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. -Hint Resolve ocitv0 : core. - -Lemma ocitvP X : - ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. -Proof. -split=> [[x _ <-]|[->//|[x xlt ->]]]//. -case: (boolP (x.1 < x.2)) => x12; first by right; exists x. -by left; rewrite set_itv_ge. -Qed. - -Lemma ocitvD : semi_setD_closed ocitv. -Proof. -move=> _ _ [a _ <-] /ocitvP[|[b ltb]] ->. - rewrite setD0; exists [set `]a.1, a.2]%classic]. - by split=> [//|? ->//||? ? -> ->//]; rewrite bigcup_set1. -rewrite setDE setCitv/= setIUr -!set_itvI. -rewrite /Order.meet/= /Order.meet/= /Order.join/= - ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. -have inside : a.1 < c -> d < a.2 -> `]a.1, c] `&` `]d, a.2] = set0. - rewrite -subset0 lt_minr lt_maxl => /andP[a12 ab1] /andP[_ ba2] x /= []. - have b1a2 : b.1 <= a.2 by rewrite ltW// (lt_trans ltb). - have a1b2 : a.1 <= b.2 by rewrite ltW// (lt_trans _ ltb). - rewrite /c /d (min_idPr _)// (max_idPr _)// !in_itv /=. - move=> /andP[a1x xb1] /andP[b2x xa2]. - by have := lt_le_trans b2x xb1; case: ltgtP ltb. -exists ((if a.1 < c then [set `]a.1, c]%classic] else set0) `|` - (if d < a.2 then [set `]d, a.2]%classic] else set0)); split. -- by rewrite finite_setU; do! case: ifP. -- by move=> ? []; case: ifP => ? // ->//=. -- by rewrite bigcup_setU; congr (_ `|` _); - case: ifPn => ?; rewrite ?bigcup_set1 ?bigcup_set0// set_itv_ge. -- move=> I J/=; case: ifP => //= ac; case: ifP => //= da [] // -> []// ->. - by rewrite inside// => -[]. - by rewrite setIC inside// => -[]. -Qed. - -Lemma ocitvI : setI_closed ocitv. -Proof. -move=> _ _ [a _ <-] [b _ <-]; rewrite -set_itvI/=. -rewrite /Order.meet/= /Order.meet /Order.join/= - ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -by rewrite -negb_or le_total/=. -Qed. - -Variable d : measure_display. - -HB.instance Definition _ := @isSemiRingOfSets.Build d ocitv_type - (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. - -Definition itvs_semiRingOfSets := [the semiRingOfSetsType d of ocitv_type]. - -Lemma hlength_semi_additive (f : R -> R) : - semi_additive (hlength f : set ocitv_type -> _). +Lemma hlength_semi_additive (f : R -> R) : semi_additive (hlength f). Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. @@ -349,36 +358,24 @@ apply/andP; split=> //; apply: contraTneq xbj => ->. by rewrite in_itv/= le_gtF// (itvP xabi). Qed. -Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. - -Lemma hlength_sigma_finite (f : R -> R) : - sigma_finite [set: ocitv_type] (hlength f). -Proof. -exists (fun k => `](- k%:R), k%:R]%classic). - apply/esym; rewrite -subTset => /= x _ /=. - exists `|(floor `|x|%R + 1)%R|%N; rewrite //= in_itv/=. - rewrite !natr_absz intr_norm intrD -RfloorE. - suff: `|x| < `|Rfloor `|x| + 1| by rewrite ltr_norml => /andP[-> /ltW->]. - rewrite [ltRHS]ger0_norm//. - by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. - by rewrite addr_ge0// -Rfloor0 le_Rfloor. -move=> k; split => //; rewrite hlength_itv /= -EFinB. -by case: ifP; rewrite ltey. -Qed. - -Lemma hlength_ge0' (f : cumulative R) (I : set ocitv_type) : +Lemma hlength_ge0 (f : cumulative R) (I : set (ocitv_type R)) : (0 <= hlength f I)%E. Proof. by rewrite -(hlength0 f) le_hlength//; exact: cumulative_is_nondecreasing. Qed. +#[local] Hint Extern 0 (0%:E <= hlength _ _) => solve[apply: hlength_ge0] : core. + HB.instance Definition _ (f : cumulative R) := - isContent.Build _ _ R (hlength f : set ocitv_type -> _) - (hlength_ge0' f) (hlength_semi_additive f). + isContent.Build _ _ R (hlength f) + (hlength_ge0 f) + (hlength_semi_additive f). + +Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. Lemma hlength_content_sub_fsum (f : cumulative R) (D : {fset nat}) a0 b0 (a b : nat -> R) : (forall i, i \in D -> a i <= b i) -> - `]a0, b0] `<=` \big[setU/set0]_(i <- D) `] a i, b i]%classic -> + `]a0, b0] `<=` \big[setU/set0]_(i <- D) `]a i, b i]%classic -> f b0 - f a0 <= \sum_(i <- D) (f (b i) - f (a i)). Proof. move=> Dab h; have [ab|ab] := leP a0 b0; last first. @@ -386,11 +383,9 @@ move=> Dab h; have [ab|ab] := leP a0 b0; last first. by rewrite subr_le0 cumulative_is_nondecreasing// ltW. rewrite big_seq sumr_ge0// => i iD. by rewrite subr_ge0 cumulative_is_nondecreasing// Dab. -have mab k : - [set` D] k -> @measurable d itvs_semiRingOfSets `]a k, b k]%classic by []. +have mab k : [set` D] k -> R.-ocitv.-measurable `]a k, b k]%classic by []. move: h; rewrite -bigcup_fset. -move/(@content_sub_fsum d R _ - [the content _ _ of hlength f : set ocitv_type -> _] _ [set` D] +move/(@content_sub_fsum _ R _ [the content _ _ of hlength f] _ [set` D] `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) (finite_fset D) mab (is_ocitv _ _)) => /=. rewrite hlength_itv_bnd// -lee_fin => /le_trans; apply. @@ -399,13 +394,11 @@ by apply: lee_sum => i iD; rewrite hlength_itv_bnd// Dab. Qed. Lemma hlength_sigma_sub_additive (f : cumulative R) : - sigma_sub_additive (hlength f : set ocitv_type -> _). + sigma_sub_additive (hlength f). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. -case: ifPn => a12; last first. - rewrite nneseries_esum; last by move=> ? _; exact: hlength_ge0'. - by rewrite esum_ge0// => ? _; exact: hlength_ge0'. +case: ifPn => a12; last by rewrite nneseries_esum ?esum_ge0. wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. move=> /= h. set A' := fun n => if (b n).1 >= (b n).2 then set0 else A n. @@ -414,7 +407,7 @@ wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. apply: (@eq_eseriesr _ (hlength f \o A) (hlength f \o A')) => k. rewrite /= /A' AE; case: ifPn => // bn. by rewrite set_itv_ge//= bnd_simp -leNgt. - apply (h b'). + apply: (h b'). - move=> k; rewrite /A'; case: ifPn => // bk. by rewrite set_itv_ge//= bnd_simp -leNgt /b' bk. - by rewrite AE /b' (negbTE bk). @@ -442,10 +435,11 @@ have acbd : `[ a.1 + c%:num / 2, a.2] `<=` move: Anr; rewrite AE /= !in_itv/= => /andP [->]/= /le_lt_trans. by apply; rewrite ltr_addl. have := @segment_compact _ (a.1 + c%:num / 2) a.2; rewrite compact_cover. -have obd k : [set: nat] k-> open `](b k).1, ((b k).2 + (D k)%:num)[%classic. +have obd k : [set: nat] k -> open `](b k).1, ((b k).2 + (D k)%:num)[%classic. by move=> _; exact: interval_open. move=> /(_ _ _ _ obd acbd){obd acbd}. case=> X _ acXbd. +rewrite /cover in acXbd. rewrite -EFinD. apply: (@le_trans _ _ (\sum_(i <- X) (hlength f `](b i).1, (b i).2]%classic) + \sum_(i <- X) (f ((b i).2 + (D i)%:num)%R - f (b i).2)%:E)%E). @@ -470,34 +464,29 @@ rewrite big_seq [in X in (_ <= X)%E]big_seq; apply: lee_sum => k kX. by rewrite AE lee_add2l// lee_fin ler_subl_addl natrX De. Qed. -Let gitvs := [the measurableType _ of salgebraType ocitv]. - -HB.instance Definition _ (f : cumulative R) := Content_SubSigmaAdditive_isMeasure.Build _ _ _ - (hlength f : set ocitv_type -> _) (hlength_sigma_sub_additive f). - -Definition lebesgue_stieltjes_measure (f : cumulative R) := measure_extension - [the measure _ _ of hlength f : set ocitv_type -> _ ]. -HB.instance Definition _ (f : cumulative R) := Measure.on (lebesgue_stieltjes_measure f). - -End itv_semiRingOfSets. -Arguments lebesgue_stieltjes_measure {R}. - -Section lebesgue_stieltjes_measure_itv. -Variables (d : measure_display) (R : realType) (f : cumulative R). - -Let m := [the measure _ _ of lebesgue_stieltjes_measure d f]. - -Let g : \bar R -> \bar R := er_map f. +HB.instance Definition _ (f : cumulative R) := + Content_SubSigmaAdditive_isMeasure.Build _ _ _ + (hlength f) (hlength_sigma_sub_additive f). -Let lebesgue_stieltjes_measure_itvoc (a b : R) : - (m `]a, b] = hlength f `]a, b])%classic. +Lemma hlength_sigma_finite (f : R -> R) : + sigma_finite [set: (ocitv_type R)] (hlength f). Proof. -rewrite /m/= /lebesgue_stieltjes_measure /= /measure_extension measurable_mu_extE//. -by exists (a, b). +exists (fun k => `](- k%:R), k%:R]%classic). + apply/esym; rewrite -subTset => /= x _ /=. + exists `|(floor `|x|%R + 1)%R|%N; rewrite //= in_itv/=. + rewrite !natr_absz intr_norm intrD -RfloorE. + suff: `|x| < `|Rfloor `|x| + 1| by rewrite ltr_norml => /andP[-> /ltW->]. + rewrite [ltRHS]ger0_norm//. + by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. + by rewrite addr_ge0// -Rfloor0 le_Rfloor. +move=> k; split => //; rewrite hlength_itv /= -EFinB. +by case: ifP; rewrite ltey. Qed. -End lebesgue_stieltjes_measure_itv. +Definition lebesgue_stieltjes_measure (f : cumulative R) := + measure_extension [the measure _ _ of hlength f]. +HB.instance Definition _ (f : cumulative R) := + Measure.on (lebesgue_stieltjes_measure f). -Example lebesgue_measure d (R : realType) - : {measure set [the measurableType (d.-measurable).-sigma of salgebraType (d.-measurable)] -> \bar R} := - [the measure _ _ of lebesgue_stieltjes_measure _ [the cumulative _ of @idfun R]]. +End hlength_extension. +Arguments lebesgue_stieltjes_measure {R}. From 886ee65088a36c25ab44c2fae577e6b18837d321 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 21 Jun 2023 16:54:00 +0900 Subject: [PATCH 12/19] changelog, doc, minor fixes --- CHANGELOG_UNRELEASED.md | 38 +++++++ theories/constructive_ereal.v | 7 ++ theories/ereal.v | 2 +- theories/lebesgue_integral.v | 4 +- theories/lebesgue_measure.v | 21 ++-- theories/lebesgue_stieltjes_measure.v | 146 ++++++++++++++------------ theories/reals.v | 72 +++++++------ 7 files changed, 175 insertions(+), 115 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index a487b863aa..1200cb1bb6 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -29,6 +29,44 @@ - in `charge.v` + `isCharge` -> `isSemiSigmaAdditive` +- in `reals.v`: + + lemma `le_inf` +- in `constructive_ereal.v`: + + lemma `le_er_map` +- new `lebesgue_stieltjes_measure.v`: + + notation `right_continuous` + + lemmas `right_continuousW`, `nondecreasing_right_continuousP` + + mixin `isCumulative`, structure `Cumulative`, notation `cumulative` + + `idfun` instance of `Cumulative` + + `hlength`, `hlength0`, `hlength_singleton`, `hlength_setT`, `hlength_itv`, + `hlength_finite_fin_num`, `finite_hlengthE`, `hlength_itv_bnd`, `hlength_infty_bnd`, + `hlength_bnd_infty`, `pinfty_hlength`, `hlength_itv_ge0`, `hlength_Rhull`, + `le_hlength_itv`, `le_hlength`, `hlength_semi_additive`, `hlength_ge0` + + content instance of `hlength` + + `hlength_content_sub_fsum`, + `hlength_sigma_sub_additive`, `hlength_sigma_finite` + + measure instance of `hlength` + + definition `lebesgue_stieltjes_measure` + +### Changed + +- in `lebesgue_measure.v`: + + are now prefixed with `LebesgueMeasure`: + * `hlength`, `hlength0`, `hlength_singleton`, `hlength_setT`, `hlength_itv`, + `hlength_finite_fin_num`, `finite_hlengthE`, `hlength_infty_bnd`, + `hlength_bnd_infty`, `pinfty_hlength`, `hlength_itv_ge0`, `hlength_Rhull`, + `le_hlength_itv`, `le_hlength`, `hlength_ge0`, `hlength_semi_additive`, + `hlength_sigma_sub_additive`, `hlength_sigma_finite` + + `lebesgue_measure` now defined with `lebesgue_stieltjes_measure` +- moved from `lebesgue_measure.v` to `lebesgue_stieltjes_measure.v` + + notations `_.-ocitv`, `_.-ocitv.-measurable` + + definitions `ocitv`, `ocitv_display` + + lemmas `is_ocitv`, `ocitv0`, `ocitvP`, `ocitvD`, `ocitvI` + +### Renamed + +- in `ereal.v`: + + `le_er_map` -> `le_er_map_in` ### Generalized diff --git a/theories/constructive_ereal.v b/theories/constructive_ereal.v index 9f099adac0..15e7e38775 100644 --- a/theories/constructive_ereal.v +++ b/theories/constructive_ereal.v @@ -356,6 +356,13 @@ Definition lteey := (ltey, leey). Definition lteNye := (ltNye, leNye). +Lemma le_er_map (f : R -> R) : {homo f : x y / (x <= y)%R} -> + {homo er_map f : x y / x <= y}. +Proof. +move=> ndf. +by move=> [r| |] [l| |]//=; rewrite ?leey ?leNye// !lee_fin; exact: ndf. +Qed. + Lemma le_total_ereal : totalPOrderMixin [porderType of \bar R]. Proof. by move=> [?||][?||]//=; rewrite (ltEereal, leEereal)/= ?num_real ?le_total. diff --git a/theories/ereal.v b/theories/ereal.v index de97ccc88d..a249452e7d 100644 --- a/theories/ereal.v +++ b/theories/ereal.v @@ -162,7 +162,7 @@ Section ERealArithTh_realDomainType. Context {R : realDomainType}. Implicit Types (x y z u a b : \bar R) (r : R). -Lemma le_er_map (A : set R) (f : R -> R) : +Lemma le_er_map_in (A : set R) (f : R -> R) : {in A &, {homo f : x y / (x <= y)%O}} -> {in (EFin @` A)%classic &, {homo er_map f : x y / (x <= y)%E}}. Proof. diff --git a/theories/lebesgue_integral.v b/theories/lebesgue_integral.v index 57107fe01d..d22965795c 100644 --- a/theories/lebesgue_integral.v +++ b/theories/lebesgue_integral.v @@ -4869,7 +4869,7 @@ move=> /[dup]/compact_measurable => mA /compact_bounded[N [_ N1x]]. have AN1 : (A `<=` `[- (`|N| + 1), `|N| + 1])%R. by move=> z Az; rewrite set_itvcc /= -ler_norml N1x// ltr_spaddr// ler_norm. rewrite (le_lt_trans (le_measure _ _ _ AN1)) ?inE//=. -by rewrite lebesgue_measure_itv hlength_itv/= lte_fin gtr_opp// EFinD ltry. +by rewrite lebesgue_measure_itv/= lebesgue_stieltjes_measure.hlength_itv/= lte_fin gtr_opp// EFinD ltry. Qed. Lemma continuous_compact_integrable (f : R -> R^o) (A : set R^o) : @@ -5571,7 +5571,7 @@ have ball_itv2 r : 0 < r -> ball x r = `[x - r, x + r] `\` [set x + r; x - r]. rewrite -ball_itvr // setDD setIC; apply/esym/setIidPl. by rewrite ballE set_itvcc => ?/=; rewrite in_itv => /andP [/ltW -> /ltW ->]. have ritv r : 0 < r -> mu `[x - r, x + r]%classic = (r *+ 2)%:E. - move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv hlength_itv /= lte_fin. + move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv lebesgue_stieltjes_measure.hlength_itv /= lte_fin. rewrite ler_lt_add // ?rE // -EFinD; congr (_ _). by rewrite opprB addrAC [_ - _]addrC addrA subrr add0r. move=> oA intf ctsfx Ax. diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index b5a6336b34..55bf784290 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -12,18 +12,14 @@ Require Import lebesgue_stieltjes_measure. (* Lebesgue Measure *) (* *) (* This file contains a formalization of the Lebesgue measure using the *) -(* Caratheodory's theorem available in measure.v and further develops the *) -(* theory of measurable functions. *) +(* Measure Extension theorem from measure.v and further develops the theory *) +(* of measurable functions. *) (* *) (* Main reference: *) (* - Daniel Li, Intégration et applications, 2016 *) (* - Achim Klenke, Probability Theory 2nd edition, 2014 *) (* *) -(* hlength A == length of the hull of the set of real numbers A *) -(* ocitv == set of open-closed intervals ]x, y] where *) -(* x and y are real numbers *) (* lebesgue_measure == the Lebesgue measure *) -(* *) (* ps_infty == inductive definition of the powerset *) (* {0, {-oo}, {+oo}, {-oo,+oo}} *) (* emeasurable G == sigma-algebra over \bar R built out of the *) @@ -50,9 +46,10 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -(* direct construction of the Lebesgue measure *) +(* This module contains a direct construction of the Lebesgue measure this is + kept here for archival purpose. The Lebesgue measure is actually defined as + an instance of the Lebesgue-Stieltjes measure. *) Module LebesgueMeasure. - Section hlength. Context {R : realType}. Local Open Scope ereal_scope. @@ -335,7 +332,7 @@ Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. HB.instance Definition _ := @isSigmaFinite.Build _ _ _ lebesgue_measure sigmaT_finite_lebesgue_measure. -End itv_semiRingOfSets. +End hlength_extension. Arguments hlength {R}. #[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. Arguments lebesgue_measure {R}. @@ -845,7 +842,7 @@ suff : (lebesgue_measure (`]a - 1, a]%classic%R : set R) = rewrite [in X in X == _]/= EFinN EFinB fin_num_oppeB// addeA subee// add0e. by rewrite addeC -sube_eq ?fin_num_adde_defl// subee// => /eqP. rewrite -setUitv1// ?bnd_simp; last by rewrite ltr_subl_addr ltr_addl. -rewrite measureU //; apply/seteqP; split => // x []/=. +rewrite measureU //; apply/seteqP; split => // x []/=. by rewrite in_itv/= => + xa; rewrite xa ltxx andbF. Qed. @@ -2056,7 +2053,7 @@ Lemma lebesgue_regularity_inner_sup (D : set R) (eps : R) : measurable D -> Proof. move=> mD; have [?|] := ltP (mu D) +oo. exact: lebesgue_regularity_innerE_bounded. -have /sigma_finiteP [/= F RFU [Fsub ffin]] := sigmaT_finite_lebesgue_measure R (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *). +have /sigma_finiteP [F RFU [Fsub ffin]] := sigma_finiteT mu (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *). rewrite leye_eq => /eqP /[dup] + ->. have {1}-> : D = \bigcup_n (F n `&` D) by rewrite -setI_bigcupl -RFU setTI. move=> FDp; apply/esym/eq_infty => M. @@ -2069,7 +2066,7 @@ move/cvgey_ge => /(_ (M + 1)%R) [N _ /(_ _ (lexx N))]. have [mFN FNoo] := ffin N. have [] := @lebesgue_regularity_inner (F N `&` D) _ _ _ ltr01. - exact: measurableI. -- by rewrite (le_lt_trans _ (ffin N).2)// measureIl. +- by rewrite (le_lt_trans _ (ffin N).2)//= measureIl. move=> V [/[dup] /compact_measurable mV cptV VFND] FDV1 M1FD. rewrite (@le_trans _ _ (mu V))//; last first. apply: ereal_sup_ub; exists V => //=; split => //. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 827e760fd6..6c57e158f0 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -12,7 +12,25 @@ Require Import real_interval measure realfun. (* Lebesgue Stieltjes Measure *) (* *) (* This file contains a formalization of the Lebesgue-Stieltjes measure using *) -(* the Extension theorem available in measure.v. *) +(* the Measure Extension theorem from measure.v. *) +(* *) +(* Reference: *) +(* - Achim Klenke, Probability Theory 2nd edition, 2014 *) +(* *) +(* right_continuous f == the function f is right-continuous *) +(* cumulative R == type of non-decreasing, right-continuous *) +(* functions (with R : numFieldType) *) +(* The HB class is Cumulative. *) +(* instance: idfun *) +(* ocitv_type R == alias for R : realType *) +(* ocitv == set of open-closed intervals ]x, y] where *) +(* x and y are real numbers *) +(* R.-ocitv == display for ocitv_type R *) +(* R.-ocitv.-measurable == semiring of sets of open-closed intervals *) +(* hlength f A := f b - f a with the hull of the set of real *) +(* numbers A being delimited by a and b *) +(* lebesgue_stieltjes_measure f == Lebesgue-Stieltjes measure for f *) +(* f is a cumulative function. *) (* *) (******************************************************************************) @@ -29,6 +47,55 @@ Reserved Notation "R .-ocitv" (at level 1, format "R .-ocitv"). Reserved Notation "R .-ocitv.-measurable" (at level 2, format "R .-ocitv.-measurable"). +(* TODO: move? *) +Notation right_continuous f := + (forall x, f%function @ at_right x --> f%function x). + +Lemma right_continuousW (R : numFieldType) (f : R -> R) : + continuous f -> right_continuous f. +Proof. by move=> cf x; apply: cvg_within_filter; exact/cf. Qed. + +HB.mixin Record isCumulative (R : numFieldType) (f : R -> R) := { + cumulative_is_nondecreasing : {homo f : x y / x <= y} ; + cumulative_is_right_continuous : right_continuous f }. + +#[short(type=cumulative)] +HB.structure Definition Cumulative (R : numFieldType) := + { f of isCumulative R f }. + +Arguments cumulative_is_nondecreasing {R} _. +Arguments cumulative_is_right_continuous {R} _. + +Lemma nondecreasing_right_continuousP (R : numFieldType) (a : R) (e : R) + (f : cumulative R) : + e > 0 -> exists d : {posnum R}, f (a + d%:num) <= f a + e. +Proof. +move=> e0; move: (cumulative_is_right_continuous f). +move=> /(_ a)/(@cvgr_dist_lt _ [normedModType R of R^o]). +move=> /(_ _ e0)[] _ /posnumP[d] => h. +exists (PosNum [gt0 of (d%:num / 2)]) => //=. +move: h => /(_ (a + d%:num / 2)) /=. +rewrite opprD addrA subrr distrC subr0 ger0_norm //. +rewrite ltr_pdivr_mulr// ltr_pmulr// ltr1n => /(_ erefl). +rewrite ltr_addl divr_gt0// => /(_ erefl). +rewrite ler0_norm; last first. + by rewrite subr_le0 (cumulative_is_nondecreasing f)// ler_addl. +by rewrite opprB ltr_subl_addl => fa; exact: ltW. +Qed. + +Section id_is_cumulative. +Variable R : realType. + +Let id_nd : {homo @idfun R : x y / x <= y}. +Proof. by []. Qed. + +Let id_rc : right_continuous (@idfun R). +Proof. by apply/right_continuousW => x; exact: cvg_id. Qed. + +HB.instance Definition _ := isCumulative.Build R idfun id_nd id_rc. +End id_is_cumulative. +(* /TODO: move? *) + Section itv_semiRingOfSets. Variable R : realType. Implicit Types (I J K : set R). @@ -98,70 +165,6 @@ Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type R))) : classical_set_scope. -(* TODO: move *) -Notation right_continuous f := - (forall x, f%function @ at_right x --> f%function x). - -Lemma right_continuousW (R : numFieldType) (f : R -> R) : - continuous f -> right_continuous f. -Proof. by move=> cf x; apply: cvg_within_filter; exact/cf. Qed. - -HB.mixin Record isCumulative (R : numFieldType) (f : R -> R) := { - cumulative_is_nondecreasing : {homo f : x y / x <= y} ; - cumulative_is_right_continuous : right_continuous f }. - -#[short(type=cumulative)] -HB.structure Definition Cumulative (R : numFieldType) := - { f of isCumulative R f }. - -Arguments cumulative_is_nondecreasing {R} _. -Arguments cumulative_is_right_continuous {R} _. - -Lemma nondecreasing_right_continuousP (R : numFieldType) (a : R) (e : R) - (f : cumulative R) : - e > 0 -> exists d : {posnum R}, f (a + d%:num) <= f a + e. -Proof. -move=> e0; move: (cumulative_is_right_continuous f). -move=> /(_ a)/(@cvgr_dist_lt _ [normedModType R of R^o]). -move=> /(_ _ e0)[] _ /posnumP[d] => h. -exists (PosNum [gt0 of (d%:num / 2)]) => //=. -move: h => /(_ (a + d%:num / 2)) /=. -rewrite opprD addrA subrr distrC subr0 ger0_norm //. -rewrite ltr_pdivr_mulr// ltr_pmulr// ltr1n => /(_ erefl). -rewrite ltr_addl divr_gt0// => /(_ erefl). -rewrite ler0_norm; last first. - by rewrite subr_le0 (cumulative_is_nondecreasing f)// ler_addl. -by rewrite opprB ltr_subl_addl => fa; exact: ltW. -Qed. - -Section id_is_cumulative. -Variable R : realType. - -Let id_nd : {homo @idfun R : x y / x <= y}. -Proof. by []. Qed. - -Let id_rc : right_continuous (@idfun R). -Proof. by apply/right_continuousW => x; exact: cvg_id. Qed. - -HB.instance Definition _ := isCumulative.Build R idfun id_nd id_rc. -End id_is_cumulative. - -(* TODO: move and use in lebesgue_measure.v? *) -Lemma le_inf (R : realType) (S1 S2 : set R) : - -%R @` S2 `<=` down (-%R @` S1) -> nonempty S2 -> has_inf S1 - -> (inf S1 <= inf S2)%R. -Proof. -move=> S21 S12 S1i; rewrite ler_oppl opprK le_sup// ?has_inf_supN//. -exact/nonemptyN. -Qed. - -Lemma nondecreasing_er_map (R : realDomainType) (f : R -> R) : - {homo f : x y / (x <= y)%R} -> {homo er_map f : x y / (x <= y)%E}. -Proof. -move=> ndf. -by move=> [r| |] [l| |]//=; rewrite ?leey ?leNye// !lee_fin; exact: ndf. -Qed. - Section hlength. Context {R : realType}. Variable (f : R -> R). @@ -251,7 +254,7 @@ Lemma hlength_itv_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. -- by rewrite suber_ge0// => /ltW /(nondecreasing_er_map ndf). +- by rewrite suber_ge0// => /ltW /(le_er_map ndf). - by rewrite ltNge leey. - by case: (i.2 : \bar _) => //= [r _]; rewrite leey. Qed. @@ -415,7 +418,7 @@ wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. rewrite /A' AE; case: ifPn => bk //. by rewrite subset0 set_itv_ge//= bnd_simp -leNgt. - by move=> k; rewrite /b'; case: ifPn => //; rewrite -ltNge => /ltW. -apply: lee_adde => e. +apply/lee_addgt0Pr => _/posnumP[e]. rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. apply: le_trans (epsilon_trick _ _ _) => //=. have [c ce] := nondecreasing_right_continuousP a.1 f [gt0 of e%:num / 2]. @@ -488,5 +491,14 @@ Definition lebesgue_stieltjes_measure (f : cumulative R) := HB.instance Definition _ (f : cumulative R) := Measure.on (lebesgue_stieltjes_measure f). +(* TODO: this ought to be turned into a Let but older version of mathcomp/coq + does not seem to allow, try to change asap *) +Local Lemma sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : + sigma_finite setT (lebesgue_stieltjes_measure f). +Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. + +HB.instance Definition _ (f : cumulative R) := @isSigmaFinite.Build _ _ _ + (lebesgue_stieltjes_measure f) (sigmaT_finite_lebesgue_stieltjes_measure f). + End hlength_extension. Arguments lebesgue_stieltjes_measure {R}. diff --git a/theories/reals.v b/theories/reals.v index b401650ba6..b0fb595438 100644 --- a/theories/reals.v +++ b/theories/reals.v @@ -770,53 +770,59 @@ End CeilTheory. (* -------------------------------------------------------------------- *) Section Sup. Context {R : realType}. +Implicit Types A B : set R. -Lemma le_down (S : set R) : S `<=` down S. -Proof. by move=> x xS; apply/downP; exists x. Qed. +Lemma le_down A : A `<=` down A. +Proof. by move=> x xA; apply/downP; exists x. Qed. -Lemma downK (S : set R) : down (down S) = down S. +Lemma downK A : down (down A) = down A. Proof. -rewrite predeqE => x; split. -- case/downP => y /downP[z Sz yz xy]. - by apply/downP; exists z => //; rewrite (le_trans xy). -- by move=> Sx; apply/downP; exists x. +rewrite predeqE => x; split; last by move=> Ax; apply/downP; exists x. +case/downP => y /downP[z Az yz xy]. +by apply/downP; exists z => //; rewrite (le_trans xy). Qed. -Lemma has_sup_down (S : set R) : has_sup (down S) <-> has_sup S. +Lemma has_sup_down A : has_sup (down A) <-> has_sup A. Proof. -split=> -[nzS nzubS]. - case: nzS=> x /downP[y yS le_xy]; split; first by exists y. - case: nzubS=> u /ubP ubS; exists u; apply/ubP=> z zS. - by apply/ubS; apply/downP; exists z. -case: nzS=> x xS; split; first by exists x; apply/le_down. -case: nzubS=> u /ubP ubS; exists u; apply/ubP=> y /downP []. -by move=> z zS /le_trans; apply; apply/ubS. +split=> -[nzA nzubA]. + case: nzA => x /downP[y yS le_xy]; split; first by exists y. + case: nzubA=> u /ubP ubA; exists u; apply/ubP=> z zS. + by apply/ubA; apply/downP; exists z. +case: nzA => x xA; split; first by exists x; apply/le_down. +case: nzubA => u /ubP ubA; exists u; apply/ubP=> y /downP []. +by move=> z zA /le_trans; apply; apply/ubA. Qed. -Lemma le_sup (S1 S2 : set R) : - S1 `<=` down S2 -> nonempty S1 -> has_sup S2 - -> sup S1 <= sup S2. +Lemma le_sup A B : A `<=` down B -> nonempty A -> has_sup B -> + sup A <= sup B. Proof. -move=> le_S12 nz_S1 hs_S2; have hs_S1: has_sup S1. - split=> //; case: hs_S2=> _ [x ubx]. - exists x; apply/ubP=> y /le_S12 /downP[z zS2 le_yz]. +move=> le_AB nz_A hs_B; have hs_A: has_sup A. + split=> //; case: hs_B => _ [x ubx]. + exists x; apply/ubP=> y /le_AB /downP[z zB le_yz]. by apply/(le_trans le_yz); move/ubP: ubx; apply. rewrite leNgt -subr_gt0; apply/negP => lt_sup. -case: (sup_adherent lt_sup hs_S1 )=> x /le_S12 xdS2. -rewrite subKr => lt_S2x; case/downP: xdS2=> z zS2. -move/(lt_le_trans lt_S2x); rewrite ltNge. -by move/ubP: (sup_upper_bound hs_S2) => ->. +case: (sup_adherent lt_sup hs_A )=> x /le_AB xdB. +rewrite subKr => lt_Bx; case/downP: xdB => z zB. +move/(lt_le_trans lt_Bx); rewrite ltNge. +by move/ubP : (sup_upper_bound hs_B) => ->. Qed. -Lemma sup_down (S : set R) : sup (down S) = sup S. +Lemma le_inf A B : -%R @` B `<=` down (-%R @` A) -> nonempty B -> has_inf A -> + inf A <= inf B. Proof. -have [supS|supNS] := pselect (has_sup S); last first. +move=> SBA AB Ai; rewrite ler_oppl opprK le_sup// ?has_inf_supN//. +exact/nonemptyN. +Qed. + +Lemma sup_down A : sup (down A) = sup A. +Proof. +have [supA|supNA] := pselect (has_sup A); last first. by rewrite !sup_out // => /has_sup_down. -have supDS : has_sup (down S) by apply/has_sup_down. +have supDA : has_sup (down A) by apply/has_sup_down. apply/eqP; rewrite eq_le !le_sup //. - by case: supS => -[x xS] _; exists x; apply/le_down. - rewrite downK; exact: le_down. - by case: supS. +- by case: supA => -[x xA] _; exists x; apply/le_down. +- by rewrite downK; exact: le_down. +- by case: supA. Qed. Lemma lt_sup_imfset {T : Type} (F : T -> R) l : @@ -835,8 +841,8 @@ Lemma lt_inf_imfset {T : Type} (F : T -> R) l : exists2 x, F x < l & inf [set y | exists x, y = F x] <= F x. Proof. set P := [set y | _]; move=> hs; rewrite -subr_gt0. -move=> /inf_adherent/(_ hs)[_ [x ->]]; rewrite addrA [_ + l]addrC addrK. -by move=> ltFxl; exists x=> //; move/lbP : (inf_lower_bound hs) => -> //; exists x. +move=> /inf_adherent/(_ hs)[_ [x ->]]; rewrite addrCA subrr addr0 => ltFxl. +by exists x=> //; move/lbP : (inf_lower_bound hs) => -> //; exists x. Qed. End Sup. From 7f3ecfcb82e86b1db2bf13ac1af3fcf0a3e32577 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 4 Oct 2023 11:02:43 +0900 Subject: [PATCH 13/19] test --- theories/lebesgue_measure.v | 10 +++------- theories/lebesgue_stieltjes_measure.v | 2 +- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 55bf784290..89362b34ec 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -324,18 +324,13 @@ Qed. Definition lebesgue_measure := measure_extension [the measure _ _ of hlength]. HB.instance Definition _ := Measure.on lebesgue_measure. -(* TODO: this ought to be turned into a Let but older version of mathcomp/coq - does not seem to allow, try to change asap *) -Local Lemma sigmaT_finite_lebesgue_measure : sigma_finite setT lebesgue_measure. +Let sigmaT_finite_lebesgue_measure : sigma_finite setT lebesgue_measure. Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. HB.instance Definition _ := @isSigmaFinite.Build _ _ _ lebesgue_measure sigmaT_finite_lebesgue_measure. End hlength_extension. -Arguments hlength {R}. -#[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. -Arguments lebesgue_measure {R}. End LebesgueMeasure. @@ -344,6 +339,7 @@ Definition lebesgue_measure {R : realType} : salgebraType R.-ocitv.-measurable] -> \bar R := [the measure _ _ of lebesgue_stieltjes_measure [the cumulative _ of idfun]]. HB.instance Definition _ (R : realType) := Measure.on (@lebesgue_measure R). +HB.instance Definition _ (R : realType) := SigmaFiniteContent.on (@lebesgue_measure R). Section lebesgue_measure. Variable R : realType. @@ -2053,7 +2049,7 @@ Lemma lebesgue_regularity_inner_sup (D : set R) (eps : R) : measurable D -> Proof. move=> mD; have [?|] := ltP (mu D) +oo. exact: lebesgue_regularity_innerE_bounded. -have /sigma_finiteP [F RFU [Fsub ffin]] := sigma_finiteT mu (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *). +have /sigma_finiteP [F RFU [Fsub ffin]] := sigma_finiteT mu (*lebesgue_stieltjes_measure.sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *) *). rewrite leye_eq => /eqP /[dup] + ->. have {1}-> : D = \bigcup_n (F n `&` D) by rewrite -setI_bigcupl -RFU setTI. move=> FDp; apply/esym/eq_infty => M. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 6c57e158f0..18cb61ffab 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -493,7 +493,7 @@ HB.instance Definition _ (f : cumulative R) := (* TODO: this ought to be turned into a Let but older version of mathcomp/coq does not seem to allow, try to change asap *) -Local Lemma sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : +Let sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : sigma_finite setT (lebesgue_stieltjes_measure f). Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. From ac085b4864b63c41431ddf5a26a76b2fc19a3bf2 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 4 Oct 2023 12:53:46 +0900 Subject: [PATCH 14/19] fix --- theories/lebesgue_measure.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 89362b34ec..05c612e8c3 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -2049,7 +2049,7 @@ Lemma lebesgue_regularity_inner_sup (D : set R) (eps : R) : measurable D -> Proof. move=> mD; have [?|] := ltP (mu D) +oo. exact: lebesgue_regularity_innerE_bounded. -have /sigma_finiteP [F RFU [Fsub ffin]] := sigma_finiteT mu (*lebesgue_stieltjes_measure.sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *) *). +have /sigma_finiteP [F RFU [Fsub ffin]] := sigma_finiteT [the {measure set _ -> \bar R} of mu] (*lebesgue_stieltjes_measure.sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *) *). rewrite leye_eq => /eqP /[dup] + ->. have {1}-> : D = \bigcup_n (F n `&` D) by rewrite -setI_bigcupl -RFU setTI. move=> FDp; apply/esym/eq_infty => M. From 26f083f37620ecbfb812516c1da8c6c942233dc2 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 4 Oct 2023 13:45:12 +0900 Subject: [PATCH 15/19] fix --- theories/lebesgue_measure.v | 2 +- theories/lebesgue_stieltjes_measure.v | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 05c612e8c3..8fd672c93f 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -2049,7 +2049,7 @@ Lemma lebesgue_regularity_inner_sup (D : set R) (eps : R) : measurable D -> Proof. move=> mD; have [?|] := ltP (mu D) +oo. exact: lebesgue_regularity_innerE_bounded. -have /sigma_finiteP [F RFU [Fsub ffin]] := sigma_finiteT [the {measure set _ -> \bar R} of mu] (*lebesgue_stieltjes_measure.sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *) *). +have /sigma_finiteP [F RFU [Fsub ffin]] := lebesgue_stieltjes_measure.sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *). rewrite leye_eq => /eqP /[dup] + ->. have {1}-> : D = \bigcup_n (F n `&` D) by rewrite -setI_bigcupl -RFU setTI. move=> FDp; apply/esym/eq_infty => M. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 18cb61ffab..a6c996a613 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -493,7 +493,7 @@ HB.instance Definition _ (f : cumulative R) := (* TODO: this ought to be turned into a Let but older version of mathcomp/coq does not seem to allow, try to change asap *) -Let sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : +Lemma sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : sigma_finite setT (lebesgue_stieltjes_measure f). Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. From 84c0db84d8fc72e7d4002653375381baba534681 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 4 Oct 2023 17:02:17 +0900 Subject: [PATCH 16/19] rm dup, fix --- theories/lebesgue_integral.v | 4 +- theories/lebesgue_measure.v | 76 +++++------------------------------- 2 files changed, 11 insertions(+), 69 deletions(-) diff --git a/theories/lebesgue_integral.v b/theories/lebesgue_integral.v index d22965795c..e4cd3f1236 100644 --- a/theories/lebesgue_integral.v +++ b/theories/lebesgue_integral.v @@ -4869,7 +4869,7 @@ move=> /[dup]/compact_measurable => mA /compact_bounded[N [_ N1x]]. have AN1 : (A `<=` `[- (`|N| + 1), `|N| + 1])%R. by move=> z Az; rewrite set_itvcc /= -ler_norml N1x// ltr_spaddr// ler_norm. rewrite (le_lt_trans (le_measure _ _ _ AN1)) ?inE//=. -by rewrite lebesgue_measure_itv/= lebesgue_stieltjes_measure.hlength_itv/= lte_fin gtr_opp// EFinD ltry. +by rewrite lebesgue_measure_itv/= hlength_itv/= lte_fin gtr_opp// EFinD ltry. Qed. Lemma continuous_compact_integrable (f : R -> R^o) (A : set R^o) : @@ -5571,7 +5571,7 @@ have ball_itv2 r : 0 < r -> ball x r = `[x - r, x + r] `\` [set x + r; x - r]. rewrite -ball_itvr // setDD setIC; apply/esym/setIidPl. by rewrite ballE set_itvcc => ?/=; rewrite in_itv => /andP [/ltW -> /ltW ->]. have ritv r : 0 < r -> mu `[x - r, x + r]%classic = (r *+ 2)%:E. - move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv lebesgue_stieltjes_measure.hlength_itv /= lte_fin. + move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv hlength_itv /= lte_fin. rewrite ler_lt_add // ?rE // -EFinD; congr (_ _). by rewrite opprB addrAC [_ - _]addrC addrA subrr add0r. move=> oA intf ctsfx Ax. diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 8fd672c93f..e19bddcaf9 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -6,7 +6,7 @@ From mathcomp Require Import cardinality fsbigop. Require Import reals ereal signed topology numfun normedtype. From HB Require Import structures. Require Import sequences esum measure real_interval realfun exp. -Require Import lebesgue_stieltjes_measure. +Require Export lebesgue_stieltjes_measure. (******************************************************************************) (* Lebesgue Measure *) @@ -46,7 +46,7 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -(* This module contains a direct construction of the Lebesgue measure this is +(* This module contains a direct construction of the Lebesgue measure that is kept here for archival purpose. The Lebesgue measure is actually defined as an instance of the Lebesgue-Stieltjes measure. *) Module LebesgueMeasure. @@ -162,7 +162,7 @@ Lemma hlength_ge0 I : (0 <= hlength I)%E. Proof. by rewrite -hlength0 le_hlength. Qed. End hlength. -#[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. +#[local] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. (* Unused *) (* Lemma hlength_semi_additive2 : semi_additive2 hlength. *) @@ -339,7 +339,8 @@ Definition lebesgue_measure {R : realType} : salgebraType R.-ocitv.-measurable] -> \bar R := [the measure _ _ of lebesgue_stieltjes_measure [the cumulative _ of idfun]]. HB.instance Definition _ (R : realType) := Measure.on (@lebesgue_measure R). -HB.instance Definition _ (R : realType) := SigmaFiniteContent.on (@lebesgue_measure R). +HB.instance Definition _ (R : realType) := + SigmaFiniteContent.on (@lebesgue_measure R). Section lebesgue_measure. Variable R : realType. @@ -480,68 +481,6 @@ Qed. End puncture_ereal_itv. -Lemma set1_bigcap_oc (R : realType) (r : R) : - [set r] = \bigcap_i `]r - i.+1%:R^-1, r]%classic. -Proof. -apply/seteqP; split=> [x ->|]. - by move=> i _/=; rewrite in_itv/= lexx ltr_subl_addr ltr_addl invr_gt0 ltr0n. -move=> x rx; apply/esym/eqP; rewrite eq_le (itvP (rx 0%N _))// andbT. -apply/ler_addgt0Pl => e e_gt0; rewrite -ler_subl_addl ltW//. -have := rx `|floor e^-1%R|%N I; rewrite /= in_itv => /andP[/le_lt_trans->]//. -rewrite ler_add2l ler_opp2 -lef_pinv ?invrK//; last by rewrite qualifE. -by rewrite -natr1 natr_absz ger0_norm ?floor_ge0 ?invr_ge0 1?ltW// lt_succ_floor. -Qed. - -Lemma itv_bnd_open_bigcup (R : realType) b (r s : R) : - [set` Interval (BSide b r) (BLeft s)] = - \bigcup_n [set` Interval (BSide b r) (BRight (s - n.+1%:R^-1))]. -Proof. -apply/seteqP; split => [x/=|]; last first. - move=> x [n _ /=] /[!in_itv] /andP[-> /le_lt_trans]; apply. - by rewrite ltr_subl_addr ltr_addl invr_gt0 ltr0n. -rewrite in_itv/= => /andP[sx xs]; exists `|ceil ((s - x)^-1)|%N => //=. -rewrite in_itv/= sx/= ler_subr_addl addrC -ler_subr_addl. -rewrite -[in X in _ <= X](invrK (s - x)) ler_pinv. -- rewrite -natr1 natr_absz ger0_norm; last first. - by rewrite ceil_ge0// invr_ge0 subr_ge0 ltW. - by rewrite (@le_trans _ _ (ceil (s - x)^-1)%:~R)// ?ler_addl// ceil_ge. -- by rewrite inE unitfE ltr0n andbT pnatr_eq0. -- by rewrite inE invr_gt0 subr_gt0 xs andbT unitfE invr_eq0 subr_eq0 gt_eqF. -Qed. - -Lemma itv_open_bnd_bigcup (R : realType) b (r s : R) : - [set` Interval (BRight s) (BSide b r)] = - \bigcup_n [set` Interval (BLeft (s + n.+1%:R^-1)) (BSide b r)]. -Proof. -have /(congr1 (fun x => -%R @` x)) := itv_bnd_open_bigcup (~~ b) (- r) (- s). -rewrite opp_itv_bnd_bnd/= !opprK negbK => ->; rewrite image_bigcup. -apply eq_bigcupr => k _; apply/seteqP; split=> [_/= [y ysr] <-|x/= xsr]. - by rewrite oppr_itv/= opprD. -by exists (- x); rewrite ?oppr_itv//= opprK// negbK opprB opprK addrC. -Qed. - -Lemma itv_bnd_infty_bigcup (R : realType) b (x : R) : - [set` Interval (BSide b x) +oo%O] = - \bigcup_i [set` Interval (BSide b x) (BRight (x + i%:R))]. -Proof. -apply/seteqP; split=> y; rewrite /= !in_itv/= andbT; last first. - by move=> [k _ /=]; move: b => [|] /=; rewrite in_itv/= => /andP[//] /ltW. -move=> xy; exists `|ceil (y - x)|%N => //=; rewrite in_itv/= xy/= -ler_subl_addl. -rewrite !natr_absz/= ger0_norm ?ceil_ge0 ?subr_ge0 ?ceil_ge//. -by case: b xy => //= /ltW. -Qed. - -Lemma itv_infty_bnd_bigcup (R : realType) b (x : R) : - [set` Interval -oo%O (BSide b x)] = - \bigcup_i [set` Interval (BLeft (x - i%:R)) (BSide b x)]. -Proof. -have /(congr1 (fun x => -%R @` x)) := itv_bnd_infty_bigcup (~~ b) (- x). -rewrite opp_itv_bnd_infty negbK opprK => ->; rewrite image_bigcup. -apply eq_bigcupr => k _; apply/seteqP; split=> [_ /= -[r rbxk <-]|y/= yxkb]. - by rewrite oppr_itv/= opprB addrC. -by exists (- y); [rewrite oppr_itv/= negbK opprD opprK|rewrite opprK]. -Qed. - Section salgebra_R_ssets. Variable R : realType. @@ -2049,7 +1988,10 @@ Lemma lebesgue_regularity_inner_sup (D : set R) (eps : R) : measurable D -> Proof. move=> mD; have [?|] := ltP (mu D) +oo. exact: lebesgue_regularity_innerE_bounded. -have /sigma_finiteP [F RFU [Fsub ffin]] := lebesgue_stieltjes_measure.sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] (*TODO: sigma_finiteT mu should be enough but does not seem to work with holder version of mathcomp/coq *). +have /sigma_finiteP [F RFU [Fsub ffin]] := + sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] + (*TODO: sigma_finiteT mu should be enough but does not seem to work with older + versions of MathComp/Coq (Coq <= 8.15?) *). rewrite leye_eq => /eqP /[dup] + ->. have {1}-> : D = \bigcup_n (F n `&` D) by rewrite -setI_bigcupl -RFU setTI. move=> FDp; apply/esym/eq_infty => M. From 0358d247962c9bd21c102b6d517cf3ad9256018d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 4 Oct 2023 19:19:32 +0900 Subject: [PATCH 17/19] fix --- CHANGELOG_UNRELEASED.md | 2 +- theories/lebesgue_integral.v | 2 +- theories/lebesgue_stieltjes_measure.v | 1 - theories/probability.v | 6 +++--- 4 files changed, 5 insertions(+), 6 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 1200cb1bb6..1851a465b2 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -56,7 +56,7 @@ `hlength_finite_fin_num`, `finite_hlengthE`, `hlength_infty_bnd`, `hlength_bnd_infty`, `pinfty_hlength`, `hlength_itv_ge0`, `hlength_Rhull`, `le_hlength_itv`, `le_hlength`, `hlength_ge0`, `hlength_semi_additive`, - `hlength_sigma_sub_additive`, `hlength_sigma_finite` + `hlength_sigma_sub_additive`, `hlength_sigma_finite`, `lebesgue_measure` + `lebesgue_measure` now defined with `lebesgue_stieltjes_measure` - moved from `lebesgue_measure.v` to `lebesgue_stieltjes_measure.v` + notations `_.-ocitv`, `_.-ocitv.-measurable` diff --git a/theories/lebesgue_integral.v b/theories/lebesgue_integral.v index e4cd3f1236..57107fe01d 100644 --- a/theories/lebesgue_integral.v +++ b/theories/lebesgue_integral.v @@ -4869,7 +4869,7 @@ move=> /[dup]/compact_measurable => mA /compact_bounded[N [_ N1x]]. have AN1 : (A `<=` `[- (`|N| + 1), `|N| + 1])%R. by move=> z Az; rewrite set_itvcc /= -ler_norml N1x// ltr_spaddr// ler_norm. rewrite (le_lt_trans (le_measure _ _ _ AN1)) ?inE//=. -by rewrite lebesgue_measure_itv/= hlength_itv/= lte_fin gtr_opp// EFinD ltry. +by rewrite lebesgue_measure_itv hlength_itv/= lte_fin gtr_opp// EFinD ltry. Qed. Lemma continuous_compact_integrable (f : R -> R^o) (A : set R^o) : diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index a6c996a613..2406e4cbb6 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -1,4 +1,3 @@ -(* -*- company-coq-local-symbols: (("`&`" . ?∩) ("`|`" . ?∪) ("set0" . ?∅)); -*- *) (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat. diff --git a/theories/probability.v b/theories/probability.v index 4507d78bd8..6e59aad181 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -4,9 +4,9 @@ From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. From mathcomp Require Import cardinality. From HB Require Import structures. -From mathcomp.classical Require Import functions cardinality. -Require Import reals ereal signed topology normedtype sequences exp esum. -Require Import measure numfun lebesgue_measure lebesgue_integral. +Require Import exp numfun lebesgue_measure lebesgue_integral. +Require Import reals ereal signed topology normedtype sequences esum measure. +Require Import exp numfun lebesgue_measure lebesgue_integral. (******************************************************************************) (* Probability (experimental) *) From 3915fa4b44f9a1a4ffb768092bdd273c3cb7811b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 23 Oct 2023 15:56:24 +0900 Subject: [PATCH 18/19] rename hlength to wlength --- CHANGELOG_UNRELEASED.md | 51 +++---- theories/constructive_ereal.v | 3 + theories/lebesgue_integral.v | 4 +- theories/lebesgue_measure.v | 80 +++++------ theories/lebesgue_stieltjes_measure.v | 189 ++++++++++++++------------ 5 files changed, 171 insertions(+), 156 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 1851a465b2..df2f0239e2 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -14,50 +14,48 @@ - in `measure.v`: + lemmas `negligibleI`, `negligible_bigsetU`, `negligible_bigcup` -### Changed - -- in `hoelder.v`: - + definition `Lnorm` now `HB.lock`ed -- in `lebesgue_integral.v`: - + `integral_dirac` now uses the `\d_` notation - -- in `measure.v`: - + order of parameters changed in `semi_sigma_additive_is_additive`, - `isMeasure` - -### Renamed - -- in `charge.v` - + `isCharge` -> `isSemiSigmaAdditive` - in `reals.v`: + lemma `le_inf` - in `constructive_ereal.v`: - + lemma `le_er_map` + + lemmas `le_er_map`, `er_map_idfun` - new `lebesgue_stieltjes_measure.v`: + notation `right_continuous` + lemmas `right_continuousW`, `nondecreasing_right_continuousP` + mixin `isCumulative`, structure `Cumulative`, notation `cumulative` + `idfun` instance of `Cumulative` - + `hlength`, `hlength0`, `hlength_singleton`, `hlength_setT`, `hlength_itv`, - `hlength_finite_fin_num`, `finite_hlengthE`, `hlength_itv_bnd`, `hlength_infty_bnd`, - `hlength_bnd_infty`, `pinfty_hlength`, `hlength_itv_ge0`, `hlength_Rhull`, - `le_hlength_itv`, `le_hlength`, `hlength_semi_additive`, `hlength_ge0` + + `wlength`, `wlength0`, `wlength_singleton`, `wlength_setT`, `wlength_itv`, + `wlength_finite_fin_num`, `finite_wlength_itv`, `wlength_itv_bnd`, `wlength_infty_bnd`, + `wlength_bnd_infty`, `infinite_wlength_itv`, `wlength_itv_ge0`, `wlength_Rhull`, + `le_wlength_itv`, `le_wlength`, `wlength_semi_additive`, `wlength_ge0`, + `lebesgue_stieltjes_measure_unique` + content instance of `hlength` - + `hlength_content_sub_fsum`, - `hlength_sigma_sub_additive`, `hlength_sigma_finite` + + `cumulative_content_sub_fsum`, + `wlength_sigma_sub_additive`, `wlength_sigma_finite` + measure instance of `hlength` + definition `lebesgue_stieltjes_measure` ### Changed +- in `hoelder.v`: + + definition `Lnorm` now `HB.lock`ed +- in `lebesgue_integral.v`: + + `integral_dirac` now uses the `\d_` notation + +- in `measure.v`: + + order of parameters changed in `semi_sigma_additive_is_additive`, + `isMeasure` + - in `lebesgue_measure.v`: + are now prefixed with `LebesgueMeasure`: * `hlength`, `hlength0`, `hlength_singleton`, `hlength_setT`, `hlength_itv`, - `hlength_finite_fin_num`, `finite_hlengthE`, `hlength_infty_bnd`, - `hlength_bnd_infty`, `pinfty_hlength`, `hlength_itv_ge0`, `hlength_Rhull`, + `hlength_finite_fin_num`, `hlength_infty_bnd`, + `hlength_bnd_infty`, `hlength_itv_ge0`, `hlength_Rhull`, `le_hlength_itv`, `le_hlength`, `hlength_ge0`, `hlength_semi_additive`, `hlength_sigma_sub_additive`, `hlength_sigma_finite`, `lebesgue_measure` + * `finite_hlengthE` renamed to `finite_hlentgh_itv` + * `pinfty_hlength` renamed to `infinite_hlength_itv` + `lebesgue_measure` now defined with `lebesgue_stieltjes_measure` + + `lebesgue_measure_itv` does not refer to `hlength` anymore - moved from `lebesgue_measure.v` to `lebesgue_stieltjes_measure.v` + notations `_.-ocitv`, `_.-ocitv.-measurable` + definitions `ocitv`, `ocitv_display` @@ -65,6 +63,9 @@ ### Renamed +- in `charge.v` + + `isCharge` -> `isSemiSigmaAdditive` + - in `ereal.v`: + `le_er_map` -> `le_er_map_in` @@ -77,6 +78,8 @@ ### Removed +- `lebesgue_measure_unique` (generalized to `lebesgue_stieltjes_measure_unique`) + ### Infrastructure ### Misc diff --git a/theories/constructive_ereal.v b/theories/constructive_ereal.v index 15e7e38775..b146d568dd 100644 --- a/theories/constructive_ereal.v +++ b/theories/constructive_ereal.v @@ -123,6 +123,9 @@ Definition er_map T T' (f : T -> T') (x : \bar T) : \bar T' := | -oo => -oo end. +Lemma er_map_idfun T (x : \bar T) : er_map idfun x = x. +Proof. by case: x. Qed. + Definition fine {R : zmodType} x : R := if x is EFin v then v else 0. Section EqEReal. diff --git a/theories/lebesgue_integral.v b/theories/lebesgue_integral.v index 57107fe01d..40517b53e3 100644 --- a/theories/lebesgue_integral.v +++ b/theories/lebesgue_integral.v @@ -4869,7 +4869,7 @@ move=> /[dup]/compact_measurable => mA /compact_bounded[N [_ N1x]]. have AN1 : (A `<=` `[- (`|N| + 1), `|N| + 1])%R. by move=> z Az; rewrite set_itvcc /= -ler_norml N1x// ltr_spaddr// ler_norm. rewrite (le_lt_trans (le_measure _ _ _ AN1)) ?inE//=. -by rewrite lebesgue_measure_itv hlength_itv/= lte_fin gtr_opp// EFinD ltry. +by rewrite lebesgue_measure_itv/= lte_fin gtr_opp// EFinD ltry. Qed. Lemma continuous_compact_integrable (f : R -> R^o) (A : set R^o) : @@ -5571,7 +5571,7 @@ have ball_itv2 r : 0 < r -> ball x r = `[x - r, x + r] `\` [set x + r; x - r]. rewrite -ball_itvr // setDD setIC; apply/esym/setIidPl. by rewrite ballE set_itvcc => ?/=; rewrite in_itv => /andP [/ltW -> /ltW ->]. have ritv r : 0 < r -> mu `[x - r, x + r]%classic = (r *+ 2)%:E. - move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv hlength_itv /= lte_fin. + move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv/= lte_fin. rewrite ler_lt_add // ?rE // -EFinD; congr (_ _). by rewrite opprB addrAC [_ - _]addrC addrA subrr add0r. move=> oA intf ctsfx Ax. diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index e19bddcaf9..530af50396 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -93,7 +93,7 @@ by move=> _; rewrite hlength_itv /= ltNyr. by move=> _; rewrite hlength_itv. Qed. -Lemma finite_hlengthE i : neitv i -> hlength [set` i] < +oo -> +Lemma finite_hlength_itv i : neitv i -> hlength [set` i] < +oo -> hlength [set` i] = (fine i.2)%:E - (fine i.1)%:E. Proof. move=> i0 ioo; have [ri1 ri2] := hlength_finite_fin_num i0 ioo. @@ -110,7 +110,7 @@ Lemma hlength_bnd_infty b r : hlength [set` Interval (BSide b r) +oo%O] = +oo :> \bar R. Proof. by rewrite hlength_itv /= ltry. Qed. -Lemma pinfty_hlength i : hlength [set` i] = +oo -> +Lemma infinite_hlength_itv i : hlength [set` i] = +oo -> (exists s r, i = Interval -oo%O (BSide s r) \/ i = Interval (BSide s r) +oo%O) \/ i = `]-oo, +oo[. Proof. @@ -342,20 +342,6 @@ HB.instance Definition _ (R : realType) := Measure.on (@lebesgue_measure R). HB.instance Definition _ (R : realType) := SigmaFiniteContent.on (@lebesgue_measure R). -Section lebesgue_measure. -Variable R : realType. -Let gitvs := [the measurableType _ of salgebraType (@ocitv R)]. - -Lemma lebesgue_measure_unique (mu : {measure set gitvs -> \bar R}) : - (forall X, ocitv X -> hlength [the cumulative _ of idfun] X = mu X) -> - forall X, measurable X -> lebesgue_measure X = mu X. -Proof. -move=> muE X mX; apply: measure_extension_unique => //. -exact: hlength_sigma_finite. -Qed. - -End lebesgue_measure. - Section ps_infty. Context {T : Type}. Local Open Scope ereal_scope. @@ -738,7 +724,7 @@ Variable R : realType. Let lebesgue_measure_itvoc (a b : R) : (lebesgue_measure (`]a, b] : set R) = - hlength [the cumulative _ of idfun] `]a, b])%classic. + wlength [the cumulative _ of idfun] `]a, b])%classic. Proof. rewrite /lebesgue_measure/= /lebesgue_stieltjes_measure/= /measure_extension/=. by rewrite measurable_mu_extE//; exact: is_ocitv. @@ -758,7 +744,7 @@ rewrite itv_bnd_open_bigcup//; transitivity (lim (lebesgue_measure \o rewrite (_ : _ \o _ = (fun n => (1 - n.+1%:R^-1)%:E)); last first. apply/funext => n /=; rewrite lebesgue_measure_itvoc. have [->|n0] := eqVneq n 0%N; first by rewrite invr1 subrr set_itvoc0. - rewrite hlength_itv/= lte_fin ifT; last first. + rewrite wlength_itv/= lte_fin ifT; last first. by rewrite ler_lt_sub// invr_lt1 ?unitfE// ltr1n ltnS lt0n. by rewrite !(EFinB,EFinN) fin_num_oppeB// addeAC addeA subee// add0e. apply/cvg_lim => //=; apply/fine_cvgP; split => /=; first exact: nearW. @@ -773,7 +759,7 @@ suff : (lebesgue_measure (`]a - 1, a]%classic%R : set R) = lebesgue_measure (`]a - 1, a[%classic%R : set R) + lebesgue_measure [set a])%E. rewrite lebesgue_measure_itvoo_subr1 lebesgue_measure_itvoc => /eqP. - rewrite hlength_itv lte_fin ltr_subl_addr ltr_addl ltr01. + rewrite wlength_itv lte_fin ltr_subl_addr ltr_addl ltr01. rewrite [in X in X == _]/= EFinN EFinB fin_num_oppeB// addeA subee// add0e. by rewrite addeC -sube_eq ?fin_num_adde_defl// subee// => /eqP. rewrite -setUitv1// ?bnd_simp; last by rewrite ltr_subl_addr ltr_addl. @@ -783,40 +769,40 @@ Qed. Let lebesgue_measure_itvoo (a b : R) : (lebesgue_measure (`]a, b[ : set R) = - hlength [the cumulative _ of idfun] `]a, b[)%classic. + wlength [the cumulative _ of idfun] `]a, b[)%classic. Proof. have [ab|ba] := ltP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoc a b. -rewrite 2!hlength_itv => <-; rewrite -setUitv1// measureU//. +rewrite 2!wlength_itv => <-; rewrite -setUitv1// measureU//. - by have /= -> := lebesgue_measure_set1 b; rewrite adde0. - by apply/seteqP; split => // x [/= + xb]; rewrite in_itv/= xb ltxx andbF. Qed. Let lebesgue_measure_itvcc (a b : R) : (lebesgue_measure (`[a, b] : set R) = - hlength [the cumulative _ of idfun] `[a, b])%classic. + wlength [the cumulative _ of idfun] `[a, b])%classic. Proof. have [ab|ba] := leP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoc a b. -rewrite 2!hlength_itv => <-; rewrite -setU1itv// measureU//. +rewrite 2!wlength_itv => <-; rewrite -setU1itv// measureU//. - by have /= -> := lebesgue_measure_set1 a; rewrite add0e. - by apply/seteqP; split => // x [/= ->]; rewrite in_itv/= ltxx. Qed. Let lebesgue_measure_itvco (a b : R) : (lebesgue_measure (`[a, b[ : set R) = - hlength [the cumulative _ of idfun] `[a, b[)%classic. + wlength [the cumulative _ of idfun] `[a, b[)%classic. Proof. have [ab|ba] := ltP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoo a b. -rewrite 2!hlength_itv => <-; rewrite -setU1itv// measureU//. +rewrite 2!wlength_itv => <-; rewrite -setU1itv// measureU//. - by have /= -> := lebesgue_measure_set1 a; rewrite add0e. - by apply/seteqP; split => // x [/= ->]; rewrite in_itv/= ltxx. Qed. Let lebesgue_measure_itv_bnd (x y : bool) (a b : R) : lebesgue_measure ([set` Interval (BSide x a) (BSide y b)] : set R) = - hlength [the cumulative _ of idfun] [set` Interval (BSide x a) (BSide y b)]. + wlength [the cumulative _ of idfun] [set` Interval (BSide x a) (BSide y b)]. Proof. by move: x y => [|] [|]; [exact: lebesgue_measure_itvco | exact: lebesgue_measure_itvcc | exact: lebesgue_measure_itvoo | @@ -837,7 +823,7 @@ rewrite itv_bnd_infty_bigcup; transitivity (lim (lebesgue_measure \o + move=> m n mn; apply/subsetPset => r/=; rewrite !in_itv/= => /andP[->/=]. by move=> /le_trans; apply; rewrite ler_add// ler_nat. rewrite (_ : _ \o _ = (fun k => k%:R%:E))//. -apply/funext => n /=; rewrite lebesgue_measure_itv_bnd hlength_itv/=. +apply/funext => n /=; rewrite lebesgue_measure_itv_bnd wlength_itv/=. rewrite lte_fin; have [->|n0] := eqVneq n 0%N; first by rewrite addr0 ltxx. by rewrite ltr_addl ltr0n lt0n n0 EFinD addeAC EFinN subee ?add0e. Qed. @@ -853,28 +839,33 @@ rewrite itv_infty_bnd_bigcup; transitivity (lim (lebesgue_measure \o + move=> m n mn; apply/subsetPset => r/=; rewrite !in_itv/= => /andP[+ ->]. by rewrite andbT; apply: le_trans; rewrite ler_sub// ler_nat. rewrite (_ : _ \o _ = (fun k : nat => k%:R%:E))//. -apply/funext => n /=; rewrite lebesgue_measure_itv_bnd hlength_itv/= lte_fin. +apply/funext => n /=; rewrite lebesgue_measure_itv_bnd wlength_itv/= lte_fin. have [->|n0] := eqVneq n 0%N; first by rewrite subr0 ltxx. rewrite ltr_subl_addr ltr_addl ltr0n lt0n n0 EFinN EFinB fin_num_oppeB// addeA. by rewrite subee// add0e. Qed. +Let lebesgue_measure_itv_infty_infty : + lebesgue_measure ([set` Interval -oo%O +oo%O] : set R) = +oo%E. +Proof. +rewrite set_itv_infty_infty -(setUv (`]-oo, 0[)) setCitv. +rewrite [X in _ `|` (X `|` _) ]set_itvE set0U measureU//; last first. + apply/seteqP; split => //= x [] /= /[swap]. + by rewrite !in_itv/= andbT ltNge => ->//. +rewrite [X in (X + _)%E]lebesgue_measure_itv_infty_bnd. +by rewrite [X in (_ + X)%E]lebesgue_measure_itv_bnd_infty. +Qed. + Lemma lebesgue_measure_itv (i : interval R) : - lebesgue_measure ([set` i] : set R) = - hlength [the cumulative _ of idfun] [set` i]. + lebesgue_measure ([set` i] : set R) = (if i.1 < i.2 then i.2 - i.1 else 0)%E. Proof. -move: i => [[x a|[|]]] [y b|[|]]; first exact: lebesgue_measure_itv_bnd. +move: i => [[x a|[|]]] [y b|[|]]. + by rewrite lebesgue_measure_itv_bnd wlength_itv. - by rewrite set_itvE ?measure0. -- by rewrite lebesgue_measure_itv_bnd_infty hlength_bnd_infty. -- by rewrite lebesgue_measure_itv_infty_bnd hlength_infty_bnd. +- by rewrite lebesgue_measure_itv_bnd_infty/= ltry. +- by rewrite lebesgue_measure_itv_infty_bnd/= ltNyr. - by rewrite set_itvE ?measure0. -- rewrite set_itvE hlength_setT. - rewrite (_ : setT = [set` `]-oo, 0[] `|` [set` `[0, +oo[]); last first. - by apply/seteqP; split=> // => x _; have [x0|x0] := leP 0 x; [right|left]; - rewrite /= in_itv//= x0. - rewrite measureU//=; try exact: measurable_itv. - + by rewrite lebesgue_measure_itv_infty_bnd lebesgue_measure_itv_bnd_infty. - + by apply/seteqP; split => // x []/=; rewrite !in_itv/= andbT leNgt => ->. +- by rewrite lebesgue_measure_itv_infty_infty. - by rewrite set_itvE ?measure0. - by rewrite set_itvE ?measure0. - by rewrite set_itvE ?measure0. @@ -1836,7 +1827,7 @@ Lemma lebesgue_regularity_outer (D : set R) (eps : R) : exists U : set R, [/\ open U , D `<=` U & mu (U `\` D) < eps%:E]. Proof. move=> mD muDpos epspos. -have /ereal_inf_lt[z [/= M' covDM sMz zDe]] : mu D < mu D + (eps / 2)%:E. +have /ereal_inf_lt[z [M' covDM sMz zDe]] : mu D < mu D + (eps / 2)%:E. by rewrite lte_spaddre ?lte_fin ?divr_gt0// ge0_fin_numE. pose e2 n := (eps / 2) / (2 ^ n.+1)%:R. have e2pos n : (0 < e2 n)%R by rewrite ?divr_gt0. @@ -1853,7 +1844,7 @@ have muM n : mu (M n) <= mu (M' n) + (e2 n)%:E. by rewrite propeqE; split=> /orP. by rewrite !bnd_simp (ltW alb)/= ltr_spaddr. rewrite measureU/=. - - rewrite !lebesgue_measure_itv !hlength_itv/= !lte_fin alb ltr_spaddr//=. + - rewrite !lebesgue_measure_itv/= !lte_fin alb ltr_spaddr//=. by rewrite -(EFinD (b + e2 n)) (addrC b) addrK. - by apply: sub_sigma_algebra; exact: is_ocitv. - by apply: open_measurable; exact: interval_open. @@ -1879,7 +1870,8 @@ have muU : mu U < mu D + eps%:E. by apply: epsilon_trick => //; rewrite divr_ge0// ltW. rewrite {2}[eps]splitr EFinD addeA lte_le_add//. rewrite (le_lt_trans _ zDe)// -sMz lee_nneseries// => i _. - rewrite -hlength_Rhull -lebesgue_measure_itv le_measure//= ?inE. + rewrite /= -wlength_Rhull wlength_itv !er_map_idfun. + rewrite -lebesgue_measure_itv le_measure//= ?inE. - by case: covDM => /(_ i) + _; exact: sub_sigma_algebra. - exact: measurable_itv. - exact: sub_Rhull. @@ -1954,7 +1946,7 @@ have mD' : measurable D' by exact: measurableD. have [] := lebesgue_regularity_outer mD' _ epspos. rewrite (@le_lt_trans _ _ (mu `[a,b]%classic))//. by rewrite le_measure ?inE//; exact: subIsetl. - by rewrite /= lebesgue_measure_itv /= hlength_itv //= -EFinD -fun_if ltry. + by rewrite /= lebesgue_measure_itv //= -EFinD -fun_if ltry. move=> U [oU /subsetC + mDeps]; rewrite setCI setCK => nCD'. exists (`[a, b] `&` ~` U); split. - apply: (subclosed_compact _ (@segment_compact _ a b)) => //. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index 2406e4cbb6..cee6d1efa4 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -164,7 +164,9 @@ Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type R))) : classical_set_scope. -Section hlength. +Local Open Scope measure_display_scope. + +Section wlength. Context {R : realType}. Variable (f : R -> R). Local Open Scope ereal_scope. @@ -172,100 +174,100 @@ Implicit Types i j : interval R. Let g : \bar R -> \bar R := er_map f. -Definition hlength (A : set (ocitv_type R)) : \bar R := +Definition wlength (A : set (ocitv_type R)) : \bar R := let i := Rhull A in g i.2 - g i.1. -Lemma hlength0 : hlength (set0 : set R) = 0. -Proof. by rewrite /hlength Rhull0 /= subee. Qed. +Lemma wlength0 : wlength (set0 : set R) = 0. +Proof. by rewrite /wlength Rhull0 /= subee. Qed. -Lemma hlength_singleton (r : R) : hlength `[r, r] = 0. +Lemma wlength_singleton (r : R) : wlength `[r, r] = 0. Proof. -rewrite /hlength /= asboolT// sup_itvcc//= asboolT//. +rewrite /wlength /= asboolT// sup_itvcc//= asboolT//. by rewrite asboolT inf_itvcc//= ?subee// inE. Qed. -Lemma hlength_setT : hlength setT = +oo%E :> \bar R. -Proof. by rewrite /hlength RhullT. Qed. +Lemma wlength_setT : wlength setT = +oo%E :> \bar R. +Proof. by rewrite /wlength RhullT. Qed. -Lemma hlength_itv i : hlength [set` i] = if i.2 > i.1 then g i.2 - g i.1 else 0. +Lemma wlength_itv i : wlength [set` i] = if i.2 > i.1 then g i.2 - g i.1 else 0. Proof. -case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /hlength set_itvK. +case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /wlength set_itvK. rewrite le_eqVlt => /orP[|/lt_ereal_bnd i12]; last first. - rewrite -hlength0; congr (hlength _). + rewrite -wlength0; congr (wlength _). by apply/eqP/negPn; rewrite -/(neitv _) neitvE -leNgt (ltW i12). case: i => -[ba a|[|]] [bb b|[|]] //=. - rewrite /= => /eqP[->{b}]; move: ba bb => -[] []; try - by rewrite set_itvE hlength0. - by rewrite hlength_singleton. -- by move=> _; rewrite set_itvE hlength0. -- by move=> _; rewrite set_itvE hlength0. + by rewrite set_itvE wlength0. + by rewrite wlength_singleton. +- by move=> _; rewrite set_itvE wlength0. +- by move=> _; rewrite set_itvE wlength0. Qed. -Lemma hlength_finite_fin_num i : neitv i -> hlength [set` i] < +oo -> +Lemma wlength_finite_fin_num i : neitv i -> wlength [set` i] < +oo -> ((i.1 : \bar R) \is a fin_num) /\ ((i.2 : \bar R) \is a fin_num). Proof. move: i => [[ba a|[]] [bb b|[]]] /neitvP //=; do ?by rewrite ?set_itvE ?eqxx. -by move=> _; rewrite hlength_itv /= ltry. -by move=> _; rewrite hlength_itv /= ltNye. -by move=> _; rewrite hlength_itv. +by move=> _; rewrite wlength_itv /= ltry. +by move=> _; rewrite wlength_itv /= ltNye. +by move=> _; rewrite wlength_itv. Qed. -Lemma finite_hlengthE i : neitv i -> hlength [set` i] < +oo -> - hlength [set` i] = (fine (g i.2))%:E - (fine (g i.1))%:E. +Lemma finite_wlength_itv i : neitv i -> wlength [set` i] < +oo -> + wlength [set` i] = (fine (g i.2))%:E - (fine (g i.1))%:E. Proof. -move=> i0 ioo; have [i1f i2f] := hlength_finite_fin_num i0 ioo. +move=> i0 ioo; have [i1f i2f] := wlength_finite_fin_num i0 ioo. rewrite fineK; last first. by rewrite /g; move: i2f; case: (ereal_of_itv_bound i.2). rewrite fineK; last first. by rewrite /g; move: i1f; case: (ereal_of_itv_bound i.1). -rewrite hlength_itv; case: ifPn => //; rewrite -leNgt le_eqVlt => /predU1P[->|]. +rewrite wlength_itv; case: ifPn => //; rewrite -leNgt le_eqVlt => /predU1P[->|]. by rewrite subee// /g; move: i1f; case: (ereal_of_itv_bound i.1). by move/lt_ereal_bnd/ltW; rewrite leNgt; move: i0 => /neitvP => ->. Qed. -Lemma hlength_itv_bnd (a b : R) (x y : bool) : (a <= b)%R -> - hlength [set` Interval (BSide x a) (BSide y b)] = (f b - f a)%:E. +Lemma wlength_itv_bnd (a b : R) (x y : bool) : (a <= b)%R -> + wlength [set` Interval (BSide x a) (BSide y b)] = (f b - f a)%:E. Proof. -move=> ab; rewrite hlength_itv/= lte_fin lt_neqAle ab andbT. +move=> ab; rewrite wlength_itv/= lte_fin lt_neqAle ab andbT. by have [-> /=|/= ab'] := eqVneq a b; rewrite ?subrr// EFinN EFinB. Qed. -Lemma hlength_infty_bnd b r : - hlength [set` Interval -oo%O (BSide b r)] = +oo :> \bar R. -Proof. by rewrite hlength_itv /= ltNye. Qed. +Lemma wlength_infty_bnd b r : + wlength [set` Interval -oo%O (BSide b r)] = +oo :> \bar R. +Proof. by rewrite wlength_itv /= ltNye. Qed. -Lemma hlength_bnd_infty b r : - hlength [set` Interval (BSide b r) +oo%O] = +oo :> \bar R. -Proof. by rewrite hlength_itv /= ltey. Qed. +Lemma wlength_bnd_infty b r : + wlength [set` Interval (BSide b r) +oo%O] = +oo :> \bar R. +Proof. by rewrite wlength_itv /= ltey. Qed. -Lemma pinfty_hlength i : hlength [set` i] = +oo -> +Lemma pinfty_wlength_itv i : wlength [set` i] = +oo -> (exists s r, i = Interval -oo%O (BSide s r) \/ i = Interval (BSide s r) +oo%O) \/ i = `]-oo, +oo[. Proof. -rewrite hlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. +rewrite wlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. - by case: ifPn. - by left; exists ba, a; right. - by left; exists bb, b; left. - by right. Qed. -Lemma hlength_itv_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : - 0 <= hlength [set` i]. +Lemma wlength_itv_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : + 0 <= wlength [set` i]. Proof. -rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. +rewrite wlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. - by rewrite suber_ge0// => /ltW /(le_er_map ndf). - by rewrite ltNge leey. - by case: (i.2 : \bar _) => //= [r _]; rewrite leey. Qed. -Lemma hlength_Rhull (A : set R) : hlength [set` Rhull A] = hlength A. -Proof. by rewrite /hlength Rhull_involutive. Qed. +Lemma wlength_Rhull (A : set R) : wlength [set` Rhull A] = wlength A. +Proof. by rewrite /wlength Rhull_involutive. Qed. -Lemma le_hlength_itv (ndf : {homo f : x y / (x <= y)%R}) i j : - {subset i <= j} -> hlength [set` i] <= hlength [set` j]. +Lemma le_wlength_itv (ndf : {homo f : x y / (x <= y)%R}) i j : + {subset i <= j} -> wlength [set` i] <= wlength [set` j]. Proof. set I := [set` i]; set J := [set` j]. -have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_itv_ge0. +have [->|/set0P I0] := eqVneq I set0; first by rewrite wlength0 wlength_itv_ge0. have [J0|/set0P J0] := eqVneq J set0. by move/subset_itvP; rewrite -/J J0 subset0 -/I => ->. move=> /subset_itvP ij; apply: lee_sub => /=. @@ -283,27 +285,27 @@ move=> r [r' Ir' <-{r}]; exists (- r')%R. by split => //; exists r' => //; apply: ij. Qed. -Lemma le_hlength (ndf : {homo f : x y / (x <= y)%R}) : - {homo hlength : A B / A `<=` B >-> A <= B}. +Lemma le_wlength (ndf : {homo f : x y / (x <= y)%R}) : + {homo wlength : A B / A `<=` B >-> A <= B}. Proof. -move=> a b /le_Rhull /(le_hlength_itv ndf). -by rewrite (hlength_Rhull a) (hlength_Rhull b). +move=> a b /le_Rhull /(le_wlength_itv ndf). +by rewrite (wlength_Rhull a) (wlength_Rhull b). Qed. -End hlength. +End wlength. -Section hlength_extension. +Section wlength_extension. Context {R : realType}. -Lemma hlength_semi_additive (f : R -> R) : semi_additive (hlength f). +Lemma wlength_semi_additive (f : R -> R) : semi_additive (wlength f). Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. -rewrite hlength_itv ?lte_fin/= -EFinB. +rewrite wlength_itv ?lte_fin/= -EFinB. case: ifPn => a12; last first. - pose I i := `](b i).1, (b i).2]%classic. + pose I i := `](b i).1, (b i).2]%classic. rewrite set_itv_ge//= -(bigcup_mkord _ I) /I => /bigcup0P I0. - by under eq_bigr => i _ do rewrite I0//= hlength0; rewrite big1. + by under eq_bigr => i _ do rewrite I0//= wlength0; rewrite big1. set A := `]a1, a2]%classic. rewrite -bigcup_pred; set P := xpredT; rewrite (eq_bigl P)//. move: P => P; have [p] := ubnP #|P|; elim: p => // p IHp in P a2 a12 A *. @@ -316,28 +318,28 @@ have {}a2bi : a2 = (b i).2. suff: A (b i).2 by move=> /itvP->. by rewrite AE; exists i=> //=; rewrite in_itv/= lexx andbT. rewrite {a2}a2bi in a12 A AE *. -rewrite (bigD1 i)//= hlength_itv ?lte_fin/= bi !EFinD -addeA. +rewrite (bigD1 i)//= wlength_itv ?lte_fin/= bi !EFinD -addeA. congr (_ + _)%E; apply/eqP; rewrite addeC -sube_eq// 1?adde_defC//. rewrite ?EFinN oppeK addeC; apply/eqP. -case: (eqVneq a1 (b i).1) => a1bi. +have [a1bi|a1bi] := eqVneq a1 (b i).1. rewrite {a1}a1bi in a12 A AE {IHp} *; rewrite subee ?big1// => j. - move=> /andP[Pj Nji]; rewrite hlength_itv ?lte_fin/=; case: ifPn => bj//. + move=> /andP[Pj Nji]; rewrite wlength_itv ?lte_fin/=; case: ifPn => bj//. exfalso; have /trivIsetP/(_ j i I I Nji) := Itriv. pose m := ((b j).1 + (b j).2) / 2%:R. have mbj : `](b j).1, (b j).2]%classic m. by rewrite /= !in_itv/= ?(midf_lt, midf_le)//= ltW. rewrite -subset0 => /(_ m); apply; split=> //. - by suff: A m by []; rewrite AE; exists j => //. + by suff: A m by []; rewrite AE; exists j. have a1b2 j : P j -> (b j).1 < (b j).2 -> a1 <= (b j).2. move=> Pj bj; suff /itvP-> : A (b j).2 by []. - by rewrite AE; exists j => //=; rewrite ?in_itv/= bj//=. + by rewrite AE; exists j => //=; rewrite ?in_itv/= bj/=. have a1b j : P j -> (b j).1 < (b j).2 -> a1 <= (b j).1. move=> Pj bj; case: ltP=> // bj1a. suff : A a1 by rewrite /A/= in_itv/= ltxx. by rewrite AE; exists j; rewrite //= in_itv/= bj1a//= a1b2. have bbi2 j : P j -> (b j).1 < (b j).2 -> (b j).2 <= (b i).2. move=> Pj bj; suff /itvP-> : A (b j).2 by []. - by rewrite AE; exists j => //=; rewrite ?in_itv/= bj//=. + by rewrite AE; exists j => //=; rewrite ?in_itv/= bj/=. apply/IHp. - by rewrite lt_neqAle a1bi/= a1b. - rewrite (leq_trans _ cP)// -(cardID (pred1 i) P). @@ -360,22 +362,22 @@ apply/andP; split=> //; apply: contraTneq xbj => ->. by rewrite in_itv/= le_gtF// (itvP xabi). Qed. -Lemma hlength_ge0 (f : cumulative R) (I : set (ocitv_type R)) : - (0 <= hlength f I)%E. +Lemma wlength_ge0 (f : cumulative R) (I : set (ocitv_type R)) : + (0 <= wlength f I)%E. Proof. -by rewrite -(hlength0 f) le_hlength//; exact: cumulative_is_nondecreasing. +by rewrite -(wlength0 f) le_wlength//; exact: cumulative_is_nondecreasing. Qed. -#[local] Hint Extern 0 (0%:E <= hlength _ _) => solve[apply: hlength_ge0] : core. +#[local] Hint Extern 0 (0%:E <= wlength _ _) => solve[apply: wlength_ge0] : core. HB.instance Definition _ (f : cumulative R) := - isContent.Build _ _ R (hlength f) - (hlength_ge0 f) - (hlength_semi_additive f). + isContent.Build _ _ R (wlength f) + (wlength_ge0 f) + (wlength_semi_additive f). Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. -Lemma hlength_content_sub_fsum (f : cumulative R) (D : {fset nat}) a0 b0 +Lemma cumulative_content_sub_fsum (f : cumulative R) (D : {fset nat}) a0 b0 (a b : nat -> R) : (forall i, i \in D -> a i <= b i) -> `]a0, b0] `<=` \big[setU/set0]_(i <- D) `]a i, b i]%classic -> f b0 - f a0 <= \sum_(i <- D) (f (b i) - f (a i)). @@ -387,26 +389,26 @@ move=> Dab h; have [ab|ab] := leP a0 b0; last first. by rewrite subr_ge0 cumulative_is_nondecreasing// Dab. have mab k : [set` D] k -> R.-ocitv.-measurable `]a k, b k]%classic by []. move: h; rewrite -bigcup_fset. -move/(@content_sub_fsum _ R _ [the content _ _ of hlength f] _ [set` D] +move/(@content_sub_fsum _ R _ [the content _ _ of wlength f] _ [set` D] `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) (finite_fset D) mab (is_ocitv _ _)) => /=. -rewrite hlength_itv_bnd// -lee_fin => /le_trans; apply. +rewrite wlength_itv_bnd// -lee_fin => /le_trans; apply. rewrite -sumEFin fsbig_finite//= set_fsetK// big_seq [in X in (_ <= X)%E]big_seq. -by apply: lee_sum => i iD; rewrite hlength_itv_bnd// Dab. +by apply: lee_sum => i iD; rewrite wlength_itv_bnd// Dab. Qed. -Lemma hlength_sigma_sub_additive (f : cumulative R) : - sigma_sub_additive (hlength f). +Lemma wlength_sigma_sub_additive (f : cumulative R) : + sigma_sub_additive (wlength f). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. -move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. +move=> [a _ <-]; rewrite wlength_itv ?lte_fin/= -EFinB => lebig. case: ifPn => a12; last by rewrite nneseries_esum ?esum_ge0. wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. move=> /= h. set A' := fun n => if (b n).1 >= (b n).2 then set0 else A n. set b' := fun n => if (b n).1 >= (b n).2 then (0, 0) else b n. - rewrite [X in (_ <= X)%E](_ : _ = \sum_(n k. + rewrite [X in (_ <= X)%E](_ : _ = \sum_(n k. rewrite /= /A' AE; case: ifPn => // bn. by rewrite set_itv_ge//= bnd_simp -leNgt. apply: (h b'). @@ -443,7 +445,7 @@ move=> /(_ _ _ _ obd acbd){obd acbd}. case=> X _ acXbd. rewrite /cover in acXbd. rewrite -EFinD. -apply: (@le_trans _ _ (\sum_(i <- X) (hlength f `](b i).1, (b i).2]%classic) + +apply: (@le_trans _ _ (\sum_(i <- X) (wlength f `](b i).1, (b i).2]%classic) + \sum_(i <- X) (f ((b i).2 + (D i)%:num)%R - f (b i).2)%:E)%E). apply: (@le_trans _ _ (f a.2 - f (a.1 + c%:num / 2))%:E). rewrite lee_fin -addrA -opprD ler_sub// (le_trans _ ce)//. @@ -451,16 +453,15 @@ apply: (@le_trans _ _ (\sum_(i <- X) (hlength f `](b i).1, (b i).2]%classic) + by rewrite ler_add2l ler_pdivr_mulr// ler_pmulr// ler1n. apply: (@le_trans _ _ (\sum_(i <- X) (f ((b i).2 + (D i)%:num) - f (b i).1)%:E)%E). - rewrite sumEFin lee_fin hlength_content_sub_fsum//. + rewrite sumEFin lee_fin cumulative_content_sub_fsum//. by move=> k kX; rewrite (@le_trans _ _ (b k).2)// ler_addl. apply: subset_trans. exact/(subset_trans _ acXbd)/subset_itv_oc_cc. move=> x [k kX] kx; rewrite -bigcup_fset; exists k => //. by move: x kx; exact: subset_itv_oo_oc. rewrite addeC -big_split/=; apply: lee_sum => k _. - by rewrite !(EFinB, hlength_itv_bnd)// addeA subeK. -rewrite -big_split/= nneseries_esum//; last first. - by move=> k _; rewrite adde_ge0// hlength_ge0'. + by rewrite !(EFinB, wlength_itv_bnd)// addeA subeK. +rewrite -big_split/= nneseries_esum//; last by move=> k _; rewrite adde_ge0. rewrite esum_ge//; exists [set` X] => //; rewrite fsbig_finite//= set_fsetK. rewrite big_seq [in X in (_ <= X)%E]big_seq; apply: lee_sum => k kX. by rewrite AE lee_add2l// lee_fin ler_subl_addl natrX De. @@ -468,10 +469,10 @@ Qed. HB.instance Definition _ (f : cumulative R) := Content_SubSigmaAdditive_isMeasure.Build _ _ _ - (hlength f) (hlength_sigma_sub_additive f). + (wlength f) (wlength_sigma_sub_additive f). -Lemma hlength_sigma_finite (f : R -> R) : - sigma_finite [set: (ocitv_type R)] (hlength f). +Lemma wlength_sigma_finite (f : R -> R) : + sigma_finite [set: (ocitv_type R)] (wlength f). Proof. exists (fun k => `](- k%:R), k%:R]%classic). apply/esym; rewrite -subTset => /= x _ /=. @@ -481,12 +482,12 @@ exists (fun k => `](- k%:R), k%:R]%classic). rewrite [ltRHS]ger0_norm//. by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. by rewrite addr_ge0// -Rfloor0 le_Rfloor. -move=> k; split => //; rewrite hlength_itv /= -EFinB. +move=> k; split => //; rewrite wlength_itv /= -EFinB. by case: ifP; rewrite ltey. Qed. Definition lebesgue_stieltjes_measure (f : cumulative R) := - measure_extension [the measure _ _ of hlength f]. + measure_extension [the measure _ _ of wlength f]. HB.instance Definition _ (f : cumulative R) := Measure.on (lebesgue_stieltjes_measure f). @@ -494,10 +495,26 @@ HB.instance Definition _ (f : cumulative R) := does not seem to allow, try to change asap *) Lemma sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : sigma_finite setT (lebesgue_stieltjes_measure f). -Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. +Proof. exact/measure_extension_sigma_finite/wlength_sigma_finite. Qed. HB.instance Definition _ (f : cumulative R) := @isSigmaFinite.Build _ _ _ (lebesgue_stieltjes_measure f) (sigmaT_finite_lebesgue_stieltjes_measure f). -End hlength_extension. +End wlength_extension. Arguments lebesgue_stieltjes_measure {R}. + +Section lebesgue_stieltjes_measure. +Variable R : realType. +Let gitvs := [the measurableType _ of salgebraType (@ocitv R)]. + +Lemma lebesgue_stieltjes_measure_unique (f : cumulative R) + (mu : {measure set gitvs -> \bar R}) : + (forall X, ocitv X -> lebesgue_stieltjes_measure f X = mu X) -> + forall X, measurable X -> lebesgue_stieltjes_measure f X = mu X. +Proof. +move=> muE X mX; apply: measure_extension_unique => //=. + exact: wlength_sigma_finite. +by move=> A mA; rewrite -muE// -measurable_mu_extE. +Qed. + +End lebesgue_stieltjes_measure. From d67d3345d1a19825838020ed37dd32d87a558932 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 23 Oct 2023 16:23:48 +0900 Subject: [PATCH 19/19] fix doc --- theories/lebesgue_stieltjes_measure.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index cee6d1efa4..4414860f1c 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -26,7 +26,7 @@ Require Import real_interval measure realfun. (* x and y are real numbers *) (* R.-ocitv == display for ocitv_type R *) (* R.-ocitv.-measurable == semiring of sets of open-closed intervals *) -(* hlength f A := f b - f a with the hull of the set of real *) +(* wlength f A := f b - f a with the hull of the set of real *) (* numbers A being delimited by a and b *) (* lebesgue_stieltjes_measure f == Lebesgue-Stieltjes measure for f *) (* f is a cumulative function. *)