diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index d2d0ed195d..eee3614a7c 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -47,6 +47,16 @@ + definitions `next_prime`, `prime_seq` + lemmas `leq_prime_seq`, `mem_prime_seq` + theorem `dvg_sum_inv_prime_seq` +- new directory `theories/measure_theory` with new files: + + `measurable_structure.v` + + `measure_function.v` + + `counting_measure.v` + + `dirac_measure.v` + + `probability_measure.v` + + `measure_negligible.v` + + `measure_extension.v` + + `measurable_function.v` + + `measure.v` ### Changed @@ -61,6 +71,238 @@ - moved from `vitali_lemma.v` to `pseudometric_normed_Zmodule.v` and renamed: + `closure_ball` -> `closure_ballE` +- moved from `theories/measure.v` (now removed) + + to `sequences.v`: + * lemmas `epsilon_trick`, `epsilon_trick0` + + to `measure_theory/measurable_structure.v`: + * definitions `setC_closed`, `setI_closed`, `setU_closed`, `setSD_closed`, + `setD_closed`, `setY_closed`, `fin_bigcap_closed`, `finN0_bigcap_closed`, + `fin_bigcup_closed`, `semi_setD_closed` + * lemma `setD_semi_setD_closed` + * definitions `ndseq_closed`, `niseq_closed`, `trivIset_closed`, `fin_trivIset_closed`, + `setring`, `sigma_ring`, `sigma_algebra`, `dynkin`, `lambda_system`, + `monotone` + * lemmas `powerset_sigma_ring`, `powerset_lambda_system` + * notations `<>`, `<>`, `<>`, `<>`, `<>`, + `<>`, `<>`, `<>` + * lemmas `lambda_system_smallest`, `fin_bigcup_closedP`, `finN0_bigcap_closedP`, + `setD_closedP`, `sigma_algebra_bigcap`, `sigma_algebraP`, `smallest_sigma_algebra`, + `sub_sigma_algebra2`, `sigma_algebra_id`, `sub_sigma_algebra`, + `sigma_algebra0`, `sigma_algebraCD`, `sigma_algebra_bigcup`, + `smallest_setring`, `sub_setring2`, `setring_id`, `sub_setring`, + `setring0`, `setringD`, `setringU`, `setring_fin_bigcup`, `g_sigma_algebra_lambda_system`, + `smallest_sigma_ring`, `sigma_ring_monotone`, `g_sigma_ring_monotone`, + `sub_g_sigma_ring`, `setring_monotone_sigma_ring`, `g_monotone_monotone`, + `g_monotone_setring`, `g_monotone_g_sigma_ring`, `monotone_setring_sub_g_sigma_ring`, + `smallest_lambda_system`, `lambda_system_subset`, `dynkinT`, `dynkinC`, + `dynkinU`, `dynkin_lambda_system`, `g_dynkin_dynkin`, `sigma_algebra_dynkin`, + `dynkin_setI_sigma_algebra`, `setI_closed_g_dynkin_g_sigma_algebra` + * definition `strace` + * lemmas `subset_strace`, `g_sigma_ring_strace`, `strace_sigma_ring`, + `setI_g_sigma_ring`, `sigma_algebra_strace` + * mixin `isSemiRingOfSets`, structure `SemiRingOfSets`, + notation `semiRingOfSetsType` + * lemma `measurable_curry` + * notations `.-measurable`, `'measurable` + * mixin `SemiRingOfSets_isRingOfSets`, structure `RingOfSets`, + notation `ringOfSetsType` + * mixin `RingOfSets_isAlgebraOfSets`, structure `AlgebraOfSets`, + notation `algebraOfSetsType` + * mixin `hasMeasurableCountableUnion` + * structure `SigmaRing`, structure `SigmaRing`, notation `sigmaRingType` + * factory `isSigmaRing` + * structure `Measurable`, notation `measurableType` + * factories `isRingOfSets`, `isRingOfSets_setY`, `isAlgebraOfSets`, + `isAlgebraOfSets_setD`, `isMeasurable` + * lemmas `bigsetU_measurable`, `fin_bigcup_measurable`, `measurableD`, + `seqDU_measurable`, ` measurableC`, `bigsetI_measurable`, `fin_bigcap_measurable`, + `measurableID`, `bigcup_measurable`, `bigcap_measurable`, `bigcapT_measurable`, + `countable_measurable`, `sigmaRingType_lambda_system`, `countable_bigcupT_measurable`, + `bigcupT_measurable_rat`, `sigma_algebra_measurable`, `bigcap_measurableType` + * definition `discrete_measurable` + * lemmas `discrete_measurable0`, `discrete_measurableC`, `discrete_measurableU` + * definitions `sigma_display`, `g_sigma_algebraType` + * lemmas `sigma_algebraC` + * notations `.-sigma`, `.-sigma.-measurable` + * lemma `measurable_g_measurableTypeE` + * definition `preimage_set_system` + * lemmas `preimage_set_system0`, `preimage_set_systemU`, `preimage_set_system_comp`, + `preimage_set_system_id`, `sigma_algebra_preimage` + * definition `image_set_system` + * lemmas `sigma_algebra_image`, `g_sigma_preimageE` + * definition `subset_sigma_subadditive` + * lemmas `big_trivIset` + * definition `covered_by` + * lemmas `covered_bySr`, `covered_byP`, `covered_by_finite`, `covered_by_countable`, + `measurable_uncurry` + * definition `g_sigma_preimageU` + * lemmas `g_sigma_preimageU_comp` + * definition `measure_prod_display` + * notation `.-prod`, `.-prod.-measurable` + * lemmas `measurableX`, `measurable_prod_measurableType`, + `measurable_prod_g_measurableTypeR`, `measurable_prod_g_measurableType` + * definition `g_sigma_preimage` + * lemma `g_sigma_preimage_comp` + * definition `measure_tuple_display` + * definition `measure_dominates`, notation ``` `<< ``` + * lemma `measure_dominates_trans` + + to `measure_theory/measure_function.v`: + * definitions `semi_additive2`, `semi_additive`, `semi_sigma_additive`, + `additive2`, `additive`, `sigma_additive`, `subadditive`, + `measurable_subset_sigma_subadditive` + * lemma `semi_additiveW` + * lemmas `semi_additiveE`, `semi_additive2E`, `additive2P` + * lemmas `semi_sigma_additive_is_additive`, `semi_sigma_additiveE`, + `sigma_additive_is_additive` + * mixin `isContent`, structure `Content`, notation `{content set _ -> \bar _}` + * lemma `content_inum_subproof` + * lemmas `measure0`, `measure_gt0`, `measure_semi_additive_ord`, + `measure_semi_additive_ord_I`, `content_fin_bigcup`, `measure_semi_additive2` + * lemmas `measureU`, `measure_bigsetU`, `measure_fin_bigcup`, + `measure_bigsetU_ord_cond`, `measure_bigsetU_ord`, `measure_fbigsetU` + * mixin `Content_isMeasure` + * structure `Measure`, notations `measure`, + `{measure set _ -> \bar _}` + * lemma `measure_inum_subproof` + * factory `isMeasure`, lemma `eq_measure` + * lemmma `measure_semi_bigcup` + * lemmas `measure_sigma_additive`, `measure_bigcup` + * definition `msum` + * definition `mzero`, lemma `msum_mzero` + * definition `measure_add`, `measure_addE` + * definition `mscale` + * definition `mseries` + * definition `pushforward` + * module `SetRing` + * notations `.-ring`, `.-ring.-measurable` + * lemmas `le_measure`, `measure_le0` + * lemmas `content_subadditive`, `content_sub_fsum` + * lemmas `content_ring_sup_sigma_additive`, `content_ring_sigma_additive` + * lemmas `ring_sigma_subadditive`, `ring_semi_sigma_additive`, + `semiring_sigma_additive` + * factory `Content_SigmaSubAdditive_isMeasure` + * lemma `measure_sigma_subadditive` + * lemma `measure_sigma_subadditive_tail` + * definition `fin_num_fun` + * lemmas `fin_num_fun_lty`, `lty_fin_num_fun` + * definitions `sfinite_measure`, `sigma_finite` + * lemma `fin_num_fun_sigma_finite` + * definition `mrestr` + * lemma `sfinite_measure_sigma_finite` + * mixin `isSFinite`, structure `SFiniteMeasure`, + notation `{sfinite_measure set _ -> \bar _}` + * mixin `isSigmaFinite`, structure `SigmaFiniteContent`, + notation `sigma_finite_content`, `{sigma_finite_content set _ -> \bar _}` + * structure `SigmaFiniteMeasure`, notations `sigma_finite_measure`, + `{sigma_finite_measure set _ -> \bar _}` + * factory `Measure_isSigmaFinite` + * lemmas `sigma_finite_mzero`, `sfinite_mzero` + * mixin `isFinite`, structures `FinNumFun`, `FiniteMeasure`, + notation `{finite_measure set _ -> \bar _}` + * factories `Measure_isFinite`, `Measure_isSFinite` + * definition `sfinite_measure_seq` + * lemma `sfinite_measure_seqP` + * definition `mfrestr` + * lemmas `measureIl`, `measureIr`, `subset_measure0` + * lemmas `measureDI`, `measureD`, `measureU2` + * lemmas `measureUfinr`, `measureUfinl`, `null_set_setU`, `measureU0` + * lemma `eq_measureU` + * lemma `g_sigma_algebra_measure_unique_trace` + * lemmas `nondecreasing_cvg_mu`, `nonincreasing_cvg_mu` + * definition `lim_sup_set` + * lemmas `lim_sup_set_ub`, `lim_sup_set_cvg` + * lemma `lim_sup_set_cvg0` + * theorem `Boole_inequality` + * lemma `sigma_finiteP` + * theorem `generalized_Boole_inequality` + * lemmas `g_sigma_algebra_measure_unique_cover`, `g_sigma_algebra_measure_unique` + * lemma `measure_unique` + + to `measure_theory/counting_measure.v`: + * definition `counting` + * lemma `sigma_finite_counting` + + to `measure_theory/dirac_measure.v`: + * definition `dirac`, notation `\d_` + * lemmas `finite_card_sum`, `finite_card_dirac`, `infinite_card_dirac ` + + to `measure_theory/probability_measure.v`: + * mixin `isSubProbability`, structure `SubProbability`, notation `subprobability` + * factory `Measure_isSubProbability` + * mixin `isProbability`, structure `Probability`, notation `probability` + * lemmas `probability_le1`, `probability_setC` + * factory `Measure_isProbability` + * definition `mnormalize` + * lemmas `mnormalize_id` + * definitions `mset`, `pset`, `pprobability` + * lemmas `lt0_mset`, `gt1_mset` + + to `measure_theory/measure_negligible.v`: + * definition `negligible`, notation `.-negligible` + * lemmas `negligibleP`, `negligible_set0`, `measure_negligible`, `negligibleS`, + `negligibleI` + * definition `measure_is_complete` + * lemmas `negligibleU`, `negligible_bigsetU`, `negligible_bigcup` + * definition `almost_everywhere`, `ae_filter_ringOfSetsType`, + `ae_properfilter_algebraOfSetsType` + * definition `ae_eq`, notations `{ae _, _}`, `\forall _ \ae _, _`, + `_ = _ [%ae _ in _]`, `_ = _ %[ae _]` + * lemmas `measure0_ae`, `aeW` + * instance `ae_eq_equiv` + * instances `comp_ae_eq`, `comp_ae_eq2`, `comp_ae_eq2'`, `sub_ae_eq2` + * lemmas `ae_eq0`, `ae_eq_refl`, `ae_eq_comp`, `ae_eq_comp2`, + `ae_eq_funeposneg`, `ae_eq_sym`, `ae_eq_trans`, `ae_eq_sub`, + `ae_eq_mul2r`, `ae_eq_mul2l`, `ae_eq_mul1l`, `ae_eq_abse`, `ae_foralln` + * lemmas `ae_eq_subset`, `ae_eqe_mul2l` + * lemma `measure_dominates_ae_eq` + + to `measure_theory/measure_extension.v`: + * definitions `sigma_subadditive`, `subset_sigma_subadditive` + * mixin `isOuterMeasure`, structure `OuterMeasure` + * notation `{outer_measure set _ -> \bar _}` + * factory `isSubsetOuterMeasure` + * lemmas `outer_measure_sigma_subadditive_tail`, `outer_measure_subadditive`, + `outer_measureU2`, `le_outer_measureIC` + * definition `caratheodory_measurable`, notation `.-caratheodory` + * lemma `le_caratheodory_measurable` + * lemmas `outer_measure_bigcup_lim`, `caratheodory_measurable_set0`, + `caratheodory_measurable_setC`, `caratheodory_measurable_setU_le`, + `caratheodory_measurable_setU`, `caratheodory_measurable_bigsetU`, + `caratheodory_measurable_setI`, `caratheodory_measurable_setD`, + `disjoint_caratheodoryIU`, `caratheodory_additive`, `caratheodory_lime_le`, + `caratheodory_measurable_trivIset_bigcup`, `caratheodory_measurable_bigcup` + * definition `caratheodory_type`, notation `.-cara.-measurable` + * definition `caratheodory_display`, notation `.-cara` + * lemmas `caratheodory_measure0`, `caratheodory_measure_ge0`, + `caratheodory_measure_sigma_additive`, `measure_is_complete_caratheodory` + * definition `measurable_cover`, lemmas `cover_measurable`, `cover_subset` + * definition `mu_ext`, notation `^*` + * lemmas `le_mu_ext`, `mu_ext_ge0`, `mu_ext0`, `mu_ext_sigma_subadditive` + * lemmas `Rmu_ext`, `measurable_mu_extE`, `measurable_Rmu_extE` + * lemma `sub_caratheodory` + * definition `measure_extension` + * lemmas `measure_extension_sigma_finite`, `measure_extension_unique` + * lemma `caratheodory_measurable_mu_ext` + * definition `completed_measure_extension` + * lemma `completed_measure_extension_sigma_finite` + + to `measure_theory/measurable_function.v`: + * mixin `isMeasurableFun`, structure `MeasurableFun`, notations `{mfun _ >-> _}`, + `[mfun of _]` + * lemmas `measurable_funP`, `measurable_funPTI` + * definitions `mfun`, `mfun_key`, canonical `mfun_keyed` + * lemmas `measurable_id`, `measurable_comp`, `eq_measurable_fun`, + `measurable_fun_eqP`, `measurable_cst`, `measurable_fun_bigcup`, + `measurable_funU`, `measurable_funS`, `measurable_fun_if`, + `measurable_fun_set0`, `measurable_fun_set1` + * definitions `mfun_Sub_subproof`, `mfun_Sub` + * lemmas `mfun_rect`, `mfun_val`, `mfuneqP` + * lemmas `measurableT_comp`, `measurable_funTS`, `measurable_restrict`, + `measurable_restrictT`, `measurable_fun_ifT`, `measurable_fun_bool`, + `measurable_and`, `measurable_neg`, `measurable_or` + * lemmas `preimage_set_system_measurable_fun`, `measurability` + * lemmas `measurable_fun_pairP`, `measurable_fun_pair` + * lemmas `measurable_fst`, `measurable_snd`, `measurable_swap` + * lemmas `measurable_tnth`, `measurable_fun_tnthP`, `measurable_cons` + * lemmas `measurable_behead`, `measurable_fun_if_pair` + * lemmas `pair1_measurable`, `pair2_measurable` + * lemmas `measurable_xsection`, `measurable_ysection`, + `measurable_fun_pair1`, `measurable_fun_pair2` + ### Renamed ### Generalized @@ -84,6 +326,10 @@ - in file `all_reals.v` + export of `interval_inference` (now in mathcomp-algebra, but not automatically exported) +- file `theories/measure.v` +- notations `[measure of _]`, `[measure of _]` +- notations `[content of _]`, `[content of _]` +- notations `[outer_measure of _]`, `[outer_measure of _]` ### Infrastructure diff --git a/_CoqProject b/_CoqProject index afa7fd3af3..4a35dbab15 100644 --- a/_CoqProject +++ b/_CoqProject @@ -39,7 +39,8 @@ experimental_reals/realsum.v experimental_reals/distr.v reals_stdlib/Rstruct.v reals_stdlib/nsatz_realtype.v -theories/all_analysis.v + +theories/ereal.v theories/landau.v theories/topology_theory/topology.v @@ -70,7 +71,6 @@ theories/homotopy_theory/continuous_path.v theories/ess_sup_inf.v theories/function_spaces.v -theories/ereal.v theories/cantor.v theories/tvs.v @@ -89,12 +89,22 @@ theories/sequences.v theories/exp.v theories/trigo.v theories/esum.v -theories/measurable_realfun.v -theories/lebesgue_measure.v -theories/lebesgue_stieltjes_measure.v theories/derive.v -theories/measure.v theories/numfun.v + +theories/measure_theory/measurable_structure.v +theories/measure_theory/measure_function.v +theories/measure_theory/counting_measure.v +theories/measure_theory/dirac_measure.v +theories/measure_theory/probability_measure.v +theories/measure_theory/measure_negligible.v +theories/measure_theory/measure_extension.v +theories/measure_theory/measurable_function.v +theories/measure_theory/measure.v + +theories/measurable_realfun.v +theories/lebesgue_stieltjes_measure.v +theories/lebesgue_measure.v theories/borel_hierarchy.v theories/lebesgue_integral_theory/simple_functions.v @@ -118,7 +128,11 @@ theories/charge.v theories/kernel.v theories/pi_irrational.v theories/gauss_integral.v + +theories/all_analysis.v + theories/showcase/summability.v theories/showcase/pnt.v + analysis_stdlib/Rstruct_topology.v analysis_stdlib/showcase/uniform_bigO.v diff --git a/classical/boolp.v b/classical/boolp.v index 6bfbff0120..90ecf0ead1 100644 --- a/classical/boolp.v +++ b/classical/boolp.v @@ -521,11 +521,11 @@ Lemma notB : ((~ True) = False) * ((~ False) = True). Proof. by rewrite /not; split; eqProp. Qed. Lemma andB : left_id True and * right_id True and - * (left_zero False and * right_zero False and * idempotent and). + * (left_zero False and * right_zero False and * idempotent_op and). Proof. by do ![split] => /PropB[]; eqProp=> // -[]. Qed. Lemma orB : left_id False or * right_id False or - * (left_zero True or * right_zero True or * idempotent or). + * (left_zero True or * right_zero True or * idempotent_op or). Proof. do ![split] => /PropB[]; eqProp=> -[] //; by [left | right]. Qed. Lemma implyB : let imply (P Q : Prop) := P -> Q in diff --git a/classical/classical_sets.v b/classical/classical_sets.v index 796d671fec..7f9233cbc7 100644 --- a/classical/classical_sets.v +++ b/classical/classical_sets.v @@ -637,7 +637,7 @@ Proof. by move=> A B C; rewrite setIC setICA setIA. Qed. Lemma setIACA : @interchange (set T) setI setI. Proof. by move=> A B C D; rewrite -setIA [B `&` _]setICA setIA. Qed. -Lemma setIid : idempotent (@setI T). +Lemma setIid : idempotent_op (@setI T). Proof. by move=> A; rewrite predeqE => ?; split=> [[]|]. Qed. Lemma setIIl A B C : A `&` B `&` C = (A `&` C) `&` (B `&` C). @@ -691,7 +691,7 @@ Proof. by move=> A B C; rewrite setUC setUCA setUA. Qed. Lemma setUACA : @interchange (set T) setU setU. Proof. by move=> A B C D; rewrite -setUA [B `|` _]setUCA setUA. Qed. -Lemma setUid : idempotent (@setU T). +Lemma setUid : idempotent_op (@setU T). Proof. move=> p; rewrite /setU/mkset predeqE => a; tauto. Qed. Lemma setUUl A B C : A `|` B `|` C = (A `|` C) `|` (B `|` C). @@ -3167,12 +3167,12 @@ Lemma joinIB A B : (A `&` B) `|` A `\` B = A. Proof. by rewrite setUC -setDDr setDv setD0. Qed. #[export] -HB.instance Definition _ := - Order.hasRelativeComplement.Build set_display (set T) subKI joinIB. +HB.instance Definition _ := Order.BDistrLattice_hasSectionalComplement.Build + set_display (set T) subKI joinIB. #[export] -HB.instance Definition _ := Order.hasComplement.Build set_display (set T) - (fun x => esym (setTD x)). +HB.instance Definition _ := Order.CBDistrLattice_hasComplement.Build + set_display (set T) (fun x => esym (setTD x)). End SetOrder. Module Exports. HB.reexport. End Exports. diff --git a/reals/real_interval.v b/reals/real_interval.v index 2343f4190f..8ea49a4845 100644 --- a/reals/real_interval.v +++ b/reals/real_interval.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import fingroup perm rat archimedean finmap. From mathcomp Require Import boolp classical_sets functions. @@ -306,7 +306,7 @@ apply eq_bigcupr => k _; apply/seteqP; split=> [_/= [y ysr] <-|x/= xsr]. by exists (- x); rewrite ?oppr_itv//= opprK// negbK opprB opprK addrC. Qed. -Lemma itv_bndy_bigcup_BLeft_shift {R : archiDomainType} b (x : R) n: +Lemma itv_bndy_bigcup_BLeft_shift {R : archiRealDomainType} b (x : R) n: [set` Interval (BSide b x) +oo%O] = \bigcup_i [set` Interval (BSide b x) (BLeft (x + (i + n)%:R))]. Proof. @@ -316,7 +316,7 @@ move=> xy; exists (trunc (y - x)).+1 => //=. by rewrite in_itv/= xy/= natrD addrA ltr_wpDr// -ltrBDl truncnS_gt. Qed. -Lemma itv_bndy_bigcup_BRight (R : archiDomainType) b (x : R) : +Lemma itv_bndy_bigcup_BRight (R : archiRealDomainType) b (x : R) : [set` Interval (BSide b x) +oo%O] = \bigcup_n [set` Interval (BSide b x) (BRight (x + n%:R))]. Proof. @@ -353,7 +353,7 @@ Qed. #[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `itvNy_bnd_bigcup_BLeft`")] Notation itv_infty_bnd_bigcup := itvNy_bnd_bigcup_BLeft (only parsing). -Lemma bigcup_itvT {R : archiDomainType} b1 b2 : +Lemma bigcup_itvT {R : archiRealDomainType} b1 b2 : \bigcup_n [set` Interval (BSide b1 (- n%:R)) (BSide b2 n%:R)] = [set: R]. Proof. rewrite -subTset => x _ /=; exists (trunc `|x|).+1 => //=. diff --git a/reals/reals.v b/reals/reals.v index 87f3f09b8b..80c96fc666 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) (* -------------------------------------------------------------------- *) (* Copyright (c) - 2015--2016 - IMDEA Software Institute *) (* Copyright (c) - 2015--2018 - Inria *) @@ -119,7 +119,7 @@ End has_bound_lemmas. (* -------------------------------------------------------------------- *) -HB.mixin Record ArchimedeanField_isReal R of Num.ArchiField R := { +HB.mixin Record ArchimedeanField_isReal R of Num.ArchiRealField R := { sup_upper_bound_subdef : forall E : set R, has_sup E -> ubound E (supremum 0 E) ; sup_adherent_subdef : forall (E : set R) (eps : R), @@ -128,7 +128,7 @@ HB.mixin Record ArchimedeanField_isReal R of Num.ArchiField R := { #[short(type=realType)] HB.structure Definition Real := {R of ArchimedeanField_isReal R - & Num.ArchiField R & Num.RealClosedField R}. + & Num.ArchiRealField R & Num.RealClosedField R}. Bind Scope ring_scope with Real.sort. @@ -654,10 +654,10 @@ Qed. Section rat_in_itvoo. -Let bound_div (R : archiFieldType) (x y : R) : nat := +Let bound_div (R : archiRealFieldType) (x y : R) : nat := if y < 0 then 0%N else Num.bound (y / x). -Let archi_bound_divP (R : archiFieldType) (x y : R) : +Let archi_bound_divP (R : archiRealFieldType) (x y : R) : 0 < x -> y < x *+ bound_div x y. Proof. move=> x0; have [y0|y0] := leP 0 y; last by rewrite /bound_div y0 mulr0n. @@ -665,7 +665,7 @@ rewrite /bound_div (ltNge y 0) y0/= -mulr_natl -ltr_pdivrMr//. by rewrite archi_boundP// (divr_ge0 _(ltW _)). Qed. -Lemma rat_in_itvoo (R : archiFieldType) (x y : R) : +Lemma rat_in_itvoo (R : archiRealFieldType) (x y : R) : x < y -> exists q, ratr q \in `]x, y[. Proof. move=> xy; move: (xy); rewrite -subr_gt0. diff --git a/theories/Make b/theories/Make index 77ba626718..98c1b98895 100644 --- a/theories/Make +++ b/theories/Make @@ -9,6 +9,7 @@ ereal.v landau.v + topology_theory/topology.v topology_theory/bool_topology.v topology_theory/compact.v @@ -55,11 +56,22 @@ sequences.v exp.v trigo.v esum.v -measurable_realfun.v -lebesgue_measure.v derive.v -measure.v numfun.v + +measure_theory/measurable_structure.v +measure_theory/measure_function.v +measure_theory/counting_measure.v +measure_theory/dirac_measure.v +measure_theory/probability_measure.v +measure_theory/measure_negligible.v +measure_theory/measure_extension.v +measure_theory/measurable_function.v +measure_theory/measure.v + +measurable_realfun.v +lebesgue_stieltjes_measure.v +lebesgue_measure.v borel_hierarchy.v lebesgue_integral_theory/simple_functions.v @@ -78,7 +90,6 @@ lebesgue_integral_theory/lebesgue_integral.v ftc.v hoelder.v probability.v -lebesgue_stieltjes_measure.v convex.v charge.v kernel.v diff --git a/theories/charge.v b/theories/charge.v index 5ba168c010..137ca34abe 100644 --- a/theories/charge.v +++ b/theories/charge.v @@ -100,7 +100,8 @@ Local Open Scope classical_set_scope. Local Open Scope ereal_scope. HB.mixin Record isAdditiveCharge d (T : semiRingOfSetsType d) (R : numFieldType) - (mu : set T -> \bar R) := { charge_semi_additive : measure.semi_additive mu }. + (mu : set T -> \bar R) := + { charge_semi_additive : measure_function.semi_additive mu }. #[short(type=additive_charge)] HB.structure Definition AdditiveCharge d (T : semiRingOfSetsType d) @@ -135,7 +136,7 @@ Let finite : fin_num_fun mu. Proof. exact: charge_finite. Qed. HB.instance Definition _ := isFinite.Build d T R mu finite. -Let semi_additive : measure.semi_additive mu. +Let semi_additive : measure_function.semi_additive mu. Proof. move=> I n mI trivI mUI. rewrite (semi_sigma_additive_is_additive charge0)//. @@ -165,7 +166,7 @@ Qed. Hint Resolve charge0 : core. Lemma charge_semi_additiveW nu : - nu set0 = 0 -> measure.semi_additive nu -> semi_additive2 nu. + nu set0 = 0 -> measure_function.semi_additive nu -> semi_additive2 nu. Proof. move=> nu0 anu A B mA mB + AB; rewrite -bigcup2inE bigcup_mkord. move=> /(anu (bigcup2 A B)) ->. @@ -296,7 +297,7 @@ Qed. HB.instance Definition _ := isFinite.Build _ _ _ restr crestr_finite_measure_function. -Let crestr_semi_additive : measure.semi_additive restr. +Let crestr_semi_additive : measure_function.semi_additive restr. Proof. move=> F n mF tF mU; pose FD i := F i `&` D. have mFD i : measurable (FD i) by exact: measurableI. @@ -400,7 +401,7 @@ Proof. by move=> mU; apply: fin_numM => //; exact: fin_num_measure. Qed. HB.instance Definition _ := isFinite.Build _ _ _ cscale cscale_finite_measure_function. -Let cscale_semi_additive : measure.semi_additive cscale. +Let cscale_semi_additive : measure_function.semi_additive cscale. Proof. move=> F n mF tF mU; rewrite /cscale charge_semi_additive//. rewrite fin_num_sume_distrr// => i j _ _. diff --git a/theories/ftc.v b/theories/ftc.v index 980be4bbc9..157a707d58 100644 --- a/theories/ftc.v +++ b/theories/ftc.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2023 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import archimedean. diff --git a/theories/kernel.v b/theories/kernel.v index 1be2e0d1e7..c0caf46819 100644 --- a/theories/kernel.v +++ b/theories/kernel.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. From mathcomp Require Import archimedean. @@ -194,7 +194,7 @@ Lemma measure_fam_uubP : measure_fam_uub <-> Proof. split => [|] [r kr]; last by exists r%:num. suff r_gt0 : (0 < r)%R by exists (PosNum r_gt0). -by rewrite -lte_fin; apply: (le_lt_trans _ (kr point)). +by rewrite -lte_fin; exact: le_lt_trans (kr point). Qed. End measure_fam_uub. diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index 00719b349a..85d85f7806 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -202,7 +202,7 @@ Context {R : realType}. Notation hlength := (@hlength R). -Lemma hlength_semi_additive : measure.semi_additive hlength. +Lemma hlength_semi_additive : measure_function.semi_additive hlength. Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v index c6eb7627d8..d34eed174d 100644 --- a/theories/lebesgue_stieltjes_measure.v +++ b/theories/lebesgue_stieltjes_measure.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat archimedean. From HB Require Import structures. @@ -309,7 +309,8 @@ End wlength. Section wlength_extension. Context {R : realType}. -Lemma wlength_semi_additive (f : R -> R) : measure.semi_additive (wlength f). +Lemma wlength_semi_additive (f : R -> R) : + measure_function.semi_additive (wlength f). Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. diff --git a/theories/measure.v b/theories/measure.v deleted file mode 100644 index 4fc78ffcc9..0000000000 --- a/theories/measure.v +++ /dev/null @@ -1,5601 +0,0 @@ -(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) -From HB Require Import structures. -From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. -From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. -From mathcomp Require Import functions cardinality fsbigop reals. -From mathcomp Require Import interval_inference ereal topology normedtype. -From mathcomp Require Import sequences esum numfun. - -(**md**************************************************************************) -(* # Measure Theory *) -(* *) -(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) -(* *) -(* This files provides a formalization of the basics of measure theory. This *) -(* includes the formalization of mathematical structures and of measures, as *) -(* well as standard theorems such as the Measure Extension theorem that *) -(* builds a measure given a function defined over a semiring of sets, the *) -(* intermediate outer measure being *) -(* $\inf_F\{ \sum_{k=0}^\infty \mu(F_k) | X \subseteq \bigcup_k F_k\}.$ *) -(* *) -(* References: *) -(* - R. Affeldt, C. Cohen. Measure construction by extension in dependent *) -(* type theory with application to integration. JAR 2023 *) -(* - Daniel Li. Intégration et applications. 2016 *) -(* - Achim Klenke. Probability Theory. 2014 *) -(* *) -(* ## Mathematical structures *) -(* ``` *) -(* semiRingOfSetsType d == the type of semirings of sets *) -(* The carrier is a set of sets A_i such that *) -(* "measurable A_i" holds. *) -(* "measurable A" is printed as "d.-measurable A" *) -(* where d is a "display parameter" whose purpose *) -(* is to distinguish different "measurable" *) -(* predicates in the same context. *) -(* The HB class is SemiRingOfSets. *) -(* ringOfSetsType d == the type of rings of sets *) -(* The HB class is RingOfSets. *) -(* sigmaRingType d == the type of sigma-rings (of sets) *) -(* The HB class is SigmaRing. *) -(* algebraOfSetsType d == the type of algebras of sets *) -(* The HB class is AlgebraOfsets. *) -(* measurableType == the type of sigma-algebras *) -(* The HB class is Measurable. *) -(* ``` *) -(* *) -(* ## Instances of mathematical structures *) -(* ``` *) -(* discrete_measurable T == alias for the sigma-algebra [set: set T] *) -(* setring G == the set of sets G contains the empty set, is *) -(* closed by union, and difference (it is a ring *) -(* of sets in the sense of ringOfSetsType) *) -(* <> := smallest setring G *) -(* <> is equipped with a structure of ring *) -(* of sets. *) -(* G.-ring.-measurable A == A belongs to the ring of sets <> *) -(* sigma_ring G == the set of sets G forms a sigma-ring *) -(* <> == sigma-ring generated by G *) -(* := smallest sigma_ring G *) -(* sigma_algebra D G == the set of sets G forms a sigma-algebra on D *) -(* <> == sigma-algebra generated by G on D *) -(* := smallest (sigma_algebra D) G *) -(* <> := <> *) -(* <> is equipped with a structure of *) -(* sigma-algebra *) -(* G.-sigma.-measurable A == A is measurable for the sigma-algebra <> *) -(* g_sigma_algebraType G == the measurableType corresponding to <> *) -(* This is an HB alias. *) -(* mu .-cara.-measurable == sigma-algebra of Caratheodory measurable sets *) -(* ``` *) -(* *) -(* ## Structures for functions on set systems *) -(* *) -(* Hierarchy of contents, measures, s-finite/sigma-finite/finite measures, *) -(* etc. Also contains a number of details about its implementation. *) -(* ``` *) -(* {content set T -> \bar R} == type of contents *) -(* T is expected to be a semiring of sets and R *) -(* a numFieldType. *) -(* The HB class is Content. *) -(* {measure set T -> \bar R} == type of (non-negative) measures *) -(* T is expected to be a semiring of sets and *) -(* R is expected to be a numFieldType. *) -(* The HB class is Measure. *) -(* Content_isMeasure == interface that extends a content to a measure *) -(* with the proof that it is semi_sigma_additive *) -(* Content_SubSigmaAdditive_isMeasure == interface that extends a content to *) -(* a measure with the proof that it is *) -(* sigma_sub_additive *) -(* isMeasure == interface corresponding to the "textbook *) -(* definition" of measures *) -(* sfinite_measure == predicate for s-finite measure functions *) -(* {sfinite_measure set T -> \bar R} == type of s-finite measures *) -(* The HB class is SFiniteMeasure. *) -(* sfinite_measure_seq mu == the sequence of finite measures of the *) -(* s-finite measure mu *) -(* isSFinite == interface for functions that satisfy the *) -(* sfinite_measure predicate *) -(* s-finite measure using a sequence of finite *) -(* measures *) -(* Measure_isSFinite == interface that extends a measure to an *) -(* s-finite measure using a sequence of finite *) -(* measures *) -(* isSigmaFinite == interface for functions that satisfy *) -(* sigma finiteness *) -(* {sigma_finite_content set T -> \bar R} == contents that are also sigma *) -(* finite *) -(* The HB class is SigmaFiniteContent. *) -(* {sigma_finite_measure set T -> \bar R} == measures that are also sigma *) -(* finite *) -(* The HB class is SigmaFiniteMeasure. *) -(* sigma_finite A f == the measure function f is sigma-finite on the *) -(* A : set T with T a semiring of sets *) -(* fin_num_fun == predicate for finite function over measurable *) -(* sets *) -(* FinNumFun.type == type of functions over semiring of sets *) -(* returning a fin_num *) -(* The HB class is FinNumFun. *) -(* {finite_measure set T -> \bar R} == finite measures *) -(* The HB class is FiniteMeasure. *) -(* isFinite == interface for functions that satisfy the *) -(* fin_num_fun predicate *) -(* Measure_isFinite == interface that extends a measure to a finite *) -(* measure using a proof of fin_num_fun *) -(* isSubProbability == interface for functions that satisfy the *) -(* property of subprobability *) -(* The HB class is SubProbability. *) -(* subprobability T R == subprobability measure over the *) -(* measurableType T with values in \bar R with *) -(* R : realType *) -(* The HB class is SubProbability. *) -(* Measure_isSubProbability == interface that extends measures to *) -(* subprobability measures *) -(* isProbability == interface for functions that satisfy the *) -(* property of probability measures *) -(* The HB class is Probability. *) -(* probability T R == type of probability measure over the *) -(* measurableType T with values in \bar R *) -(* with R : realType *) -(* Measure_isProbability == interface that extends measures to *) -(* probability measures *) -(* mnormalize mu == normalization of a measure to a probability *) -(* mset U r == the set of probability measures mu such that *) -(* mu U < r *) -(* pset == the sets mset U r with U measurable and *) -(* r \in [0,1] *) -(* pprobability == the measurable type generated by pset *) -(* lim_sup_set F == limit superior (or upper limit) of a *) -(* sequence of sets F *) -(* {outer_measure set T -> \bar R} == type of an outer measure over sets *) -(* of elements of type T : Type where R is *) -(* expected to be a numFieldType *) -(* The HB class is OuterMeasure. *) -(* interfaces: isOuterMeasure, *) -(* isSubsetOuterMeasure *) -(* ``` *) -(* *) -(* ## Instances of measures *) -(* ``` *) -(* pushforward m f == pushforward of a set function m : set T1 -> \bar R *) -(* by f : T1 -> T2; pushforward/image measure if m is *) -(* a measure and f measurable *) -(* \d_a == Dirac measure *) -(* msum mu n == the measure corresponding to the sum of the measures *) -(* mu_0, ..., mu_{n-1} *) -(* @mzero T R == the zero measure *) -(* measure_add m1 m2 == the measure corresponding to the sum of the *) -(* measures m1 and m2 *) -(* mscale r m == the measure of corresponding to fun A => r * m A *) -(* where r has type {nonneg R} *) -(* mseries mu n == the measure corresponding to the sum of the *) -(* measures mu_n, mu_{n+1}, ... *) -(* mrestr mu mD == restriction of the measure mu to a set D; mD is a *) -(* proof that D is measurable *) -(* counting T R == counting measure *) -(* mfrestr mD muDoo == finite measure corresponding to the restriction of *) -(* the measure mu over D with mu D < +oo, *) -(* mD : measurable D, muDoo : mu D < +oo *) -(* ``` *) -(* *) -(* ## About sets of sets *) -(* ``` *) -(* setI_closed G == the set of sets G is closed under finite *) -(* intersection *) -(* setU_closed G == the set of sets G is closed under finite union *) -(* setC_closed G == the set of sets G is closed under complement *) -(* setSD_closed G == the set of sets G is closed under proper *) -(* difference *) -(* setD_closed G == the set of sets G is closed under difference *) -(* setY_closed G == the set of sets G is closed under symmetric *) -(* difference *) -(* ndseq_closed G == the set of sets G is closed under non-decreasing *) -(* countable union *) -(* niseq_closed G == the set of sets G is closed under non-increasing *) -(* countable intersection *) -(* trivIset_closed G == the set of sets G is closed under pairwise-disjoint *) -(* countable union *) -(* lambda_system D G == G is a lambda_system of subsets of D *) -(* <> == lambda-system generated by G on D *) -(* <> := <> *) -(* monotone G == G is a monotone set system *) -(* <> == monotone set system generated by G *) -(* := smallest monotone G *) -(* dynkin G == G is a set of sets that form a Dynkin *) -(* system (or a d-system) *) -(* <> == Dynkin system generated by G, i.e., *) -(* smallest dynkin G *) -(* strace G D := [set x `&` D | x in G] *) -(* ``` *) -(* ## Other measure-theoretic definitions *) -(* *) -(* ``` *) -(* measurable_fun D f == the function f with domain D is measurable *) -(* {mfun aT >-> rT} == type of measurable functions *) -(* aT and rT are sigmaRingType's. *) -(* f \in mfun == holds for f : {mfun _ >-> _} *) -(* preimage_set_system D f G == set system of the preimages by f of sets in G *) -(* image_set_system D f G == set system of the sets with a preimage by f *) -(* in G *) -(* sigma_subadditive mu == predicate defining sigma-subadditivity *) -(* subset_sigma_subadditive mu == alternative predicate defining *) -(* sigma-subadditivity *) -(* mu.-negligible A == A is mu negligible *) -(* measure_is_complete mu == the measure mu is complete *) -(* {ae mu, P} == P holds almost everywhere for the measure mu, *) -(* declared as an instance of the type of *) -(* filters *) -(* P must be of the form forall x, Q x. *) -(* Prefer this notation when P is an existing *) -(* statement (i.e., a definition) that needs to *) -(* be relativised. *) -(* \forall x \ae mu, P x == equivalent to {ae mu, forall x, P x} *) -(* Prefer this notation when the statement *) -(* forall x, P x does not stand alone. *) -(* f = g %[ae mu in D ] == f is equal to g almost everywhere in D *) -(* f = g %[ae mu] == f is equal to g almost everywhere *) -(* ``` *) -(* *) -(* ## Measure extension theorem *) -(* *) -(* From a premeasure to an outer measure (Measure Extension Theorem part 1): *) -(* ``` *) -(* measurable_cover X == the set of sequences F such that *) -(* - forall k, F k is measurable *) -(* - X `<=` \bigcup_k (F k) *) -(* mu^* == extension of the measure mu over a semiring of *) -(* sets (it is an outer measure) *) -(* ``` *) -(* From an outer measure to a measure (Measure Extension Theorem part 2): *) -(* ``` *) -(* mu.-caratheodory == the set of Caratheodory measurable sets for the *) -(* outer measure mu, i.e., sets A such that *) -(* forall B, mu A = mu (A `&` B) + mu (A `&` ~` B) *) -(* caratheodory_type mu := T, where mu : {outer_measure set T -> \bar R} *) -(* It is a canonical measurableType copy of T. *) -(* The restriction of the outer measure mu to the *) -(* sigma algebra of Caratheodory measurable sets is a *) -(* measure. *) -(* Remark: sets that are negligible for *) -(* this measure are Caratheodory measurable. *) -(* ``` *) -(* Measure Extension Theorem: *) -(* ``` *) -(* measure_extension mu == extension of the content mu over a semiring of *) -(* sets to a measure over the generated *) -(* sigma algebra (requires a proof of *) -(* sigma-sub-additivity) *) -(* completed_measure_extension mu == similar to measure_extension but returns *) -(* a complete measure *) -(* ``` *) -(* *) -(* ## Product of measurable spaces *) -(* ``` *) -(* g_sigma_preimageU f1 f2 == sigma-algebra generated by the union of *) -(* the preimages by f1 and the preimages by *) -(* f2 with f1 : T -> T1 and f : T -> T2, T1 *) -(* and T2 being semiRingOfSetsType's *) -(* (d1, d2).-prod.-measurable A == A is measurable for the sigma-algebra *) -(* generated from T1 x T2, with T1 and T2 *) -(* semiRingOfSetsType's with resp. display *) -(* d1 and d2 *) -(* g_sigma_preimage n (f : 'I_n -> aT -> rT) == the sigma-algebra over aT *) -(* generated by the projections f *) -(* n.-tuple T is equipped with a *) -(* measurableType using g_sigma_preimage *) -(* and the tnth projections. *) -(* ``` *) -(* *) -(* ## More measure-theoretic definitions *) -(* ``` *) -(* m1 `<< m2 == m1 is absolutely continuous w.r.t. m2 or m2 dominates m1 *) -(* ess_sup f == essential supremum of the function f : T -> R where T is a *) -(* semiRingOfSetsType and R is a realType *) -(* ``` *) -(* *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. -Import ProperNotations. -Import Order.TTheory GRing.Theory Num.Def Num.Theory. - -Reserved Notation "'s<|' D , G '|>'" (at level 40, G, D at next level). -Reserved Notation "'s<<' A '>>'". -Reserved Notation "'d<<' D '>>'". -Reserved Notation "mu .-negligible" (format "mu .-negligible"). -Reserved Notation "{ 'ae' m , P }" (format "{ 'ae' m , P }"). -Reserved Notation "mu .-measurable" (format "mu .-measurable"). -Reserved Notation "'\d_' a" (at level 8, a at level 2, format "'\d_' a"). -Reserved Notation "G .-sigma" (format "G .-sigma"). -Reserved Notation "G .-sigma.-measurable" (format "G .-sigma.-measurable"). -Reserved Notation "d .-ring" (format "d .-ring"). -Reserved Notation "d .-ring.-measurable" (format "d .-ring.-measurable"). -Reserved Notation "mu .-cara" (format "mu .-cara"). -Reserved Notation "mu .-cara.-measurable" (format "mu .-cara.-measurable"). -Reserved Notation "mu .-caratheodory" (format "mu .-caratheodory"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "'<>'" (format "'<>'"). -Reserved Notation "{ 'content' fUV }" (format "{ 'content' fUV }"). -Reserved Notation "{ 'content' 'set' T '->' '\bar' R }" - (T at level 37, format "{ 'content' 'set' T '->' '\bar' R }"). -Reserved Notation "[ 'content' 'of' f 'as' g ]" - (format "[ 'content' 'of' f 'as' g ]"). -Reserved Notation "[ 'content' 'of' f ]" (format "[ 'content' 'of' f ]"). -Reserved Notation "{ 'measure' fUV }" (format "{ 'measure' fUV }"). -Reserved Notation "{ 'measure' 'set' T '->' '\bar' R }" - (T at level 37, format "{ 'measure' 'set' T '->' '\bar' R }"). -Reserved Notation "[ 'measure' 'of' f 'as' g ]" - (format "[ 'measure' 'of' f 'as' g ]"). -Reserved Notation "[ 'measure' 'of' f ]" (format "[ 'measure' 'of' f ]"). -Reserved Notation "{ 'outer_measure' fUV }" (format "{ 'outer_measure' fUV }"). -Reserved Notation "[ 'outer_measure' 'of' f 'as' g ]" - (format "[ 'outer_measure' 'of' f 'as' g ]"). -Reserved Notation "[ 'outer_measure' 'of' f ]" - (format "[ 'outer_measure' 'of' f ]"). -Reserved Notation "p .-prod" (format "p .-prod"). -Reserved Notation "p .-prod.-measurable" (format "p .-prod.-measurable"). -Reserved Notation "m1 `<< m2" (at level 51). -Reserved Notation "{ 'sfinite_measure' 'set' T '->' '\bar' R }" - (T at level 37, format "{ 'sfinite_measure' 'set' T '->' '\bar' R }"). -Reserved Notation "{ 'sigma_finite_content' 'set' T '->' '\bar' R }" - (T at level 37, - format "{ 'sigma_finite_content' 'set' T '->' '\bar' R }"). -Reserved Notation "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }" - (T at level 37, - format "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }"). -Reserved Notation "{ 'finite_measure' 'set' T '->' '\bar' R }" - (T at level 37, format "{ 'finite_measure' 'set' T '->' '\bar' R }"). -Reserved Notation "{ 'ae' m , P }" (format "{ 'ae' m , P }"). -Reserved Notation "\forall x \ae mu , P" - (at level 200, x name, P at level 200, format "\forall x \ae mu , P"). -Reserved Notation "f = g %[ae mu 'in' D ]" - (at level 70, g at next level, format "f = g '%[ae' mu 'in' D ]"). -Reserved Notation "f = g %[ae mu ]" - (at level 70, g at next level, format "f = g '%[ae' mu ]"). -Reserved Notation "{ 'outer_measure' 'set' T '->' '\bar' R }" - (T at level 37, format "{ 'outer_measure' 'set' T '->' '\bar' R }"). -Reserved Notation "{ 'mfun' aT >-> T }" - (at level 0, format "{ 'mfun' aT >-> T }"). -Reserved Notation "[ 'mfun' 'of' f ]" - (at level 0, format "[ 'mfun' 'of' f ]"). - -Inductive measure_display := default_measure_display. -Declare Scope measure_display_scope. -Delimit Scope measure_display_scope with mdisp. -Bind Scope measure_display_scope with measure_display. - -Local Open Scope classical_set_scope. -Local Open Scope ring_scope. - -Section set_systems. -Context {T} (C : set (set T) -> Prop) (D : set T) (G : set (set T)). - -Definition setC_closed := forall A, G A -> G (~` A). -Definition setI_closed := forall A B, G A -> G B -> G (A `&` B). -Definition setU_closed := forall A B, G A -> G B -> G (A `|` B). -Definition setSD_closed := forall A B, B `<=` A -> G A -> G B -> G (A `\` B). -Definition setD_closed := forall A B, G A -> G B -> G (A `\` B). -Definition setY_closed := forall A B, G A -> G B -> G (A `+` B). - -Definition fin_bigcap_closed := - forall I (D : set I) A_, finite_set D -> (forall i, D i -> G (A_ i)) -> - G (\bigcap_(i in D) (A_ i)). - -Definition finN0_bigcap_closed := - forall I (D : set I) A_, finite_set D -> D !=set0 -> - (forall i, D i -> G (A_ i)) -> - G (\bigcap_(i in D) (A_ i)). - -Definition fin_bigcup_closed := - forall I (D : set I) A_, finite_set D -> (forall i, D i -> G (A_ i)) -> - G (\bigcup_(i in D) (A_ i)). - -Definition semi_setD_closed := forall A B, G A -> G B -> exists D, - [/\ finite_set D, D `<=` G, A `\` B = \bigcup_(X in D) X & trivIset D id]. - -Lemma setD_semi_setD_closed : setD_closed -> semi_setD_closed. -Proof. -move=> mD A B Am Bm; exists [set A `\` B]; split; rewrite ?bigcup_set1//. - by move=> X ->; apply: mD. -by move=> X Y -> ->. -Qed. - -Definition ndseq_closed := - forall F, nondecreasing_seq F -> (forall i, G (F i)) -> G (\bigcup_i (F i)). - -Definition niseq_closed := - forall F, nonincreasing_seq F -> (forall i, G (F i)) -> G (\bigcap_i (F i)). - -Definition trivIset_closed := - forall F : (set T)^nat, trivIset setT F -> (forall n, G (F n)) -> - G (\bigcup_k F k). - -Definition fin_trivIset_closed := - forall I (D : set I) (F : I -> set T), finite_set D -> trivIset D F -> - (forall i, D i -> G (F i)) -> G (\bigcup_(k in D) F k). - -Definition setring := [/\ G set0, setU_closed & setD_closed]. - -Definition sigma_ring := [/\ G set0, setD_closed & - (forall A : (set T)^nat, (forall n, G (A n)) -> G (\bigcup_k A k))]. - -Definition sigma_algebra := - [/\ G set0, (forall A, G A -> G (D `\` A)) & - (forall A : (set T)^nat, (forall n, G (A n)) -> G (\bigcup_k A k))]. - -Definition dynkin := [/\ G setT, setC_closed & trivIset_closed]. - -(**md Until MathComp-Analysis 1.1.0, the identifier was `monotone_class` -because this definition corresponds to "classe monotone" in several -French references, e.g., the definition of "classe monotone" on the French wikipedia. *) -Definition lambda_system := - [/\ forall A, G A -> A `<=` D, G D, setSD_closed & ndseq_closed]. - -Definition monotone := ndseq_closed /\ niseq_closed. - -End set_systems. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `lambda_system`")] -Notation monotone_class := lambda_system (only parsing). -(*#[deprecated(since="mathcomp-analysis 1.3.0", note="renamed `setSD_closed`")] -Notation setD_closed := setSD_closed (only parsing).*) -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setD_closed`")] -Notation setDI_closed := setD_closed (only parsing). -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setD_semi_setD_closed`")] -Notation setDI_semi_setD_closed := setD_semi_setD_closed (only parsing). - -Lemma powerset_sigma_ring (T : Type) (D : set T) : - sigma_ring [set X | X `<=` D]. -Proof. -split => //; last first. - by move=> F FA/=; apply: bigcup_sub => i _; exact: FA. -by move=> U V + VA; apply: subset_trans; exact: subDsetl. -Qed. - -Lemma powerset_lambda_system (T : Type) (D : set T) : - lambda_system D [set X | X `<=` D]. -Proof. -split => //. -- by move=> A B BA + BD; apply: subset_trans; exact: subDsetl. -- by move=> /= F _ FD; exact: bigcup_sub. -Qed. - -Notation "'<>'" := (smallest (lambda_system D) G) : - classical_set_scope. -Notation "'<>'" := (<>) : classical_set_scope. -Notation "'<>'" := (smallest dynkin G) : classical_set_scope. -Notation "'<>'" := (smallest (sigma_algebra D) G) : - classical_set_scope. -Notation "'<>'" := (<>) : classical_set_scope. -Notation "'<>'" := (smallest setring G) : classical_set_scope. -Notation "'<>'" := (smallest sigma_ring G) : classical_set_scope. -Notation "'<>'" := (smallest monotone G) : classical_set_scope. - -Section lambda_system_smallest. -Variables (T : Type) (D : set T) (G : set (set T)). -Hypothesis GD : forall A, G A -> A `<=` D. - -Lemma lambda_system_smallest : lambda_system D <>. -Proof. -split => [A MA | E [monoE] | A B BA MA MB E [[EsubD ED setDE ndE] GE] |]. -- have monoH := powerset_lambda_system D. - by case: (monoH) => + _ _ _; apply; exact: MA. -- by case: monoE. -- by apply setDE => //; [exact: MA|exact: MB]. -- by move=> F ndF MF E [[EsubD ED setDE ndE] CE]; apply ndE=> // n; exact: MF. -Qed. - -End lambda_system_smallest. - -Lemma fin_bigcup_closedP T (G : set (set T)) : - (G set0 /\ setU_closed G) <-> fin_bigcup_closed G. -Proof. -split=> [[G0 GU] I D A DF GA|GU]; last first. - have G0 : G set0 by have := GU void set0 point; rewrite bigcup0//; apply. - by split=> // A B GA GB; rewrite -bigcup2inE; apply: GU => // -[|[|[]]]. -elim/Pchoice: I => I in D DF A GA *; rewrite -bigsetU_fset_set// big_seq. -by elim/big_ind: _ => // i; rewrite in_fset_set// inE => /GA. -Qed. - -Lemma finN0_bigcap_closedP T (G : set (set T)) : - setI_closed G <-> finN0_bigcap_closed G. -Proof. -split=> [GI I D A DF [i Di] GA|GI A B GA GB]; last first. - by rewrite -bigcap2inE; apply: GI => // [|[|[|[]]]]; first by exists 0%N. -elim/Pchoice: I => I in D DF i Di A GA *. -have finDDi : finite_set (D `\ i) by exact: finite_setD. -rewrite (bigcap_setD1 i)// -bigsetI_fset_set// big_seq. -elim/big_rec: _ => // [|j B]; first by rewrite setIT; apply: GA. -rewrite in_fset_set// inE => -[Dj /eqP nij] GAB. -by rewrite setICA; apply: GI => //; apply: GA. -Qed. - -Lemma setD_closedP T (G : set (set T)) : - setD_closed G <-> (setI_closed G /\ setSD_closed G). -Proof. -split=> [GDI|[GI GD]]. - by split=> A B => [|AB] => GA GB; rewrite -?setDD//; do ?apply: (GDI). -move=> A B GA GB; suff <- : A `\` (A `&` B) = A `\` B. - by apply: GD => //; apply: GI. -by rewrite setDE setCI setIUr -setDE setDv set0U. -Qed. -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setD_closed`")] -Notation sedDI_closedP := setD_closed (only parsing). - -Lemma sigma_algebra_bigcap T (I : choiceType) (D : set T) - (F : I -> set (set T)) (J : set I) : - (forall n, J n -> sigma_algebra D (F n)) -> - sigma_algebra D (\bigcap_(i in J) F i). -Proof. -move=> mG; split=> [i Ji|A AJ i Ji|H GH i Ji]; first by have [] := mG i. -- by have [_ mGiC _] := mG i Ji; exact/mGiC/AJ. -- by have [_ _ mGiU] := mG i Ji; apply: mGiU => j; exact: GH. -Qed. - -Lemma sigma_algebraP T U (C : set (set T)) : - (forall X, C X -> X `<=` U) -> - sigma_algebra U C <-> - [/\ C U, setSD_closed C, ndseq_closed C & setI_closed C]. -Proof. -move=> C_subU; split => [[C0 CD CU]|[DT DC DU DI]]; split. -- by rewrite -(setD0 U); apply: CD. -- move=> A B BA CA CB; rewrite (_ : A `\` B = U `\` ((U `\` A) `|` B)). - by apply CD; rewrite -bigcup2E; apply: CU => -[|[|[|]]] //=; exact: CD. - rewrite setDUr setDD [in RHS]setDE setIACA setIid -setDE setIidr//. - by rewrite setDE; apply: subIset; left; apply: C_subU. -- by move=> F ndF DF; exact: CU. -- move=> A B DA DB; rewrite (_ : A `&` B = U `\` ((U `\` A) `|` (U `\` B))). - by apply CD; rewrite -bigcup2E; apply: CU => -[|[|[|]]] //; exact: CD. - rewrite setDUr !setDD setIACA setIid (@setIidr _ U)//. - by apply: subIset; left; exact: C_subU. -- by rewrite -(setDv U); exact: DC. -- by move=> A CA; apply: DC => //; exact: C_subU. -- move=> F DF. - rewrite [X in C X](_ : _ = \bigcup_i \big[setU/set0]_(j < i.+1) F j). - apply: DU; first by move=> *; exact/subsetPset/subset_bigsetU. - elim=> [|n ih]; first by rewrite big_ord_recr /= big_ord0 set0U; exact: DF. - have CU : setU_closed C. - move=> A B DA DB; rewrite (_ : A `|` B = U `\` ((U `\` A) `&` (U `\` B))). - apply DC => //; last by apply: DI; apply: DC => //; exact: C_subU. - by apply: subIset; left; apply: subIset; left. - by rewrite setDIr// !setDD (setIidr (C_subU _ DA)) (setIidr (C_subU _ _)). - by rewrite big_ord_recr; exact: CU. - rewrite predeqE => x; split => [[n _ Fnx]|[n _]]. - by exists n => //; rewrite big_ord_recr /=; right. - by rewrite -bigcup_mkord => -[m /=]; rewrite ltnS => _ Fmx; exists m. -Qed. - -Section generated_sigma_algebra. -Context {T : Type} (D : set T) (G : set (set T)). -Implicit Types (M : set (set T)). - -Lemma smallest_sigma_algebra : sigma_algebra D <>. -Proof. -split=> [|A GA|A GA] P [[P0 PD PU]] GP //. - by apply: (PD); apply: GA. -by apply: (PU) => n; apply: GA. -Qed. -Hint Resolve smallest_sigma_algebra : core. - -Lemma sub_sigma_algebra2 M : M `<=` G -> <> `<=` <>. -Proof. exact: sub_smallest2r. Qed. - -Lemma sigma_algebra_id : sigma_algebra D G -> <> = G. -Proof. by move=> /smallest_id->. Qed. - -Lemma sub_sigma_algebra : G `<=` <>. Proof. exact: sub_smallest. Qed. - -Lemma sigma_algebra0 : <> set0. -Proof. by case: smallest_sigma_algebra. Qed. - -Lemma sigma_algebraCD : forall A, <> A -> <> (D `\` A). -Proof. by case: smallest_sigma_algebra. Qed. - -Lemma sigma_algebra_bigcup (A : (set T)^nat) : - (forall i, <> (A i)) -> <> (\bigcup_i (A i)). -Proof. by case: smallest_sigma_algebra A. Qed. - -End generated_sigma_algebra. -#[global] Hint Resolve smallest_sigma_algebra : core. - -Section generated_setring. -Context {T : Type} (G : set (set T)). -Implicit Types (M : set (set T)). - -Lemma smallest_setring : setring <>. -Proof. -split=> [|A B GA GB|A B GA GB] P [[P0 PU PDI]] GP //. - by apply: (PU); [apply: GA|apply: GB]. -by apply: (PDI); [apply: GA|apply: GB]. -Qed. -Hint Resolve smallest_setring : core. - -Lemma sub_setring2 M : M `<=` G -> <> `<=` <>. -Proof. exact: sub_smallest2r. Qed. - -Lemma setring_id : setring G -> <> = G. -Proof. by move=> /smallest_id->. Qed. - -Lemma sub_setring : G `<=` <>. Proof. exact: sub_smallest. Qed. - -Lemma setring0 : <> set0. -Proof. by case: smallest_setring. Qed. - -Lemma setringD : setD_closed <>. -Proof. by case: smallest_setring. Qed. - -Lemma setringU : setU_closed <>. -Proof. by case: smallest_setring. Qed. - -Lemma setring_fin_bigcup : fin_bigcup_closed <>. -Proof. -by apply/fin_bigcup_closedP; split; [apply: setring0|apply: setringU]. -Qed. - -End generated_setring. -#[global] Hint Resolve smallest_setring setring0 : core. -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setringD`")] -Notation setringDI := setringD (only parsing). - -Lemma g_sigma_algebra_lambda_system T (G : set (set T)) (D : set T) : - (forall X, <> X -> X `<=` D) -> - lambda_system D <>. -Proof. -move=> sDGD; have := smallest_sigma_algebra D G. -by move=> /(sigma_algebraP sDGD) [sT sD snd sI]; split. -Qed. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_lambda_system`")] -Notation monotone_class_g_salgebra := g_sigma_algebra_lambda_system (only parsing). - -Lemma smallest_sigma_ring T (G : set (set T)) : sigma_ring <>. -Proof. -split=> [B [[]]//|A B GA GB C [[? CDI ?]] GC|A GA C [[? ? CU]] GC] /=. -- by apply: (CDI); [exact: GA|exact: GB]. -- by apply: (CU) => n; exact: GA. -Qed. - -(**md see Paul Halmos' Measure Theory, Ch.1, sec.6, thm.A(1), p.27 *) -Lemma sigma_ring_monotone T (G : set (set T)) : sigma_ring G -> monotone G. -Proof. -move=> [G0 GDI GU]; split => [F ndF GF|F icF GF]; first exact: GU. -rewrite -(@setD_bigcup _ _ F _ O)//; apply: (GDI); first exact: GF. -by rewrite bigcup_mkcond; apply: GU => n; case: ifPn => // _; exact: GDI. -Qed. - -Lemma g_sigma_ring_monotone T (G : set (set T)) : monotone <>. -Proof. by apply: sigma_ring_monotone => //; exact: smallest_sigma_ring. Qed. - -Lemma sub_g_sigma_ring T (G : set (set T)) : G `<=` <>. -Proof. exact: sub_smallest. Qed. - -(**md see Paul Halmos' Measure Theory, Ch.1, sec.6, thm.A(2), p.27 *) -Lemma setring_monotone_sigma_ring T (G : set (set T)) : - setring G -> monotone G -> sigma_ring G. -Proof. -move=> [G0 GU GD] [ndG niG]; split => // F GF. -rewrite -bigcup_bigsetU_bigcup; apply: ndG. - by move=> *; exact/subsetPset/subset_bigsetU. -by elim=> [|n ih]; rewrite big_ord_recr/= ?big_ord0 ?set0U//; exact: GU. -Qed. - -Lemma g_monotone_monotone T (G : set (set T)) : monotone <>. -Proof. -split=> /= F ndF GF C [[ndC niC] GC]; - have {}GC : <> `<=` C by exact: smallest_sub. -- by apply: (ndC) => // i; apply: (GC); exact: GF. -- by apply: (niC) => // i; apply: (GC); exact: GF. -Qed. - -Section g_monotone_g_sigma_ring. -Variables (T : Type) (G : set (set T)). -Hypothesis ringG : setring G. - -(**md see Paul Halmos' Measure Theory, Ch.1, sec.6, thm.B, p.27 *) -Lemma g_monotone_setring : setring <>. -Proof. -pose M := <>. -pose K F := [set E | [/\ M (E `\` F), M (F `\` E) & M (E `|` F)] ]. -have KP E F : K(F) E -> K(E) F by move=> [] *; split; rewrite 1?setUC. -have K_monotone F : monotone (K(F)). - split. - move=> /= H ndH KFH; split. - - rewrite setD_bigcupl; apply: (g_monotone_monotone G).1. - by move=> m n mn; apply/subsetPset; apply: setSD; exact/subsetPset/ndH. - by move=> i; have [] := KFH i. - - rewrite setDE setC_bigcup -bigcapIr//; apply: (g_monotone_monotone G).2. - move=> m n mn; apply/subsetPset. - by apply: setDS; exact/subsetPset/ndH. - by move=> i; have [] := KFH i. - - rewrite -bigcupUl//; apply: (g_monotone_monotone G).1. - move=> m n mn; apply/subsetPset. - by apply: setSU; exact/subsetPset/ndH. - by move=> i; have [] := KFH i. - move=> /= H niH KFH; split. - - rewrite setDE -bigcapIl//; apply: (g_monotone_monotone G).2. - move=> m n mn; apply/subsetPset; apply: setSI; exact/subsetPset/niH. - by move=> i; have [] := KFH i. - - rewrite setDE setC_bigcap setI_bigcupr; apply: (g_monotone_monotone G).1. - move=> m n mn; apply/subsetPset. - by apply: setIS; apply: subsetC; exact/subsetPset/niH. - by move=> i; have [] := KFH i. - - rewrite setU_bigcapl//; apply: (g_monotone_monotone G).2. - move=> m n mn; apply/subsetPset. - by apply: setSU; exact/subsetPset/niH. - by move=> i; have [] := KFH i. -have G_KF F : G F -> G `<=` K(F). - case: ringG => _ GU GDI GF A GA; split. - - by apply: sub_gen_smallest; exact: GDI. - - by apply: sub_gen_smallest; exact: GDI. - - by apply: sub_gen_smallest; exact: GU. -have GM_KF F : G F -> M `<=` K(F). - by move=> GF; apply: smallest_sub => //; exact: G_KF. -have MG_KF F : M F -> G `<=` K(F). - by move=> MF A GA; rewrite /K/=; split; have /KP[] := GM_KF _ GA _ MF. -have MM_KF F : M F -> M `<=` K(F). - by move=> MF; apply: smallest_sub => //; exact: MG_KF. -split. -- by apply: sub_gen_smallest; case: ringG. -- by move=> A B GA GB; have [] := MM_KF _ GB _ GA. -- by move=> A B GA GB; have [] := MM_KF _ GB _ GA. -Qed. - -Lemma g_monotone_g_sigma_ring : <> = <>. -Proof. -rewrite eqEsubset; split. - by apply: smallest_sub; [exact: g_sigma_ring_monotone| - exact: sub_g_sigma_ring]. -apply: smallest_sub; last exact: sub_smallest. -apply: setring_monotone_sigma_ring; last exact: g_monotone_monotone. -exact: g_monotone_setring. -Qed. - -End g_monotone_g_sigma_ring. - -Corollary monotone_setring_sub_g_sigma_ring T (G R : set (set T)) : monotone G -> - setring R -> R `<=` G -> <> `<=` G. -Proof. -by move=> mG rR RG; rewrite -g_monotone_g_sigma_ring//; exact: smallest_sub. -Qed. - -Section smallest_lambda_system. -Variables (T : Type) (G : set (set T)) (setIG : setI_closed G) (D : set T). -Hypothesis lambdaDG : lambda_system D <>. - -Lemma smallest_lambda_system : (forall X, <> X -> X `<=` D) -> - <> = <>. -Proof. -move=> sDGD; rewrite eqEsubset; split. - apply: smallest_sub; first exact: g_sigma_algebra_lambda_system. - exact: sub_sigma_algebra. -suff: setI_closed <>. - move=> IH; apply: smallest_sub => //. - by apply/sigma_algebraP; case: lambdaDG. -pose H := <>. -pose H_ A := [set X | H X /\ H (X `&` A)]. -have setDH_ A : setSD_closed (H_ A). - move=> X Y XY [HX HXA] [HY HYA]; case: lambdaDG => h _ setDH _; split. - exact: setDH. - rewrite (_ : _ `&` _ = (X `&` A) `\` (Y `&` A)); last first. - rewrite predeqE => x; split=> [[[? ?] ?]|]; first by split => // -[]. - by move=> [[? ?] YAx]; split => //; split => //; apply: contra_not YAx. - by apply: setDH => //; exact: setSI. -have ndH_ A : ndseq_closed (H_ A). - move=> F ndF H_AF; split. - by case: lambdaDG => h _ _; apply => // => n; have [] := H_AF n. - rewrite setI_bigcupl; case: lambdaDG => h _ _; apply => //. - by move=> m n mn; apply/subsetPset; apply: setSI; apply/subsetPset/ndF. - by move=> n; have [] := H_AF n. -have GGH_ X : G X -> G `<=` H_ X. - move=> GX; rewrite /H_ => A GA; split; first exact: sub_smallest GA. - by apply: (@sub_smallest _ _ _ G) => //; exact: setIG. -have HD X : H X -> X `<=` D by move=> ?; case: lambdaDG => + _ _ _; apply. -have GHH_ X : G X -> H `<=` H_ X. - move=> GX; apply: smallest_sub; last exact: GGH_. - split => //; first by move=> A [HA _]; case: lambdaDG => + _ _ _; exact. - have XD : X `<=` D by apply: HD; exact: (@sub_smallest _ _ _ G). - rewrite /H_ /= setIidr//; split; [by case: lambdaDG|]. - exact: (@sub_smallest _ _ _ G). -have HGH_ X : H X -> G `<=` H_ X. - move=> *; split; [|by rewrite setIC; apply GHH_]. - exact: (@sub_smallest _ _ _ G). -have HHH_ X : H X -> H `<=` H_ X. - move=> HX; apply: smallest_sub; last exact: HGH_. - split=> //. - - by move=> ? [? ?]; case: lambdaDG => + _ _ _; exact. - - have XD : X `<=` D := HD _ HX. - by rewrite /H_/= setIidr//; split => //; case: lambdaDG. -by move=> *; apply HHH_. -Qed. - -End smallest_lambda_system. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `smallest_lambda_system`")] -Notation smallest_monotone_classE := smallest_lambda_system (only parsing). - -Section lambda_system_subset. -Variables (T : Type) (G : set (set T)) (setIG : setI_closed G) (D : set T). -Variables (H : set (set T)) (DH : lambda_system D H) (GH : G `<=` H). - -(**md a.k.a. Sierpiński–Dynkin's pi-lambda theorem *) -Lemma lambda_system_subset : (forall X, (<>) X -> X `<=` D) -> - <> `<=` H. -Proof. -move=> sDGD; set M := <>. -rewrite -(@smallest_lambda_system _ _ setIG D) //. -- exact: smallest_sub. -- apply: lambda_system_smallest => A GA. - by apply: sDGD; exact: sub_sigma_algebra. -Qed. - -End lambda_system_subset. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `lambda_system_subset`")] -Notation monotone_class_subset := lambda_system_subset (only parsing). - -Section dynkin. -Variable T : Type. -Implicit Types G D : set (set T). - -Lemma dynkinT G : dynkin G -> G setT. Proof. by case. Qed. - -Lemma dynkinC G : dynkin G -> setC_closed G. Proof. by case. Qed. - -Lemma dynkinU G : dynkin G -> (forall F : (set T)^nat, trivIset setT F -> - (forall n, G (F n)) -> G (\bigcup_k F k)). Proof. by case. Qed. - -End dynkin. - -Section dynkin_lemmas. -Variable T : Type. -Implicit Types D G : set (set T). - -Lemma dynkin_lambda_system G : dynkin G <-> lambda_system setT G. -Proof. -split => [[GT setCG trG]|[_ GT setDG ndG]]; split => //. -- move=> A B BA GA GB; rewrite setDE -(setCK (_ `&` _)) setCI; apply: (setCG). - rewrite setCK -bigcup2E; apply trG. - + by rewrite -trivIset_bigcup2 setIC; apply subsets_disjoint. - + by move=> [|[//|n]]; [exact: setCG|rewrite /bigcup2 -setCT; apply: setCG]. -- move=> F ndF GF; rewrite -eq_bigcup_seqD; apply: (trG). - exact: trivIset_seqD. - move=> [/=|n]; first exact: GF. - rewrite /seqD setDE -(setCK (_ `&` _)) setCI; apply: (setCG). - rewrite setCK -bigcup2E; apply: trG. - + rewrite -trivIset_bigcup2 setIC; apply subsets_disjoint. - exact/subsetPset/ndF/ltnW. - + move=> [|[|]]; rewrite /bigcup2 /=; [exact/setCG/GF|exact/GF|]. - by move=> _; rewrite -setCT; apply: setCG. -- by move=> A B; rewrite -setTD; apply: setDG. -- move=> F tF GF; pose A i := \big[setU/set0]_(k < i.+1) F k. - rewrite -bigcup_bigsetU_bigcup. - apply: ndG; first by move=> a b ab; exact/subsetPset/subset_bigsetU. - elim=> /= => [|n ih]. - by rewrite /A big_ord_recr /= big_ord0 set0U; exact: GF. - rewrite /A /= big_ord_recr /= -/(A n). - rewrite (_ : _ `|` _ = ~` (~` A n `\` F n.+1)); last first. - by rewrite setDE setCI !setCK. - rewrite -setTD; apply: (setDG) => //; apply: (setDG) => //; last first. - by rewrite -setTD; apply: setDG. - apply/disjoints_subset; rewrite setIC. - by apply: (@trivIset_bigsetUI _ predT) => //; rewrite /predT /= trueE. -Qed. - -Lemma g_dynkin_dynkin G : dynkin <>. -Proof. -split=> [D /= [] []//| | ]. -- by move=> Y sGY D /= [dD GD]; exact/(dynkinC dD)/(sGY D). -- by move=> F tF gGF D /= [dD GD]; apply dD => // k; exact: gGF. -Qed. - -Lemma sigma_algebra_dynkin G : sigma_algebra setT G -> dynkin G. -Proof. -case=> ? DC DU; split => [| |? ? ?]; last exact: DU. -- by rewrite -setC0 -setTD; exact: DC. -- by move=> A GA; rewrite -setTD; apply: DC. -Qed. - -Lemma dynkin_setI_sigma_algebra G : dynkin G -> setI_closed G -> - sigma_algebra setT G. -Proof. -move=> dG GI; split => [|//|F DF]. -- by rewrite -setCT; exact/(dynkinC dG)/(dynkinT dG). -- by move=> A GA; rewrite setTD; exact: (dynkinC dG). -- rewrite seqDU_bigcup_eq; apply/(dynkinU dG) => //. - move=> n; rewrite /seqDU setDE; apply GI => //. - rewrite -bigcup_mkord setC_bigcup bigcap_mkord. - apply: big_ind => //; first by case: dG. - by move=> i _; exact/(dynkinC dG). -Qed. - -Lemma setI_closed_g_dynkin_g_sigma_algebra G : - setI_closed G -> <> = <>. -Proof. -move=> GI; rewrite eqEsubset; split. - by apply: sub_smallest2l; exact: sigma_algebra_dynkin. -pose delta (D : set T) := [set E | <> (E `&` D)]. -have ddelta (D : set T) : <> D -> dynkin (delta D). - move=> dGD; split; first by rewrite /delta /= setTI. - - move=> E DE; rewrite /delta /=. - have -> : (~` E) `&` D = ~` ((E `&` D) `|` (~` D)). - by rewrite -[LHS]setU0 -(setICl D) -setIUl -setCI -{2}(setCK D) -setCU. - have : <> ((E `&` D) `|` ~` D). - rewrite -bigcup2E => S [dS GS]; apply: (dynkinU dS). - move=> [|[|i]] [|[|j]] => // _ _; rewrite /bigcup2 /=. - + by rewrite -setIA setICr setI0 => /set0P; rewrite eqxx. - + by rewrite setI0 => /set0P; rewrite eqxx. - + by rewrite setICA setICl setI0 => /set0P; rewrite eqxx. - + by rewrite setI0 => /set0P; rewrite eqxx. - + by rewrite set0I => /set0P; rewrite eqxx. - + by rewrite set0I => /set0P; rewrite eqxx. - + by rewrite set0I => /set0P; rewrite eqxx. - move=> [|[|n]] //; rewrite /bigcup2 /=; [exact: DE| |]. - + suff: <> (~` D) by exact. - by move=> F [dF GF]; apply: (dynkinC dF) => //; exact: dGD. - + by rewrite -setCT; apply/(dynkinC dS)/(dynkinT dS). - by move=> dGEDD S /= [+ GS] => dS; apply/(dynkinC dS); exact: dGEDD. - - move=> F tF deltaDF; rewrite /delta /= => S /= [dS GS]. - rewrite setI_bigcupl; apply: (dynkinU dS) => //. - by under eq_fun do rewrite setIC; exact: trivIset_setIl. - by move=> n; exact: deltaDF. -have GdG : G `<=` <> by move=> ? ? ? [_]; apply. -have Gdelta A : G A -> G `<=` delta A. - by move=> ? ? ?; rewrite /delta /= => ? [?]; apply; exact/GI. -have GdGdelta A : G A -> <> `<=` delta A. - move=> ?; apply: smallest_sub => //; last exact: Gdelta. - by apply/ddelta; exact: GdG. -have dGGI A B : <> A -> G B -> <> (A `&` B). - by move=> ? ?; apply: GdGdelta. -have dGGdelta A : <> A -> G `<=` delta A. - by move=> ? ? ?; rewrite /delta /= setIC; exact: dGGI. -have dGdGdelta A : <> A -> <> `<=` delta A. - by move=> ?; exact: smallest_sub (ddelta _ _) (dGGdelta _ _). -have dGdGdG A B : <> A -> <> B -> <> (A `&` B). - by move=> ? ?; exact: dGdGdelta. -apply: smallest_sub => //; apply: dynkin_setI_sigma_algebra => //. -exact: g_dynkin_dynkin. -Qed. - -End dynkin_lemmas. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `setI_closed_g_dynkin_g_sigma_algebra`")] -Notation setI_closed_gdynkin_salgebra := setI_closed_g_dynkin_g_sigma_algebra (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `g_dynkin_dynkin`")] -Notation dynkin_g_dynkin := g_dynkin_dynkin (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `dynkin_lambda_system`")] -Notation dynkin_monotone := dynkin_lambda_system (only parsing). - -Section trace. -Variable (T : Type). -Implicit Types (G : set (set T)) (A D : set T). - -Definition strace G D := [set x `&` D | x in G]. - -Lemma subset_strace G C : G `<=` C -> forall D, strace G D `<=` strace C D. -Proof. by move=> GC D _ [A GA <-]; exists A => //; exact: GC. Qed. - -Lemma g_sigma_ring_strace G A B : <> B -> B `<=` A. -Proof. -move=> H; apply H => /=; split; first exact: powerset_sigma_ring. -by move=> X [A0 GA0 <-]; exact: subIsetr. -Qed. - -Lemma strace_sigma_ring G A : sigma_ring (strace <> A). -Proof. -split. -- by exists set0; rewrite ?set0I//; have [] := smallest_sigma_ring G. -- move=> _ _ [A0 GA0] <- [A1 GA1] <-. - exists (A0 `\` A1); first by have [_ + _] := smallest_sigma_ring G; exact. - by rewrite -setIDA setDIr setDv setU0 setIDAC setIDA. -- move=> F GAF. - pose f n := sval (cid2 (GAF n)). - pose Hf n := (svalP (cid2 (GAF n))).1. - pose H n := (svalP (cid2 (GAF n))).2. - exists (\bigcup_k f k). - by have [_ _] := smallest_sigma_ring G; apply => n; exact: Hf. - by rewrite setI_bigcupl; apply: eq_bigcupr => i _; exact: H. -Qed. - -(**md see Paul Halmos' Measure Theory, Ch.1, sec.5, thm.E, p.25 *) -Lemma setI_g_sigma_ring G A : strace <> A = <>. -Proof. -pose D := [set B `|` (C `\` A) | B in <> & C in <>]. -have D_sigma_ring : sigma_ring D. - split. - - exists set0; first by have [] := smallest_sigma_ring (strace G A). - exists set0; first by have [] := smallest_sigma_ring G. - by rewrite set0D setU0. - - move=> _ _ [B0 GAB0] [C0 GC0] <- [B1 GAB1] [C1 GC1] <-. - exists (B0 `\` B1). - by have [_ + _] := smallest_sigma_ring (strace G A); exact. - exists (C0 `\` C1); first by have [_ + _] := smallest_sigma_ring G; exact. - apply/esym; rewrite setDUD. - transitivity (((B0 `\` B1) `&` (B0 `\` (C1 `\` A))) `|` - ((C0 `\` (A `|` B1)) `&` (C0 `\` C1))). - congr setU; first by rewrite setDUr. - apply/seteqP; split => [x [[C0x Ax]]|x]. - move=> /not_orP[B1x /not_andP[C1x|//]]. - by split=> //; split => // -[]. - move=> [[C0x /not_orP[Ax B1x] [_ C1x]]]. - by split=> // -[//|[]]. - transitivity (((B0 `\` B1) `&` B0) `|` - ((C0 `\` A ) `&` (C0 `\` C1))). - apply/seteqP; split => [x [[[B0x B1x] [_ /not_andP[C1x|]]]| - [[C0x /not_orP[Ax B1x]] [_ C1x]]]| - x [[[B0x B1x] _]|[[C0x Ax] [_ C1x]]]]. - + by left; split. - + by move=> /contrapT Ax; left. - + by right; split. - + left; split => //; split => // -[] _; apply. - exact: (g_sigma_ring_strace GAB0). - + right; split => //; split => // -[//|B1x]; apply: Ax. - exact: (g_sigma_ring_strace GAB1). - + congr setU; first by rewrite setDE setIAC setIid. - by rewrite setDDl setDUr setIC. - - move=> F DF. - pose f n := sval (cid2 (DF n)). - pose Hf n := (svalP (cid2 (DF n))).1. - pose g n := sval (cid2 (svalP (cid2 (DF n))).2). - pose Hg n := (svalP (cid2 (svalP (cid2 (DF n))).2)).1. - exists (\bigcup_n f n). - have [_ _] := smallest_sigma_ring (strace G A). - by apply => n; exact: Hf. - exists (\bigcup_n g n). - have [_ _] := smallest_sigma_ring G. - by apply => n; exact: Hg. - pose H n := (svalP (cid2 (svalP (cid2 (DF n))).2)).2. - by rewrite setD_bigcupl -bigcupU; apply: eq_bigcupr => k _; exact: H. -apply/seteqP; split => [|]. - have GD : G `<=` D. - move=> E GE; exists (E `&` A). - by apply: sub_g_sigma_ring; exists E. - by exists E; [exact: sub_g_sigma_ring|exact: setUIDK]. - have {}GD : <> `<=` D by exact: smallest_sub GD. - have GDA : strace <> A `<=` strace D A by exact: subset_strace. - suff: strace D A = <> by move=> <-. - apply/seteqP; split. - move=> _ [_ [gA HgA [g Hg] <-] <-]. - by rewrite setIUl setDKI setU0 setIidl//; exact: (g_sigma_ring_strace HgA). - move=> X HX; exists X. - exists X => //; exists set0; rewrite ?set0D ?setU0//. - by have [] := smallest_sigma_ring G. - by rewrite setIidl//; exact: (g_sigma_ring_strace HX). -have : strace G A `<=` strace <> A. - by move=> X [Y GY <-]; exists Y => //; exact: sub_smallest GY. -by apply: smallest_sub; exact: strace_sigma_ring. -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. - -HB.mixin Record isSemiRingOfSets (d : measure_display) T := { - measurable : set (set T) ; - measurable0 : measurable set0 ; - measurableI : setI_closed measurable; - semi_measurableD : semi_setD_closed measurable; -}. - -#[short(type="semiRingOfSetsType")] -HB.structure Definition SemiRingOfSets d := - {T of Pointed T & isSemiRingOfSets d T}. - -Arguments measurable {d}%_measure_display_scope {s} _%_classical_set_scope. - -Lemma measurable_curry (T1 T2 : Type) d (T : semiRingOfSetsType d) - (G : T1 * T2 -> set T) (x : T1 * T2) : - measurable (G x) <-> measurable (curry G x.1 x.2). -Proof. by case: x. Qed. - -Notation "d .-measurable" := (@measurable d%mdisp) : classical_set_scope. -Notation "'measurable" := - (@measurable default_measure_display) : classical_set_scope. - -HB.mixin Record SemiRingOfSets_isRingOfSets d T of SemiRingOfSets d T := { - measurableU : @setU_closed T measurable -}. - -#[short(type="ringOfSetsType")] -HB.structure Definition RingOfSets d := - {T of SemiRingOfSets d T & SemiRingOfSets_isRingOfSets d T }. - -HB.mixin Record RingOfSets_isAlgebraOfSets d T of RingOfSets d T := { - measurableT : measurable [set: T] -}. - -#[short(type="algebraOfSetsType")] -HB.structure Definition AlgebraOfSets d := - {T of RingOfSets d T & RingOfSets_isAlgebraOfSets d T }. - -HB.mixin Record hasMeasurableCountableUnion d T of SemiRingOfSets d T := { - bigcupT_measurable : forall F : (set T)^nat, (forall i, measurable (F i)) -> - measurable (\bigcup_i (F i)) -}. - -HB.builders Context d T of hasMeasurableCountableUnion d T. - -Let mU : @setU_closed T measurable. -Proof. -move=> A B mA mB; rewrite -bigcup2E. -by apply: bigcupT_measurable => -[//|[//|/= _]]; exact: measurable0. -Qed. - -HB.instance Definition _ := SemiRingOfSets_isRingOfSets.Build d T mU. - -HB.end. - -#[short(type="sigmaRingType")] -HB.structure Definition SigmaRing d := - {T of SemiRingOfSets d T & hasMeasurableCountableUnion d T}. - -HB.factory Record isSigmaRing (d : measure_display) T of Pointed T := { - measurable : set (set T) ; - measurable0 : measurable set0 ; - measurableD : setD_closed measurable ; - bigcupT_measurable : forall F : (set T)^nat, (forall i, measurable (F i)) -> - measurable (\bigcup_i (F i)) -}. - -HB.builders Context d T of isSigmaRing d T. - -Let m0 : measurable set0. Proof. exact: measurable0. Qed. - -Let mI : setI_closed measurable. -Proof. by have [] := (setD_closedP measurable).1 measurableD. Qed. - -Let mD : semi_setD_closed measurable. -Proof. by apply: setD_semi_setD_closed; exact: measurableD. Qed. - -HB.instance Definition _ := isSemiRingOfSets.Build d T m0 mI mD. - -HB.instance Definition _ := hasMeasurableCountableUnion.Build d T bigcupT_measurable. - -HB.end. - -#[short(type="measurableType")] -HB.structure Definition Measurable d := - {T of AlgebraOfSets d T & hasMeasurableCountableUnion d T }. - -HB.factory Record isRingOfSets (d : measure_display) T of Pointed T := { - measurable : set (set T) ; - measurable0 : measurable set0 ; - measurableU : setU_closed measurable; - measurableD : setD_closed measurable; -}. - -HB.builders Context d T of isRingOfSets d T. -Implicit Types (A B C D : set T). - -Lemma mI : setI_closed measurable. -Proof. by have [] := (setD_closedP measurable).1 measurableD. Qed. - -Lemma mD : semi_setD_closed measurable. -Proof. by apply: setD_semi_setD_closed; exact: measurableD. Qed. - -HB.instance Definition _ := - @isSemiRingOfSets.Build d T measurable measurable0 mI mD. - -HB.instance Definition _ := SemiRingOfSets_isRingOfSets.Build d T measurableU. - -HB.end. - -HB.factory Record isRingOfSets_setY (d : measure_display) T - of Pointed T := { - measurable : set (set T) ; - measurable_nonempty : measurable !=set0 ; - measurable_setY : setY_closed measurable ; - measurable_setI : setI_closed measurable }. - -HB.builders Context d T of isRingOfSets_setY d T. - -Let m0 : measurable set0. -Proof. -have [A mA] := measurable_nonempty. -have := measurable_setY mA mA. -by rewrite setYK. -Qed. - -Let mU : setU_closed measurable. -Proof. -move=> A B mA mB; rewrite -setYU. -by apply: measurable_setY; [exact: measurable_setY|exact: measurable_setI]. -Qed. - -Let mD : setD_closed measurable. -Proof. -move=> A B mA mB; rewrite -setYD. -by apply: measurable_setY => //; exact: measurable_setI. -Qed. - -HB.instance Definition _ := isRingOfSets.Build d T m0 mU mD. - -HB.end. - -HB.factory Record isAlgebraOfSets (d : measure_display) T of Pointed T := { - measurable : set (set T) ; - measurable0 : measurable set0 ; - measurableU : setU_closed measurable; - measurableC : setC_closed measurable -}. - -HB.builders Context d T of isAlgebraOfSets d T. - -Lemma mD : setD_closed measurable. -Proof. -move=> A B mA mB; rewrite setDE -[A]setCK -setCU. -by do ?[apply: measurableU | apply: measurableC]. -Qed. - -HB.instance Definition T_isRingOfSets := @isRingOfSets.Build d T - measurable measurable0 measurableU mD. - -Lemma measurableT : measurable [set: T]. -Proof. by rewrite -setC0; apply: measurableC; exact: measurable0. Qed. - -HB.instance Definition _ := RingOfSets_isAlgebraOfSets.Build d T measurableT. - -HB.end. - -HB.factory Record isAlgebraOfSets_setD (d : measure_display) T of Pointed T := { - measurable : set (set T) ; - measurableT : measurable [set: T] ; - measurableD : setD_closed measurable -}. - -HB.builders Context d T of isAlgebraOfSets_setD d T. - -Let m0 : measurable set0. -Proof. by rewrite -(setDT setT); apply: measurableD; exact: measurableT. Qed. - -Let mU : setU_closed measurable. -Proof. -move=> A B mA mB. -rewrite -(setCK A) -setCD -!setTD; apply: measurableD; first exact: measurableT. -by do 2 apply: measurableD => //; exact: measurableT. -Qed. - -HB.instance Definition _ := isRingOfSets.Build d T m0 mU measurableD. - -HB.instance Definition _ := RingOfSets_isAlgebraOfSets.Build d T measurableT. - -HB.end. - -HB.factory Record isMeasurable (d : measure_display) T of Pointed T := { - measurable : set (set T) ; - measurable0 : measurable set0 ; - measurableC : forall A, measurable A -> measurable (~` A) ; - measurable_bigcup : forall F : (set T)^nat, (forall i, measurable (F i)) -> - measurable (\bigcup_i (F i)) -}. - -HB.builders Context d T of isMeasurable d T. - -Obligation Tactic := idtac. - -Lemma mU : setU_closed measurable. -Proof. -move=> A B mA mB; rewrite -bigcup2E. -by apply: measurable_bigcup => -[//|[//|i]]; exact: measurable0. -Qed. - -Lemma mC : setC_closed measurable. Proof. by move=> *; apply: measurableC. Qed. - -HB.instance Definition _ := @isAlgebraOfSets.Build d T - measurable measurable0 mU mC. - -HB.instance Definition _ := - @hasMeasurableCountableUnion.Build d T measurable_bigcup. - -HB.end. - -#[global] Hint Extern 0 (measurable set0) => solve [apply: measurable0] : core. -#[global] Hint Extern 0 (measurable setT) => solve [apply: measurableT] : core. - -Section ringofsets_lemmas. -Context d (T : ringOfSetsType d). -Implicit Types A B : set T. - -Lemma bigsetU_measurable I r (P : pred I) (F : I -> set T) : - (forall i, P i -> measurable (F i)) -> - measurable (\big[setU/set0]_(i <- r | P i) F i). -Proof. by move=> mF; elim/big_ind : _ => //; exact: measurableU. Qed. - -Lemma fin_bigcup_measurable I (D : set I) (F : I -> set T) : - finite_set D -> - (forall i, D i -> measurable (F i)) -> - measurable (\bigcup_(i in D) F i). -Proof. -elim/Pchoice: I => I in D F * => Dfin Fm. -rewrite -bigsetU_fset_set// big_seq; apply: bigsetU_measurable => i. -by rewrite in_fset_set ?inE// => *; apply: Fm. -Qed. - -Lemma measurableD : setD_closed (@measurable d T). -Proof. -move=> A B mA mB; case: (semi_measurableD A B) => // [D [Dfin Dl -> _]]. -by apply: fin_bigcup_measurable. -Qed. - -Lemma seqDU_measurable (F : sequence (set T)) : - (forall n, measurable (F n)) -> forall n, measurable (seqDU F n). -Proof. by move=> Fmeas n; apply/measurableD/bigsetU_measurable. Qed. - -End ringofsets_lemmas. - -Section algebraofsets_lemmas. -Context d (T : algebraOfSetsType d). -Implicit Types A B : set T. - -Lemma measurableC A : measurable A -> measurable (~` A). -Proof. by move=> mA; rewrite -setTD; exact: measurableD. Qed. - -Lemma bigsetI_measurable I r (P : pred I) (F : I -> set T) : - (forall i, P i -> measurable (F i)) -> - measurable (\big[setI/setT]_(i <- r | P i) F i). -Proof. -move=> mF; rewrite -[X in measurable X]setCK setC_bigsetI; apply: measurableC. -by apply: bigsetU_measurable => i Pi; apply/measurableC/mF. -Qed. - -Lemma fin_bigcap_measurable I (D : set I) (F : I -> set T) : - finite_set D -> - (forall i, D i -> measurable (F i)) -> - measurable (\bigcap_(i in D) F i). -Proof. -elim/Pchoice: I => I in D F * => Dfin Fm. -rewrite -bigsetI_fset_set// big_seq; apply: bigsetI_measurable => i. -by rewrite in_fset_set ?inE// => *; apply: Fm. -Qed. - -Lemma measurableID A B : measurable A -> measurable (A `&` B) -> - measurable (A `\` B). -Proof. -move=> mA /measurableC; rewrite setCI => /(measurableI A) => /(_ mA). -by rewrite setIUr setICr set0U. -Qed. - -End algebraofsets_lemmas. - -Section sigmaring_lemmas. -Context d (T : sigmaRingType d). -Implicit Types (A B : set T) (F : (set T)^nat) (P : set nat). - -Lemma bigcup_measurable F P : - (forall k, P k -> measurable (F k)) -> measurable (\bigcup_(i in P) F i). -Proof. -move=> PF; rewrite bigcup_mkcond; apply: bigcupT_measurable => k. -by case: ifP => //; rewrite inE; exact: PF. -Qed. - -Lemma bigcap_measurable F P : P !=set0 -> - (forall k, P k -> measurable (F k)) -> measurable (\bigcap_(i in P) F i). -Proof. -move=> [j Pj] PF; rewrite -(setD_bigcup F Pj). -apply: measurableD; first exact: PF. -by apply: bigcup_measurable => k/= [Pk kj]; apply: measurableD; exact: PF. -Qed. - -Lemma bigcapT_measurable F : - (forall k, measurable (F k)) -> measurable (\bigcap_i F i). -Proof. by move=> PF; apply: bigcap_measurable => //; exists 1. Qed. - -End sigmaring_lemmas. - -Lemma countable_measurable d (T : sigmaRingType d) (A : set T) : - (forall t : T, measurable [set t]) -> countable A -> measurable A. -Proof. -move=> m1; have [->//|/set0P[r Ar]/countable_injP[f injf]] := eqVneq A set0. -rewrite -(injpinv_image (cst r) injf). -rewrite [X in _ X](_ : _ = \bigcup_(x in f @` A) [set 'pinv_(cst r) A f x]). - by apply: bigcup_measurable => _ /= [s As <-]. -by rewrite eqEsubset; split=> [_ [_ [s As <-]] <-|_ [_ [s As <-]] ->]; - exists (f s). -Qed. - -Section sigma_ring_lambda_system. -Context d (T : sigmaRingType d). - -Lemma sigmaRingType_lambda_system (D : set T) : measurable D -> - lambda_system D [set X | measurable X /\ X `<=` D]. -Proof. -move=> mD; split. -- by move=> A /=[]. -- by split. -- move=> B A AB/= [mB BD] [mA AD]; split; first exact: measurableD. - by apply: subset_trans BD; exact: subDsetl. -- move=> /= F _ mFD; split. - by apply: bigcup_measurable => i _; exact: (mFD _).1. - by apply: bigcup_sub => i _; exact: (mFD _).2. -Qed. - -End sigma_ring_lambda_system. - -Lemma countable_bigcupT_measurable d (T : sigmaRingType d) U - (F : U -> set T) : countable [set: U] -> - (forall i, measurable (F i)) -> measurable (\bigcup_i F i). -Proof. -elim/Ppointed: U => U in F *; first by move=> *; rewrite empty_eq0 bigcup0. -move=> /countable_bijP[B] /ppcard_eqP[f] Fm. -rewrite (reindex_bigcup f^-1%FUN setT)//=; first exact: bigcupT_measurable. -exact: (@subl_surj _ _ B). -Qed. - -Lemma bigcupT_measurable_rat d (T : sigmaRingType d) (F : rat -> set T) : - (forall i, measurable (F i)) -> measurable (\bigcup_i F i). -Proof. exact/countable_bigcupT_measurable. Qed. - -Section measurable_lemmas. -Context d (T : measurableType d). -Implicit Types (A B : set T) (F : (set T)^nat) (P : set nat). - -Lemma sigma_algebra_measurable : sigma_algebra setT (@measurable d T). -Proof. by split=> // [A|]; [exact: measurableD|exact: bigcupT_measurable]. Qed. - -Lemma bigcap_measurableType F P : - (forall k, P k -> measurable (F k)) -> measurable (\bigcap_(i in P) F i). -Proof. -move=> PF; rewrite -[X in measurable X]setCK setC_bigcap; apply: measurableC. -by apply: bigcup_measurable => k Pk; exact/measurableC/PF. -Qed. - -End measurable_lemmas. - -Section discrete_measurable. -Context {T : Type}. - -Definition discrete_measurable : set (set T) := [set: set T]. - -Lemma discrete_measurable0 : discrete_measurable set0. Proof. by []. Qed. - -Lemma discrete_measurableC X : - discrete_measurable X -> discrete_measurable (~` X). -Proof. by []. Qed. - -Lemma discrete_measurableU (F : (set T)^nat) : - (forall i, discrete_measurable (F i)) -> - discrete_measurable (\bigcup_i F i). -Proof. by []. Qed. - -End discrete_measurable. - -HB.instance Definition _ := @isMeasurable.Build default_measure_display - unit discrete_measurable discrete_measurable0 - discrete_measurableC discrete_measurableU. - -HB.instance Definition _ := @isMeasurable.Build default_measure_display - bool discrete_measurable discrete_measurable0 - discrete_measurableC discrete_measurableU. - -HB.instance Definition _ := @isMeasurable.Build default_measure_display - nat discrete_measurable discrete_measurable0 - discrete_measurableC discrete_measurableU. - -Definition sigma_display {T} : set (set T) -> measure_display. -Proof. exact. Qed. - -Definition g_sigma_algebraType {T} (G : set (set T)) := T. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `g_sigma_algebraType`")] -Notation salgebraType := g_sigma_algebraType (only parsing). - -Section g_salgebra_instance. -Variables (T : pointedType) (G : set (set T)). - -Lemma sigma_algebraC (A : set T) : <> A -> <> (~` A). -Proof. by move=> sGA; rewrite -setTD; exact: sigma_algebraCD. Qed. - -HB.instance Definition _ := Pointed.on (g_sigma_algebraType G). -HB.instance Definition _ := @isMeasurable.Build (sigma_display G) - (g_sigma_algebraType G) - <> (@sigma_algebra0 _ setT G) (@sigma_algebraC) - (@sigma_algebra_bigcup _ setT G). - -End g_salgebra_instance. - -Notation "G .-sigma" := (sigma_display G) : measure_display_scope. -Notation "G .-sigma.-measurable" := - (measurable : set (set (g_sigma_algebraType G))) : classical_set_scope. - -Lemma measurable_g_measurableTypeE (T : pointedType) (G : set (set T)) : - sigma_algebra setT G -> G.-sigma.-measurable = G. -Proof. exact: sigma_algebra_id. Qed. - -Definition measurable_fun d d' (T : sigmaRingType d) (U : sigmaRingType d') - (D : set T) (f : T -> U) := - measurable D -> forall Y, measurable Y -> measurable (D `&` f @^-1` Y). - -HB.mixin Record isMeasurableFun d d' (aT : sigmaRingType d) (rT : sigmaRingType d') - (f : aT -> rT) := { - measurable_funPT : measurable_fun [set: aT] f -}. -HB.structure Definition MeasurableFun d d' aT rT := - {f of @isMeasurableFun d d' aT rT f}. -Arguments measurable_funPT {d d' aT rT} s. - -Notation "{ 'mfun' aT >-> T }" := (@MeasurableFun.type _ _ aT T) : form_scope. -Notation "[ 'mfun' 'of' f ]" := [the {mfun _ >-> _} of f] : form_scope. -#[global] Hint Extern 0 (measurable_fun [set: _] _) => - solve [apply: measurable_funPT] : core. - -Lemma measurable_funP {d d' : measure_display} - {aT : measurableType d} {rT : sigmaRingType d'} - (D : set aT) (s : {mfun aT >-> rT}) : measurable_fun D s. -Proof. -move=> mD Y mY; apply: measurableI => //. -by rewrite -(setTI (_ @^-1` _)); exact: measurable_funPT. -Qed. -Arguments measurable_funP {d d' aT rT D} s. - -Lemma measurable_funPTI {d d'} {aT : measurableType d} {rT : measurableType d'} - (f : {mfun aT >-> rT}) (Y : set rT) : measurable Y -> measurable (f @^-1` Y). -Proof. by move=> mY; rewrite -[f @^-1` _]setTI; exact: measurable_funP. Qed. - -#[deprecated(since="mathcomp-analysis 1.13.0", note="renamed to `measurable_funPTI`")] -Notation measurable_sfunP := measurable_funPTI (only parsing). - -Section mfun_pred. -Context {d d'} {aT : sigmaRingType d} {rT : sigmaRingType d'}. -Definition mfun : {pred aT -> rT} := mem [set f | measurable_fun setT f]. -Definition mfun_key : pred_key mfun. Proof. exact. Qed. -Canonical mfun_keyed := KeyedPred mfun_key. -End mfun_pred. - -Section measurable_fun. -Context d1 d2 d3 (T1 : sigmaRingType d1) (T2 : sigmaRingType d2) - (T3 : sigmaRingType d3). -Implicit Type D E : set T1. - -Lemma measurable_id D : measurable_fun D id. -Proof. by move=> mD A mA; apply: measurableI. Qed. - -Lemma measurable_comp F (f : T2 -> T3) E (g : T1 -> T2) : - measurable F -> g @` E `<=` F -> - measurable_fun F f -> measurable_fun E g -> measurable_fun E (f \o g). -Proof. -move=> mF FgE mf mg /= mE A mA. -rewrite comp_preimage. -rewrite (_ : _ `&` _ = E `&` g @^-1` (F `&` f @^-1` A)); last first. - apply/seteqP; split=> [|? [?] []//]. - by move=> x/= [Ex Afgx]; split => //; split => //; exact: FgE. -by apply/mg => //; exact: mf. -Qed. - -Lemma eq_measurable_fun D (f g : T1 -> T2) : - {in D, f =1 g} -> measurable_fun D f -> measurable_fun D g. -Proof. -by move=> fg mf mD A mA; rewrite [X in measurable X](_ : _ = D `&` f @^-1` A); - [exact: mf|exact/esym/eq_preimage]. -Qed. - -Lemma measurable_fun_eqP D (f g : T1 -> T2) : - {in D, f =1 g} -> measurable_fun D f <-> measurable_fun D g. -Proof. -by move=> eq_fg; split; apply/eq_measurable_fun => // ? ?; rewrite eq_fg. -Qed. - -Lemma measurable_cst D (r : T2) : measurable_fun D (cst r : T1 -> _). -Proof. -by move=> mD /= Y mY; rewrite preimage_cst; case: ifPn; rewrite ?setIT ?setI0. -Qed. - -Lemma measurable_fun_bigcup (E : (set T1)^nat) (f : T1 -> T2) : - (forall i, measurable (E i)) -> - measurable_fun (\bigcup_i E i) f <-> (forall i, measurable_fun (E i) f). -Proof. -move=> mE; split => [|mf /= _ A mA]; last first. - by rewrite setI_bigcupl; apply: bigcup_measurable => i _; exact: mf. -move=> mf i _ A /mf => /(_ (bigcup_measurable (fun k _ => mE k))). -move=> /(measurableI (E i))-/(_ (mE i)). -by rewrite setICA setIA (@setIidr _ _ (E i))//; exact: bigcup_sup. -Qed. - -Lemma measurable_funU D E (f : T1 -> T2) : measurable D -> measurable E -> - measurable_fun (D `|` E) f <-> measurable_fun D f /\ measurable_fun E f. -Proof. -move=> mD mE; rewrite -bigcup2E; apply: (iff_trans (measurable_fun_bigcup _ _)). - by move=> [//|[//|//=]]. -split=> [mf|[Df Dg] [//|[//|/= _ _ Y mY]]]; last by rewrite set0I. -by split; [exact: (mf 0%N)|exact: (mf 1%N)]. -Qed. - -Lemma measurable_funS E D (f : T1 -> T2) : - measurable E -> D `<=` E -> measurable_fun E f -> - measurable_fun D f. -Proof. -move=> mE DE mf mD; have mC : measurable (E `\` D) by exact: measurableD. -move: (mD). -have := measurable_funU f mD mC. -suff -> : D `|` (E `\` D) = E by move=> [[]] //. -by rewrite setDUK. -Qed. - -Lemma measurable_fun_if (g h : T1 -> T2) D (mD : measurable D) - (f : T1 -> bool) (mf : measurable_fun D f) : - measurable_fun (D `&` (f @^-1` [set true])) g -> - measurable_fun (D `&` (f @^-1` [set false])) h -> - measurable_fun D (fun t => if f t then g t else h t). -Proof. -move=> mx my /= _ B mB; rewrite (_ : _ @^-1` B = - ((f @^-1` [set true]) `&` (g @^-1` B)) `|` - ((f @^-1` [set false]) `&` (h @^-1` B))). - rewrite setIUr; apply: measurableU. - - by rewrite setIA; apply: mx => //; exact: mf. - - by rewrite setIA; apply: my => //; exact: mf. -apply/seteqP; split=> [t /=| t /= [] [] ->//]. -by case: ifPn => ft; [left|right]. -Qed. - -Lemma measurable_fun_set0 (f : T1 -> T2) : measurable_fun set0 f. -Proof. by move=> A B _; rewrite set0I. Qed. - -Lemma measurable_fun_set1 a (f : T1 -> T2) : measurable_fun [set a] f. -Proof. by move=> ? ? ?; rewrite set1I; case: ifP. Qed. - -End measurable_fun. -#[global] Hint Extern 0 (measurable_fun _ (fun=> _)) => - solve [apply: measurable_cst] : core. -#[global] Hint Extern 0 (measurable_fun _ (cst _)) => - solve [apply: measurable_cst] : core. -#[global] Hint Extern 0 (measurable_fun _ id) => - solve [apply: measurable_id] : core. -Arguments eq_measurable_fun {d1 d2 T1 T2 D} f {g}. -Arguments measurable_fun_eqP {d1 d2 T1 T2 D} f {g}. - - -Section mfun. -Context {d d'} {aT : sigmaRingType d} {rT : sigmaRingType d'}. -Notation T := {mfun aT >-> rT}. -Notation mfun := (@mfun _ _ aT rT). - -Section Sub. -Context (f : aT -> rT) (fP : f \in mfun). -Definition mfun_Sub_subproof := @isMeasurableFun.Build d _ aT rT f (set_mem fP). -#[local] HB.instance Definition _ := mfun_Sub_subproof. -Definition mfun_Sub := [mfun of f]. -End Sub. - -Lemma mfun_rect (K : T -> Type) : - (forall f (Pf : f \in mfun), K (mfun_Sub Pf)) -> forall u : T, K u. -Proof. -move=> Ksub [f [[Pf]]]/=. -by suff -> : Pf = (set_mem (@mem_set _ [set f | _] f Pf)) by apply: Ksub. -Qed. - -Lemma mfun_valP f (Pf : f \in mfun) : mfun_Sub Pf = f :> (_ -> _). -Proof. by []. Qed. - -HB.instance Definition _ := isSub.Build _ _ T mfun_rect mfun_valP. - -Lemma mfuneqP (f g : {mfun aT >-> rT}) : f = g <-> f =1 g. -Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. - -HB.instance Definition _ := [Choice of {mfun aT >-> rT} by <:]. - -HB.instance Definition _ x := isMeasurableFun.Build d _ aT rT (cst x) - (@measurable_cst _ _ aT rT setT x). - -End mfun. - -Section measurable_fun_measurableType. -Context d1 d2 d3 (T1 : measurableType d1) (T2 : measurableType d2) - (T3 : measurableType d3). -Implicit Type D E : set T1. - -Lemma measurableT_comp (f : T2 -> T3) E (g : T1 -> T2) : - measurable_fun [set: T2] f -> measurable_fun E g -> measurable_fun E (f \o g). -Proof. exact: measurable_comp. Qed. - -Lemma measurable_funTS D (f : T1 -> T2) : - measurable_fun [set: T1] f -> measurable_fun D f. -Proof. exact: measurable_funS. Qed. - -Lemma measurable_restrict D E (f : T1 -> T2) : measurable D -> measurable E -> - measurable_fun (E `&` D) f <-> measurable_fun E (f \_ D). -Proof. -move=> mD mE; split => mf _ /= Y mY. -- rewrite preimage_restrict; case: ifPn => ptX; last first. - by rewrite set0U setIA; apply: mf => //; exact: measurableI. - rewrite setIUr; apply: measurableU. - by apply: measurableI => //; exact: measurableC. - by rewrite setIA; apply: mf => //; exact: measurableI. -- have := mf mE _ mY; rewrite preimage_restrict; case: ifP => ptY; last first. - by rewrite set0U setIA. - rewrite setUIr setvU setTI setIUr => /(measurableI _ _ mD). - by rewrite setIUr setIA setIAC setICr set0I set0U setICA setIA. -Qed. - -Lemma measurable_restrictT D (f : T1 -> T2) : measurable D -> - measurable_fun D f <-> measurable_fun [set: T1] (f \_ D). -Proof. -by move=> mD; have := measurable_restrict f mD measurableT; rewrite setTI. -Qed. - -Lemma measurable_fun_ifT (g h : T1 -> T2) (f : T1 -> bool) - (mf : measurable_fun [set: T1] f) : - measurable_fun [set: T1] g -> measurable_fun [set: T1] h -> - measurable_fun [set: T1] (fun t => if f t then g t else h t). -Proof. -by move=> mx my; apply: measurable_fun_if => //; - [exact: measurable_funS mx|exact: measurable_funS my]. -Qed. - -Section measurable_fun_bool. -Implicit Types f g : T1 -> bool. - -Let measurable_fun_TF D f : - measurable (D `&` f @^-1` [set true]) -> - measurable (D `&` f @^-1` [set false]) -> - measurable_fun D f. -Proof. -move=> mT mF mD /= Y mY. -have := @subsetT _ Y; rewrite setT_bool => YT. -move: mY; have [-> _|-> _|-> _ |-> _] := subset_set2 YT. -- by rewrite preimage0 ?setI0. -- exact: mT. -- exact: mF. -- by rewrite -setT_bool preimage_setT setIT. -Qed. - -Lemma measurable_fun_bool D f b : - measurable (D `&` f @^-1` [set b]) -> measurable_fun D f. -Proof. -move=> mb mD; have mDb : measurable (D `&` f @^-1` [set ~~ b]). - rewrite (_ : [set ~~ b] = [set~ b]); last first. - by apply/seteqP; split=> -[] /=; case: b {mb}. - by rewrite -preimage_setC; exact: measurableID. -by case: b => /= in mb mDb *; exact: measurable_fun_TF. -Qed. -#[global] Arguments measurable_fun_bool {D f} _. - -Lemma measurable_and D f g : measurable_fun D f -> measurable_fun D g -> - measurable_fun D (fun x => f x && g x). -Proof. -move=> mf mg mD; apply: (measurable_fun_bool true) => //. -rewrite [X in measurable X](_ : _ = D `&` f @^-1` [set true] `&` - (D `&` g @^-1` [set true])); last first. - by rewrite setIACA setIid; congr (_ `&` _); apply/seteqP; split => x /andP. -by apply: measurableI; [exact: mf|exact: mg]. -Qed. - -Lemma measurable_neg D f : - measurable_fun D f -> measurable_fun D (fun x => ~~ f x). -Proof. -move=> mf mD; apply: (measurable_fun_bool true) => //. -rewrite [X in measurable X](_ : _ = (D `&` f @^-1` [set false])). - exact: mf. -by apply/seteqP; split => [x [Dx/= /negbTE]|x [Dx/= ->]]. -Qed. - -Lemma measurable_or D f g : measurable_fun D f -> measurable_fun D g -> - measurable_fun D (fun x => f x || g x). -Proof. -move=> mf mg. -rewrite [X in measurable_fun _ X](_ : _ = (fun x => ~~ (~~ f x && ~~ g x))). - by apply: measurable_neg; apply: measurable_and; exact: measurable_neg. -by apply/funext=> x; rewrite -negb_or negbK. -Qed. - -End measurable_fun_bool. - -End measurable_fun_measurableType. -#[global] Hint Extern 0 (measurable_fun _ (fun=> _)) => - solve [apply: measurable_cst] : core. -#[global] Hint Extern 0 (measurable_fun _ (cst _)) => - solve [apply: measurable_cst] : core. -#[global] Hint Extern 0 (measurable_fun _ id) => - solve [apply: measurable_id] : core. -Arguments eq_measurable_fun {d1 d2 T1 T2 D} f {g}. -Arguments measurable_fun_bool {d1 T1 D f} b. - -Section mfun_measurableType. -Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} - {d3} {T3 : measurableType d3}. -Variables (f : {mfun T2 >-> T3}) (g : {mfun T1 >-> T2}). - -Let measurableT_comp_subproof : measurable_fun setT (f \o g). -Proof. exact: measurableT_comp. Qed. - -HB.instance Definition _ := isMeasurableFun.Build _ _ _ _ (f \o g) - measurableT_comp_subproof. - -End mfun_measurableType. - -Section measurability. - -Definition preimage_set_system {aT rT : Type} (D : set aT) (f : aT -> rT) - (G : set_system rT) : set (set aT) := - [set D `&` f @^-1` B | B in G]. - -Lemma preimage_set_system0 {aT rT : Type} (D : set aT) (f : aT -> rT) : - preimage_set_system D f set0 = set0. -Proof. exact: image_set0. Qed. - -Lemma preimage_set_systemU {aT rT : Type} (D : set aT) (f : aT -> rT) : - {morph preimage_set_system D f : x y / x `|` y >-> x `|` y}. -Proof. exact: image_setU. Qed. - -Lemma preimage_set_system_comp {aT bT rT : Type} (D : set aT) - (f : aT -> bT) (g : bT -> rT) (F : set_system rT) : - preimage_set_system D (g \o f) F - = preimage_set_system D f (preimage_set_system setT g F). -Proof. -apply/seteqP; split=> [_ [B FB] <-|_ [_ [C FC <-] <-]]. - by exists (g @^-1` B) => //; exists B => //; rewrite setTI. -by exists C => //; rewrite setTI comp_preimage. -Qed. - -Lemma preimage_set_system_id {aT : Type} (D : set aT) (F : set (set aT)) : - preimage_set_system D idfun F = setI D @` F. -Proof. by []. Qed. - -(* f is measurable on the sigma-algebra generated by itself *) -Lemma preimage_set_system_measurable_fun d (aT : pointedType) - (rT : measurableType d) (D : set aT) (f : aT -> rT) : - measurable_fun - (D : set (g_sigma_algebraType (preimage_set_system D f measurable))) f. -Proof. by move=> mD A mA; apply: sub_sigma_algebra; exists A. Qed. - -Lemma sigma_algebra_preimage (aT rT : Type) (G : set (set rT)) - (D : set aT) (f : aT -> rT) : - sigma_algebra setT G -> sigma_algebra D (preimage_set_system D f G). -Proof. -case=> h0 hC hU; split; first by exists set0 => //; rewrite preimage_set0 setI0. -- move=> A; rewrite /preimage_set_system /= => -[B mB <-{A}]. - exists (~` B); first by rewrite -setTD; exact: hC. - rewrite predeqE => x; split=> [[Dx Bfx]|[Dx]]; first by split => // -[] _ /Bfx. - by move=> /not_andP[]. -- move=> F; rewrite /preimage_set_system /= => mF. - have {}mF n : exists x, G x /\ D `&` f @^-1` x = F n. - by have := mF n => -[B mB <-]; exists B. - have [F' mF'] := @choice _ _ (fun x y => G y /\ D `&` f @^-1` y = F x) mF. - exists (\bigcup_k (F' k)); first by apply: hU => n; exact: (mF' n).1. - rewrite preimage_bigcup setI_bigcupr; apply: eq_bigcupr => i _. - exact: (mF' i).2. -Qed. - -Definition image_set_system (aT rT : Type) (D : set aT) (f : aT -> rT) - (G : set (set aT)) : set (set rT) := - [set B : set rT | G (D `&` f @^-1` B)]. - -Lemma sigma_algebra_image (aT rT : Type) (D : set aT) (f : aT -> rT) - (G : set (set aT)) : - sigma_algebra D G -> sigma_algebra setT (image_set_system D f G). -Proof. -move=> [G0 GC GU]; split; rewrite /image_set_system. -- by rewrite /= preimage_set0 setI0. -- move=> A /= GfAD; rewrite setTD -preimage_setC -setDE. - rewrite (_ : _ `\` _ = D `\` (D `&` f @^-1` A)); first exact: GC. - rewrite predeqE => x; split=> [[Dx fAx]|[Dx fADx]]. - by split => // -[] _ /fAx. - by split => //; exact: contra_not fADx. -- by move=> F /= mF; rewrite preimage_bigcup setI_bigcupr; exact: GU. -Qed. - -Lemma g_sigma_preimageE aT (rT : pointedType) (D : set aT) - (f : aT -> rT) (G' : set (set rT)) : - <> = - preimage_set_system D f (G'.-sigma.-measurable). -Proof. -rewrite eqEsubset; split. - have mG : sigma_algebra D - (preimage_set_system D f (G'.-sigma.-measurable)). - exact/sigma_algebra_preimage/sigma_algebra_measurable. - have subset_preimage : preimage_set_system D f G' `<=` - preimage_set_system D f (G'.-sigma.-measurable). - by move=> A [B CCB <-{A}]; exists B => //; exact: sub_sigma_algebra. - exact: smallest_sub. -have G'pre A' : G' A' -> (preimage_set_system D f G') (D `&` f @^-1` A'). - by move=> ?; exists A'. -pose I : set (set aT) := <>. -have G'sfun : G' `<=` image_set_system D f I. - by move=> A' /G'pre[B G'B h]; apply: sub_sigma_algebra; exists B. -have sG'sfun : <> `<=` image_set_system D f I. - apply: smallest_sub => //; apply: sigma_algebra_image. - exact: smallest_sigma_algebra. -by move=> _ [B mB <-]; exact: sG'sfun. -Qed. - -Lemma measurability d d' (aT : measurableType d) (rT : measurableType d') - (D : set aT) (f : aT -> rT) (G : set (set rT)) : - @measurable _ rT = <> -> preimage_set_system D f G `<=` @measurable _ aT -> - measurable_fun D f. -Proof. -move=> sG_rT fG_aT mD. -suff h : preimage_set_system D f (@measurable _ rT) `<=` @measurable _ aT. - by move=> A mA; apply: h; exists A. -have -> : preimage_set_system D f (@measurable _ rT) = - <>. - by rewrite [in LHS]sG_rT [in RHS]g_sigma_preimageE. -apply: smallest_sub => //; split => //. -- by move=> A mA; exact: measurableD. -- by move=> F h; exact: bigcupT_measurable. -Qed. - -End measurability. -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `preimage_set_system`")] -Notation preimage_class := preimage_set_system (only parsing). -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `image_set_system`")] -Notation image_class := image_set_system (only parsing). -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `preimage_set_system_measurable_fun`")] -Notation preimage_class_measurable_fun := preimage_set_system_measurable_fun (only parsing). -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `sigma_algebra_preimage`")] -Notation sigma_algebra_preimage_class := sigma_algebra_preimage (only parsing). -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `sigma_algebra_image`")] -Notation sigma_algebra_image_class := sigma_algebra_image (only parsing). - -#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `g_sigma_preimageE`")] -Notation sigma_algebra_preimage_classE := g_sigma_preimageE (only parsing). -Arguments measurability {d d' aT rT D f} _. - -Local Open Scope ereal_scope. - -Definition subset_sigma_subadditive {T} {R : numFieldType} - (mu : set T -> \bar R) (A : set T) (F : nat -> set T) := - A `<=` \bigcup_n F n -> mu A <= \sum_(n \bar R). - -Definition semi_additive2 := forall A B, measurable A -> measurable B -> - measurable (A `|` B) -> - A `&` B = set0 -> mu (A `|` B) = mu A + mu B. - -Definition semi_additive := forall F n, - (forall k : nat, measurable (F k)) -> trivIset setT F -> - measurable (\big[setU/set0]_(k < n) F k) -> - mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). - -Definition semi_sigma_additive := - forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> - measurable (\bigcup_n F n) -> - (fun n => \sum_(0 <= i < n) mu (F i)) @ \oo --> mu (\bigcup_n F n). - -Definition additive2 := forall A B, measurable A -> measurable B -> - A `&` B = set0 -> mu (A `|` B) = mu A + mu B. - -Definition additive := - forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> - forall n, mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). - -Definition sigma_additive := - forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> - (fun n => \sum_(0 <= i < n) mu (F i)) @ \oo --> mu (\bigcup_n F n). - -Definition subadditive := forall (A : set T) (F : nat -> set T) n, - (forall k, `I_n k -> measurable (F k)) -> measurable A -> - A `<=` \big[setU/set0]_(k < n) F k -> - mu A <= \sum_(k < n) mu (F k). - -Definition measurable_subset_sigma_subadditive := - forall (A : set T) (F : nat -> set T), - (forall n, measurable (F n)) -> measurable A -> - subset_sigma_subadditive mu A F. - -Lemma semi_additiveW : mu set0 = 0 -> semi_additive -> semi_additive2. -Proof. -move=> mu0 amx A B mA mB + AB; rewrite -bigcup2inE bigcup_mkord. -move=> /(amx (bigcup2 A B))->. -- by rewrite !(big_ord_recl, big_ord0)/= adde0. -- by move=> [|[|[]]]//=. -- by move=> [|[|i]] [|[|j]]/= _ _; rewrite ?(AB, setI0, set0I, setIC) => -[]. -Qed. - -End additivity. - -Section ring_additivity. -Context d (R : numFieldType) (T : ringOfSetsType d) (mu : set T -> \bar R). - -Lemma semi_additiveE : semi_additive mu = additive mu. -Proof. -rewrite propeqE; split=> [sa A mA tA n|+ A m mA tA UAm]; last by move->. -by rewrite sa //; exact: bigsetU_measurable. -Qed. - -Lemma semi_additive2E : semi_additive2 mu = additive2 mu. -Proof. -rewrite propeqE; split=> [amu A B ? ? ?|amu A B ? ? _ ?]; last by rewrite amu. -by rewrite amu //; exact: measurableU. -Qed. - -Lemma additive2P : mu set0 = 0 -> semi_additive mu <-> additive2 mu. -Proof. -move=> mu0; rewrite -semi_additive2E; split; first exact: semi_additiveW. -rewrite semi_additiveE semi_additive2E => muU A Am Atriv n. -elim: n => [|n IHn]; rewrite ?(big_ord_recr, big_ord0) ?mu0//=. -rewrite muU ?IHn//=; first by apply: bigsetU_measurable. -rewrite -bigcup_mkord -subset0 => x [[/= m + Amx] Anx]. -by rewrite (Atriv m n) ?ltnn//=; exists x. -Qed. - -End ring_additivity. - -(* NB: realFieldType cannot be weakened to numFieldType in the current - state because cvg_lim requires a topology for \bar R which is - defined for at least realFieldType *) -Lemma semi_sigma_additive_is_additive d (T : semiRingOfSetsType d) - (R : realFieldType) (mu : set T -> \bar R) : - mu set0 = 0 -> semi_sigma_additive mu -> semi_additive mu. -Proof. -move=> mu0 samu A n Am Atriv UAm. -have := samu (fun i => if (i < n)%N then A i else set0). -rewrite (bigcup_splitn n) bigcup0 ?setU0; last first. - by move=> i _; rewrite -ltn_subRL subnn. -under eq_bigr do rewrite ltn_ord. -move=> /(_ _ _ UAm)/(@cvg_lim _) <-//; last 2 first. -- by move=> i; case: ifP. -- move=> i j _ _; do 2![case: ifP] => ? ?; do ?by rewrite (setI0, set0I) => -[]. - by move=> /Atriv; apply. -apply: lim_near_cst => //=; near=> i. -have /subnKC<- : (n <= i)%N by near: i; exists n. -transitivity (\sum_(j < n + (i - n)) mu (if (j < n)%N then A j else set0)). - by rewrite big_mkord. -rewrite big_split_ord/=; under eq_bigr do rewrite ltn_ord. -by rewrite [X in _ + X]big1 ?adde0// => ?; rewrite -ltn_subRL subnn. -Unshelve. all: by end_near. Qed. - -Lemma semi_sigma_additiveE - (R : numFieldType) d (T : sigmaRingType d) (mu : set T -> \bar R) : - semi_sigma_additive mu = sigma_additive mu. -Proof. -rewrite propeqE; split=> [amu A mA tA|amu A mA tA mbigcupA]; last exact: amu. -by apply: amu => //; exact: bigcupT_measurable. -Qed. - -Lemma sigma_additive_is_additive - (R : realFieldType) d (T : sigmaRingType d) (mu : set T -> \bar R) : - mu set0 = 0 -> sigma_additive mu -> additive mu. -Proof. -move=> mu0; rewrite -semi_sigma_additiveE -semi_additiveE. -exact: semi_sigma_additive_is_additive. -Qed. - -HB.mixin Record isContent d - (T : semiRingOfSetsType d) (R : numFieldType) (mu : set T -> \bar R) := { - measure_ge0 : forall x, 0 <= mu x ; - measure_semi_additive : semi_additive mu }. - -HB.structure Definition Content d - (T : semiRingOfSetsType d) (R : numFieldType) := { - mu & isContent d T R mu }. - -Notation content := Content.type. -Notation "{ 'content' 'set' T '->' '\bar' R }" := (content T R) : ring_scope. - -Arguments measure_ge0 {d T R} _. - -Section content_signed. -Context d (T : semiRingOfSetsType d) (R : numFieldType). - -Variable mu : {content set T -> \bar R}. - -Lemma content_inum_subproof S : - Itv.spec (@ext_num_sem R) (Itv.Real `[0%Z, +oo[) (mu S). -Proof. -apply/and3P; split. -- by rewrite real_fine -real_leNye; apply: le_trans (measure_ge0 _ _). -- by rewrite /= bnd_simp measure_ge0. -- by rewrite bnd_simp. -Qed. - -Canonical content_inum S := Itv.mk (content_inum_subproof S). - -End content_signed. - -Section content_on_semiring_of_sets. -Context d (T : semiRingOfSetsType d) (R : numFieldType) - (mu : {content set T -> \bar R}). - -Lemma measure0 : mu set0 = 0. -Proof. -have /[!big_ord0] ->// := @measure_semi_additive _ _ _ mu (fun=> set0) 0%N. -exact: trivIset_set0. -Qed. - -Lemma measure_gt0 x : (0%R < mu x) = (mu x != 0). -Proof. by rewrite lt_def measure_ge0 andbT. Qed. - -Hint Resolve measure0 : core. - -Hint Resolve measure_ge0 : core. - -Hint Resolve measure_semi_additive : core. - -Lemma measure_semi_additive_ord (n : nat) (F : 'I_n -> set T) : - (forall (k : 'I_n), measurable (F k)) -> - trivIset setT F -> - measurable (\big[setU/set0]_(k < n) F k) -> - mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). -Proof. -move=> mF tF mUF; pose F' (i : nat) := oapp F set0 (insub i). -have FE (i : 'I_n) : F i = (F' \o val) i by rewrite /F'/= valK/=. -rewrite (eq_bigr (F' \o val))// (eq_bigr (mu \o F' \o val))//; last first. - by move=> i _; rewrite FE. -rewrite -measure_semi_additive//. -- by move=> k; rewrite /F'; case: insubP => /=. -- apply/trivIsetP=> i j _ _; rewrite /F'. - do 2?[case: insubP; rewrite ?(set0I, setI0)//= => ? _ <-]. - by move/trivIsetP: tF; apply. -- by rewrite (eq_bigr (F' \o val)) in mUF. -Qed. - -Lemma measure_semi_additive_ord_I (F : nat -> set T) (n : nat) : - (forall k, (k < n)%N -> measurable (F k)) -> - trivIset `I_n F -> - measurable (\big[setU/set0]_(k < n) F k) -> - mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). -Proof. -move=> mF tF; apply: measure_semi_additive_ord. - by move=> k; apply: mF. -by rewrite trivIset_comp// ?(image_eq [surjfun of val])//; apply: 'inj_val. -Qed. - -Lemma content_fin_bigcup (I : choiceType) (D : set I) (F : I -> set T) : - finite_set D -> - trivIset D F -> - (forall i, D i -> measurable (F i)) -> - measurable (\bigcup_(i in D) F i) -> - mu (\bigcup_(i in D) F i) = \sum_(i \in D) mu (F i). -Proof. -elim/choicePpointed: I => I in D F *. - by rewrite !emptyE => *; rewrite fsbig_set0 bigcup0. -move=> [n /ppcard_eqP[f]] Ftriv Fm UFm. -rewrite -(image_eq [surjfun of f^-1%FUN])/= in UFm Ftriv *. -rewrite bigcup_image fsbig_image//= bigcup_mkord -fsbig_ord/= in UFm *. -rewrite (@measure_semi_additive_ord_I (F \o f^-1))//= 1?trivIset_comp//. -by move=> k kn; apply: Fm; exact: funS. -Qed. - -Lemma measure_semi_additive2 : semi_additive2 mu. -Proof. exact/semi_additiveW. Qed. -Hint Resolve measure_semi_additive2 : core. - -End content_on_semiring_of_sets. -Arguments measure0 {d T R} _. - -#[global] Hint Extern 0 - (is_true (0%R <= (_ : {content set _ -> \bar _}) _)%E) => - solve [apply: measure_ge0] : core. - -#[global] Hint Extern 0 - ((_ : {content set _ -> \bar _}) set0 = 0%R)%E => - solve [apply: measure0] : core. - -#[global] -Hint Resolve measure_semi_additive2 measure_semi_additive : core. - -Section content_on_ring_of_sets. -Context d (R : realFieldType)(T : ringOfSetsType d) - (mu : {content set T -> \bar R}). - -Lemma measureU : additive2 mu. -Proof. by rewrite -semi_additive2E. Qed. - -Lemma measure_bigsetU : additive mu. -Proof. by rewrite -semi_additiveE. Qed. - -Lemma measure_fin_bigcup (I : choiceType) (D : set I) (F : I -> set T) : - finite_set D -> - trivIset D F -> - (forall i, D i -> measurable (F i)) -> - mu (\bigcup_(i in D) F i) = \sum_(i \in D) mu (F i). -Proof. -move=> Dfin Ftriv Fm; rewrite content_fin_bigcup//. -exact: fin_bigcup_measurable. -Qed. - -Lemma measure_bigsetU_ord_cond n (P : {pred 'I_n}) (F : 'I_n -> set T) : - (forall i : 'I_n, P i -> measurable (F i)) -> trivIset P F -> - mu (\big[setU/set0]_(i < n | P i) F i) = (\sum_(i < n | P i) mu (F i))%E. -Proof. -move=> mF tF; rewrite !(big_mkcond P)/= measure_semi_additive_ord//. -- by apply: eq_bigr => i _; rewrite (fun_if mu) measure0. -- by move=> k; case: ifP => //; apply: mF. -- by rewrite -patch_pred trivIset_restr setIT. -- by apply: bigsetU_measurable=> k _; case: ifP => //; apply: mF. -Qed. - -Lemma measure_bigsetU_ord n (P : {pred 'I_n}) (F : 'I_n -> set T) : - (forall i : 'I_n, measurable (F i)) -> trivIset setT F -> - mu (\big[setU/set0]_(i < n | P i) F i) = (\sum_(i < n | P i) mu (F i))%E. -Proof. -by move=> mF tF; rewrite measure_bigsetU_ord_cond//; apply: sub_trivIset tF. -Qed. - -Lemma measure_fbigsetU (I : choiceType) (A : {fset I}) (F : I -> set T) : - (forall i, i \in A -> measurable (F i)) -> trivIset [set` A] F -> - mu (\big[setU/set0]_(i <- A) F i) = (\sum_(i <- A) mu (F i))%E. -Proof. -by move=> mF tF; rewrite -bigcup_fset measure_fin_bigcup// -fsbig_seq. -Qed. - -End content_on_ring_of_sets. - -#[global] -Hint Resolve measureU measure_bigsetU : core. - -HB.mixin Record Content_isMeasure d (T : semiRingOfSetsType d) - (R : numFieldType) (mu : set T -> \bar R) of Content d mu := { - measure_semi_sigma_additive : semi_sigma_additive mu }. - -#[short(type=measure)] -HB.structure Definition Measure d (T : semiRingOfSetsType d) - (R : numFieldType) := - {mu of Content d mu & Content_isMeasure d T R mu }. - -Notation "{ 'measure' 'set' T '->' '\bar' R }" := (measure T%type R) - : ring_scope. - -Section measure_signed. -Context d (R : numFieldType) (T : semiRingOfSetsType d). - -Variable mu : {measure set T -> \bar R}. - -Lemma measure_inum_subproof S : - Itv.spec (@ext_num_sem R) (Itv.Real `[0%Z, +oo[) (mu S). -Proof. -apply/and3P; split. -- by rewrite real_fine -real_leNye; apply: le_trans (measure_ge0 _ _). -- by rewrite /= bnd_simp measure_ge0. -- by rewrite bnd_simp. -Qed. - -Canonical measure_inum S := Itv.mk (measure_inum_subproof S). - -End measure_signed. - -HB.factory Record isMeasure d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : set T -> \bar R) := { - measure0 : mu set0 = 0 ; - measure_ge0 : forall x, 0 <= mu x ; - measure_semi_sigma_additive : semi_sigma_additive mu }. - -HB.builders Context d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : set T -> \bar R) of isMeasure _ T R mu. - -Let semi_additive_mu : semi_additive mu. -Proof. -apply: semi_sigma_additive_is_additive. -- exact: measure0. -- exact: measure_semi_sigma_additive. -Qed. - -HB.instance Definition _ := isContent.Build d T R mu - measure_ge0 semi_additive_mu. -HB.instance Definition _ := Content_isMeasure.Build d T R mu - measure_semi_sigma_additive. -HB.end. - -Lemma eq_measure d (T : measurableType d) (R : realFieldType) - (m1 m2 : {measure set T -> \bar R}) : - (m1 = m2 :> (set T -> \bar R)) -> m1 = m2. -Proof. -move: m1 m2 => [m1 [[m10 m1ge0 [m1sa]]]] [m2 [[+ + [+]]]] /= m1m2. -rewrite -{}m1m2 => m10' m1ge0' m1sa'; f_equal. -by rewrite (_ : m10' = m10)// (_ : m1ge0' = m1ge0)// (_ : m1sa' = m1sa). -Qed. - -Section measure_lemmas. -Context d (R : realFieldType) (T : semiRingOfSetsType d). - -Variable mu : {measure set T -> \bar R}. - -Lemma measure_semi_bigcup A : (forall i : nat, measurable (A i)) -> - trivIset setT A -> measurable (\bigcup_n A n) -> - mu (\bigcup_n A n) = \sum_(i Am Atriv /measure_semi_sigma_additive/cvg_lim<-//. Qed. - -End measure_lemmas. - -#[global] Hint Extern 0 (_ set0 = 0%R) => solve [apply: measure0] : core. -#[global] Hint Extern 0 (is_true (0%:E <= _)) => solve [apply: measure_ge0] : core. - -Section measure_lemmas. -Context d (R : realFieldType) (T : sigmaRingType d). -Variable mu : {measure set T -> \bar R}. - -Lemma measure_sigma_additive : sigma_additive mu. -Proof. -by rewrite -semi_sigma_additiveE //; apply: measure_semi_sigma_additive. -Qed. - -Lemma measure_bigcup (D : set nat) F : (forall i, D i -> measurable (F i)) -> - trivIset D F -> mu (\bigcup_(n in D) F n) = \sum_(i mF tF; rewrite bigcup_mkcond measure_semi_bigcup. -- by rewrite [in RHS]eseries_mkcond; apply: eq_eseriesr => n _; case: ifPn. -- by move=> i; case: ifPn => // /set_mem; exact: mF. -- by move/trivIset_mkcond : tF. -- by rewrite -bigcup_mkcond; exact: bigcup_measurable. -Qed. - -End measure_lemmas. -Arguments measure_bigcup {d R T} _ _. - -#[global] Hint Extern 0 (sigma_additive _) => - solve [apply: measure_sigma_additive] : core. - -Definition pushforward d1 d2 (T1 : sigmaRingType d1) (T2 : sigmaRingType d2) - (R : realFieldType) (m : set T1 -> \bar R) (f : T1 -> T2) - := fun A => m (f @^-1` A). -Arguments pushforward {d1 d2 T1 T2 R}. - -Section pushforward_measure. -Local Open Scope ereal_scope. -Context d d' (T1 : measurableType d) (T2 : measurableType d') - (R : realFieldType). -Variables (m : {measure set T1 -> \bar R}) (f : T1 -> T2). -Hypothesis mf : measurable_fun [set: T1] f. - -Let pushforward0 : pushforward m f set0 = 0. -Proof. by rewrite /pushforward preimage_set0 measure0. Qed. - -Let pushforward_ge0 A : 0 <= pushforward m f A. -Proof. by apply: measure_ge0; rewrite -[X in measurable X]setIT; apply: mf. Qed. - -Let pushforward_sigma_additive : semi_sigma_additive (pushforward m f). -Proof. -move=> F mF tF mUF; rewrite /pushforward preimage_bigcup. -apply: measure_semi_sigma_additive. -- by move=> n; rewrite -[X in measurable X]setTI; exact: mf. -- apply/trivIsetP => /= i j _ _ ij; rewrite -preimage_setI. - by move/trivIsetP : tF => /(_ _ _ _ _ ij) ->//; rewrite preimage_set0. -- by rewrite -preimage_bigcup -[X in measurable X]setTI; exact: mf. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ - (pushforward m f) pushforward0 pushforward_ge0 pushforward_sigma_additive. - -End pushforward_measure. - -Section dirac_measure. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (a : T) (R : realFieldType). - -Definition dirac (A : set T) : \bar R := (\1_A a)%:E. - -Let dirac0 : dirac set0 = 0. Proof. by rewrite /dirac indic0. Qed. - -Let dirac_ge0 B : 0 <= dirac B. Proof. by rewrite /dirac indicE. Qed. - -Let dirac_sigma_additive : semi_sigma_additive dirac. -Proof. -move=> F mF tF mUF; rewrite /dirac indicE; have [|aFn] /= := boolP (a \in _). - rewrite inE => -[n _ Fna]. - have naF m : m != n -> a \notin F m. - move=> mn; rewrite notin_setE => Fma. - move/trivIsetP : tF => /(_ _ _ Logic.I Logic.I mn). - by rewrite predeqE => /(_ a)[+ _]; exact. - apply/cvg_ballP => _/posnumP[e]; near=> m. - have mn : (n < m)%N by near: m; exists n.+1. - rewrite big_mkord (bigID (xpred1 (Ordinal mn)))//= big_pred1_eq/= big1/=. - by rewrite adde0 indicE mem_set//; exact: ballxx. - by move=> j ij; rewrite indicE (negbTE (naF _ _)). -rewrite [X in X @ \oo --> _](_ : _ = cst 0); first exact: cvg_cst. -apply/funext => n; rewrite big1// => i _; rewrite indicE; apply/eqP. -by rewrite eqe pnatr_eq0 eqb0; apply: contra aFn => /[!inE] aFn; exists i. -Unshelve. all: by end_near. Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ - dirac dirac0 dirac_ge0 dirac_sigma_additive. - -End dirac_measure. -Arguments dirac {d T} _ {R}. - -Notation "\d_ a" := (dirac a) : ring_scope. - -Section dirac_lemmas_realFieldType. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realFieldType). - -Lemma diracE a (A : set T) : \d_a A = (a \in A)%:R%:E :> \bar R. -Proof. by rewrite /dirac indicE. Qed. - -Lemma dirac0 (a : T) : \d_a set0 = 0 :> \bar R. -Proof. by rewrite diracE in_set0. Qed. - -Lemma diracT (a : T) : \d_a setT = 1 :> \bar R. -Proof. by rewrite diracE in_setT. Qed. - -End dirac_lemmas_realFieldType. - -Section dirac_lemmas. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realType). - -Lemma finite_card_sum (A : set T) : finite_set A -> - \esum_(i in A) 1 = (#|` fset_set A|%:R)%:E :> \bar R. -Proof. -move=> finA; rewrite esum_fset// (eq_fsbigr (cst 1))//. -by rewrite card_fset_sum1// natr_sum -sumEFin fsbig_finite. -Qed. - -Lemma finite_card_dirac (A : set T) : finite_set A -> - \esum_(i in A) \d_ i A = (#|` fset_set A|%:R)%:E :> \bar R. -Proof. -move=> finA; rewrite esum_fset// (eq_fsbigr (cst 1))//. - by rewrite card_fset_sum1// natr_sum -sumEFin fsbig_finite. -by move=> i iA; rewrite diracE iA. -Qed. - -Lemma infinite_card_dirac (A : set T) : infinite_set A -> - \esum_(i in A) \d_ i A = +oo :> \bar R. -Proof. -move=> infA; apply/eqyP => r r0. -have [B BA Br] := infinite_set_fset (trunc r).+1 infA. -apply: esum_ge; exists [set` B] => //. -apply: (@le_trans _ _ (trunc r).+1%:R%:E). - by rewrite lee_fin ltW// truncnS_gt. -move: Br; rewrite -(@ler_nat R) -lee_fin => /le_trans; apply. -rewrite (eq_fsbigr (cst 1))/=; last first. - by move=> i /[!inE] /BA /mem_set iA; rewrite diracE iA. -by rewrite fsbig_finite//= card_fset_sum1 sumEFin natr_sum// set_fsetK. -Qed. - -End dirac_lemmas. - -Section measure_sum. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realType). -Variables (m : {measure set T -> \bar R}^nat) (n : nat). - -Definition msum (A : set T) : \bar R := \sum_(k < n) m k A. - -Let msum0 : msum set0 = 0. Proof. by rewrite /msum big1. Qed. - -Let msum_ge0 B : 0 <= msum B. Proof. by rewrite /msum; apply: sume_ge0. Qed. - -Let msum_sigma_additive : semi_sigma_additive msum. -Proof. -move=> F mF tF mUF; rewrite [X in _ --> X](_ : _ = - lim ((fun n => \sum_(0 <= i < n) msum (F i)) @ \oo)). - by apply: is_cvg_ereal_nneg_natsum => k _; exact: sume_ge0. -rewrite nneseries_sum//; apply: eq_bigr => /= i _. -exact: measure_semi_bigcup. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ msum - msum0 msum_ge0 msum_sigma_additive. - -End measure_sum. -Arguments msum {d T R}. - -Section measure_zero. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realFieldType). - -Definition mzero (A : set T) : \bar R := 0. - -Let mzero0 : mzero set0 = 0. Proof. by []. Qed. - -Let mzero_ge0 B : 0 <= mzero B. Proof. by []. Qed. - -Let mzero_sigma_additive : semi_sigma_additive mzero. -Proof. -move=> F mF tF mUF; rewrite [X in X @ \oo--> _](_ : _ = cst 0); first exact: cvg_cst. -by apply/funext => n; rewrite big1. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ mzero - mzero0 mzero_ge0 mzero_sigma_additive. - -End measure_zero. -Arguments mzero {d T R}. - -Lemma msum_mzero d (T : sigmaRingType d) (R : realType) - (m_ : {measure set T -> \bar R}^nat) : - msum m_ 0 = mzero. -Proof. by apply/funext => A/=; rewrite /msum big_ord0. Qed. - -Section measure_add. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realType). -Variables (m1 m2 : {measure set T -> \bar R}). - -Definition measure_add := msum (fun n => if n is 0%N then m1 else m2) 2. - -Lemma measure_addE A : measure_add A = m1 A + m2 A. -Proof. by rewrite /measure_add/= /msum 2!big_ord_recl/= big_ord0 adde0. Qed. - -End measure_add. - -Section measure_scale. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realFieldType). -Variables (r : {nonneg R}) (m : {measure set T -> \bar R}). - -Definition mscale (A : set T) : \bar R := r%:num%:E * m A. - -Let mscale0 : mscale set0 = 0. Proof. by rewrite /mscale measure0 mule0. Qed. - -Let mscale_ge0 B : 0 <= mscale B. -Proof. by rewrite /mscale mule_ge0. Qed. - -Let mscale_sigma_additive : semi_sigma_additive mscale. -Proof. -move=> F mF tF mUF; rewrite [X in X @ \oo --> _](_ : _ = - (fun n => (r%:num)%:E * \sum_(0 <= i < n) m (F i))); last first. - by apply/funext => k; rewrite ge0_sume_distrr. -rewrite /mscale; have [->|r0] := eqVneq r%:num 0%R. - rewrite mul0e [X in X @ \oo --> _](_ : _ = cst 0); first exact: cvg_cst. - by under eq_fun do rewrite mul0e. -by apply: cvgeZl => //; exact: measure_semi_sigma_additive. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ mscale - mscale0 mscale_ge0 mscale_sigma_additive. - -End measure_scale. -Arguments mscale {d T R}. - -Section measure_series. -Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realType). -Variables (m : {measure set T -> \bar R}^nat) (n : nat). - -Definition mseries (A : set T) : \bar R := \sum_(n <= k F mF tF mUF; rewrite [X in _ --> X](_ : _ = - lim ((fun n => \sum_(0 <= i < n) mseries (F i)) @ \oo)); last first. - rewrite [in LHS]/mseries. - transitivity (\sum_(n <= k m k (\bigcup_n0 F n0))) => i ni. - exact: measure_semi_bigcup. - rewrite ereal_series nneseries_interchange//. - apply: (@eq_eseriesr _ (fun j => \sum_(i \sum_(n <= k i _; rewrite ereal_series. -apply: is_cvg_ereal_nneg_natsum => k _. -by rewrite /mseries ereal_series; exact: nneseries_ge0. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ mseries - mseries0 mseries_ge0 mseries_sigma_additive. - -End measure_series. -Arguments mseries {d T R}. - -Definition mrestr d (T : sigmaRingType d) (R : realFieldType) (D : set T) - (f : set T -> \bar R) (mD : measurable D) := fun X => f (X `&` D). - -Section measure_restr. -Context d (T : sigmaRingType d) (R : realFieldType). -Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). - -Local Notation restr := (mrestr mu mD). - -Let restr0 : restr set0 = 0%E. Proof. by rewrite /mrestr set0I. Qed. - -Let restr_ge0 (A : set _) : (0 <= restr A)%E. -Proof. by rewrite /restr; apply: measure_ge0; exact: measurableI. Qed. - -Let restr_sigma_additive : semi_sigma_additive restr. -Proof. -move=> F mF tF mU; pose FD i := F i `&` D. -have mFD i : measurable (FD i) by exact: measurableI. -have tFD : trivIset setT FD. - apply/trivIsetP => i j _ _ ij. - move/trivIsetP : tF => /(_ i j Logic.I Logic.I ij). - by rewrite /FD setIACA => ->; rewrite set0I. -by rewrite /restr setI_bigcupl; exact: measure_sigma_additive. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ restr - restr0 restr_ge0 restr_sigma_additive. - -End measure_restr. - -Definition counting (T : choiceType) (R : realType) (X : set T) : \bar R := - if `[< finite_set X >] then (#|` fset_set X |)%:R%:E else +oo. -Arguments counting {T R}. - -Section measure_count. -Context d (T : sigmaRingType d) (R : realType). -Variables (D : set T) (mD : measurable D). - -Local Notation counting := (@counting T R). - -Let counting0 : counting set0 = 0. -Proof. by rewrite /counting asboolT// fset_set0. Qed. - -Let counting_ge0 (A : set T) : 0 <= counting A. -Proof. by rewrite /counting; case: ifPn; rewrite ?lee_fin// lee_pinfty. Qed. - -Let counting_sigma_additive : semi_sigma_additive counting. -Proof. -move=> F mF tF mU. -have [[i Fi]|infinF] := pselect (exists k, infinite_set (F k)). - have -> : counting (\bigcup_n F n) = +oo. - rewrite /counting asboolF//. - by apply: contra_not Fi; exact/sub_finite_set/bigcup_sup. - apply/cvgeyPge => M; near=> n. - have ni : (i < n)%N by near: n; exists i.+1. - rewrite (bigID (xpred1 i))/= big_mkord (big_pred1 (Ordinal ni))//=. - rewrite [X in X + _]/(counting _) asboolF// addye ?leey//. - by rewrite gt_eqF// (@lt_le_trans _ _ 0)//; exact: sume_ge0. -have {infinF}finF : forall i, finite_set (F i) by exact/not_forallP. -pose u : nat^nat := fun n => #|` fset_set (F n) |. -have sumFE n : \sum_(i < n) counting (F i) = - #|` fset_set (\big[setU/set0]_(k < n) F k) |%:R%:E. - rewrite -trivIset_sum_card// natr_sum -sumEFin. - by apply: eq_bigr => // i _; rewrite /counting asboolT. -have [cvg_u|dvg_u] := pselect (cvg (nseries u @ \oo)). - have [N _ Nu] : \forall n \near \oo, u n = 0%N by apply: cvg_nseries_near. - rewrite [X in _ --> X](_ : _ = \sum_(i < N) counting (F i)); last first. - have -> : \bigcup_i (F i) = \big[setU/set0]_(i < N) F i. - rewrite (bigcupID (`I_N)) setTI bigcup_mkord. - rewrite [X in _ `|` X](_ : _ = set0) ?setU0// bigcup0// => i [_ /negP]. - by rewrite -leqNgt => /Nu/eqP/[!cardfs_eq0]/eqP/fset_set_set0 ->. - by rewrite /counting /= asboolT ?sumFE// -bigcup_mkord; exact: bigcup_finite. - rewrite -(cvg_shiftn N)/=. - rewrite (_ : (fun n => _) = (fun=> \sum_(i < N) counting (F i))). - exact: cvg_cst. - apply/funext => n; rewrite /index_iota subn0 (addnC n) iotaD big_cat/=. - rewrite [X in _ + X](_ : _ = 0) ?adde0. - by rewrite -{1}(subn0 N) big_mkord. - rewrite add0n big_seq big1// => i /[!mem_iota] => /andP[NI iNn]. - by rewrite /counting asboolT//= -/(u _) Nu. -have {dvg_u}cvg_F : (fun n => \sum_(i < n) counting (F i)) @ \oo --> +oo. - rewrite (_ : (fun n => _) = [sequence (\sum_(0 <= i < n) (u i))%:R%:E]_n). - exact/cvgenyP/dvg_nseries. - apply/funext => n /=; under eq_bigr. - by rewrite /counting => i _; rewrite asboolT//; over. - by rewrite sumEFin natr_sum big_mkord. -have [UFoo|/contrapT[k UFk]] := pselect (infinite_set (\bigcup_n F n)). - rewrite /counting asboolF//. - by under eq_fun do rewrite big_mkord. -suff: false by []. -move: cvg_F =>/cvgeyPge/(_ k.+1%:R) [K _] /(_ K (leqnn _)) /=; apply: contra_leT => _. -rewrite sumFE lte_fin ltr_nat ltnS. -have -> : k = #|` fset_set (\bigcup_n F n) |. - by apply/esym/card_eq_fsetP; rewrite fset_setK//; exists k. -apply/fsubset_leq_card; rewrite -fset_set_sub //. -- by move=> /= t; rewrite -bigcup_mkord => -[m _ Fmt]; exists m. -- by rewrite -bigcup_mkord; exact: bigcup_finite. -- by exists k. -Unshelve. all: by end_near. Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ counting - counting0 counting_ge0 counting_sigma_additive. - -End measure_count. - -Lemma big_trivIset (I : choiceType) D T (R : Type) (idx : R) - (op : Monoid.com_law idx) (A : I -> set T) (F : set T -> R) : - finite_set D -> trivIset D A -> F set0 = idx -> - \big[op/idx]_(i <- fset_set D) F (A i) = - \big[op/idx]_(X <- (A @` fset_set D)%fset) F X. -Proof. -elim/Pchoice: R => R in idx op F *. -move=> Dfin Atriv F0; symmetry. -pose D' := [fset i in fset_set D | A i != set0]%fset. -transitivity (\big[op/idx]_(X <- (A @` D')%fset) F X). - apply: perm_big_supp; rewrite uniq_perm ?filter_uniq//=. - move=> X; rewrite !mem_filter; case: (eqVneq (F X) idx) => //= FXNidx. - apply/imfsetP/imfsetP=> -[i/=]; rewrite ?(inE, in_fset_set)//=. - move=> Di XAi; exists i; rewrite // !(inE, in_fset_set)//=. - by rewrite (mem_set Di)/= -XAi; apply: contra_neq FXNidx => ->. - by move=> /andP[Di AiN0] XAi; exists i; rewrite ?in_fset_set. -rewrite big_imfset//=; last first. - move=> i j; rewrite !(inE, in_fset_set)//= => /andP[+ +] /andP[+ +]. - rewrite !inE => Di /set0P[x Aix] Dj _ Aij. - by apply: (Atriv _ _ Di Dj); exists x; split=> //; rewrite -Aij. -apply: perm_big_supp; rewrite uniq_perm ?filter_uniq//= => i. -rewrite !mem_filter; case: (eqVneq (F (A i)) idx) => //= FAiidx. -rewrite !(in_fset_set, inE)//=; case: (boolP (i \in D)) => //= Di. -by apply: contra_neq FAiidx => ->. -Qed. - -Section covering. -Context {T : Type}. -Implicit Type (C : forall I, set (set I)). -Implicit Type (P : forall I, set I -> set (I -> set T)). - -Definition covered_by C P := - [set X : set T | exists I D A, [/\ C I D, P I D A & X = \bigcup_(i in D) A i]]. - -Lemma covered_bySr C P P' : (forall I D A, P I D A -> P' I D A) -> - covered_by C P `<=` covered_by C P'. -Proof. -by move=> PP' X [I [D [A [CX PX ->]]]]; exists I, D, A; split=> //; apply: PP'. -Qed. - -Lemma covered_byP C P I D A : C I D -> P I D A -> - covered_by C P (\bigcup_(i in D) A i). -Proof. by move=> CID PIDA; exists I, D, A. Qed. - -Lemma covered_by_finite P : - (forall I (D : set I) A, (forall i, D i -> A i = set0) -> P I D A) -> - (forall (I : pointedType) D A, finite_set D -> P I D A -> - P nat `I_#|` fset_set D| (A \o nth point (fset_set D))) -> - covered_by (@finite_set) P = - [set X : set T | exists n A, [/\ P nat `I_n A & X = \bigcup_(i < n) A i]]. -Proof. -move=> P0 Pc; apply/predeqP=> X; rewrite /covered_by /cover/=; split; last first. - by move=> [n [A [Am ->]]]; exists nat, `I_n, A; split. -case; elim/Ppointed=> I [D [A [Dfin Am ->]]]. - exists 0%N, (fun=> set0); split; first by rewrite II0; apply: P0. - by rewrite //= emptyE II0 !bigcup0. -exists #|`fset_set D|, (A \o nth point (fset_set D)). -split; first exact: Pc. -by rewrite -bigsetU_fset_set// (big_nth point) big_mkord bigcup_mkord. -Qed. - -Lemma covered_by_countable P : - (forall I (D : set I) A, (forall i, D i -> A i = set0) -> P I D A) -> - (forall (I : choiceType) (D : set I) (A : I -> set T) (f : nat -> I), - set_surj [set: nat] D f -> - P I D A -> P nat [set: nat] (A \o f)) -> - covered_by (@countable) P = - [set X : set T | exists A, [/\ P nat [set: nat] A & X = \bigcup_i A i]]. -Proof. -move=> P0 Pc; apply/predeqP=> X; rewrite /covered_by /cover/=; split; last first. - by move=> [A [Am ->]]; exists nat, [set: nat], A; split. -case; elim/Ppointed=> I [D [A [Dcnt Am ->]]]. - exists (fun=> set0); split; first exact: P0. - by rewrite emptyE bigcup_set0 bigcup0. -have /pfcard_geP[->|[f]] := Dcnt. - exists (fun=> set0); split; first exact: P0. - by rewrite !bigcup_set0 bigcup0. -pose g := [splitsurjfun of split f]. -exists (A \o g); split=> /=; first exact: Pc Am. -apply/predeqP=> x; split=> [[i Di Aix]|[n _ Afnx]]. - by exists (g^-1%FUN i) => //=; rewrite invK// inE. -by exists (g n) => //; apply: funS. -Qed. - -End covering. - -Module SetRing. -Definition type (T : Type) := T. -Definition display : measure_display -> measure_display. Proof. by []. Qed. - -Section SetRing. -Context d {T : semiRingOfSetsType d}. - -Notation rT := (type T). -#[export] -HB.instance Definition _ := Pointed.on rT. -#[export] -HB.instance Definition _ := isRingOfSets.Build (display d) rT - (@setring0 T measurable) (@setringU T measurable) (@setringD T measurable). - -Local Notation "d .-ring" := (display d). -Local Notation "d .-ring.-measurable" := - ((d%mdisp.-ring).-measurable : set (set (type _))). - -Local Definition measurable_fin_trivIset : set (set T) := - [set A | exists B : set (set T), - [/\ A = \bigcup_(X in B) X, forall X : set T, B X -> measurable X, - finite_set B & trivIset B id]]. - -Lemma ring_measurableE : d.-ring.-measurable = measurable_fin_trivIset. -Proof. -apply/seteqP; split; last first. - move=> _ [B [-> Bm Bfin Btriv]]; apply: fin_bigcup_measurable => //. - by move=> i Di; apply: sub_gen_smallest; apply: Bm. -have mdW A : measurable A -> measurable_fin_trivIset A. - move=> Am; exists [set A]; split; do ?by [rewrite bigcup_set1|move=> ? ->|]. - by move=> ? ? -> ->. -have mdI : setI_closed measurable_fin_trivIset. - move=> _ _ [A [-> Am Afin Atriv]] [B [-> Bm Bfin Btriv]]. - rewrite setI_bigcupl; under eq_bigcupr do rewrite setI_bigcupr. - rewrite -bigcup_setX -(bigcup_image _ _ id). - eexists; split; [reflexivity | | exact/finite_image/finite_setX |]. - by move=> _ [X [? ?] <-]; apply: measurableI; [apply: Am|apply: Bm]. - apply: trivIset_sets => -[a b] [a' b']/= [Xa Xb] [Xa' Xb']; rewrite setIACA. - by move=> [x [Ax Bx]]; rewrite (Atriv a a') 1?(Btriv b b')//; exists x. -have mdisj_bigcap : finN0_bigcap_closed measurable_fin_trivIset. - exact/finN0_bigcap_closedP/mdI. -have mDbigcup I (D : set I) (A : set T) (B : I -> set T) : finite_set D -> - measurable A -> (forall i, D i -> measurable (B i)) -> - measurable_fin_trivIset (A `\` \bigcup_(i in D) B i). - have [->|/set0P D0] := eqVneq D set0. - by rewrite bigcup0// setD0 => *; apply: mdW. - move=> Dfin Am Bm; rewrite -bigcupDr//; apply: mdisj_bigcap=> // i Di. - by have [F [Ffin Fm -> ?]] := semi_measurableD A (B i) Am (Bm _ Di); exists F. -have mdU : fin_trivIset_closed measurable_fin_trivIset. - elim/Pchoice=> I D F Dfin Ftriv Fm. - have /(_ _ (set_mem _))/cid-/(all_sig_cond_dep (fun=> set0)) - [G /(_ _ (mem_set _))GP] := Fm _ _. - under eq_bigcupr => i Di do case: (GP i Di) => ->. - rewrite -bigcup_setX_dep -(bigcup_image _ _ id); eexists; split=> //. - - by move=> _ [i [Di Gi] <-]; have [_ + _ _] := GP i.1 Di; apply. - - by apply: finite_image; apply: finite_setXR=> // i Di; have [] := GP i Di. - apply: trivIset_sets => -[i X] [j Y] /= [Di Gi] [Dj Gj] XYN0. - suff eqij : i = j. - by rewrite {i}eqij in Di Gi *; have [_ _ _ /(_ _ _ _ _ XYN0)->] := GP j Dj. - apply: Ftriv => //; have [-> _ _ _] := GP j Dj; have [-> _ _ _] := GP i Di. - by case: XYN0 => [x [Xx Yx]]; exists x; split; [exists X|exists Y]. -have mdDI : setD_closed measurable_fin_trivIset. - move=> A B mA mB; have [F [-> Fm Ffin Ftriv]] := mA. - have [F' [-> F'm F'fin F'triv]] := mB. - have [->|/set0P F'N0] := eqVneq F' set0. - by rewrite bigcup_set0 setD0; exists F. - rewrite setD_bigcupl; apply: mdU => //; first by apply: trivIset_setIr. - move=> X DX; rewrite -bigcupDr//; apply: mdisj_bigcap => //. - move=> Y DY; case: (semi_measurableD X Y); [exact: Fm|exact: F'm|]. - by move=> G [Gfin Gm -> Gtriv]; exists G. -apply: smallest_sub => //; split=> //; first by apply: mdW. -move=> A B mA mB; rewrite -(setUIDK B A) setUA [X in X `|` _]setUidl//. -rewrite -bigcup2inE; apply: mdU => //; last by move=> [|[]]// _; apply: mdDI. -by move=> [|[]]// [|[]]//= _ _ []; rewrite setDE ?setIA => X [] []//. -Qed. - -Lemma measurable_subring : (d.-measurable : set (set T)) `<=` d.-ring.-measurable. -Proof. by rewrite /measurable => X Xmeas /= M /= [_]; apply. Qed. - -Lemma ring_finite_set (A : set rT) : measurable A -> exists B : set (set T), - [/\ finite_set B, - (forall X, B X -> X !=set0), - trivIset B id, - (forall X : set T, X \in B -> measurable X) & - A = \bigcup_(X in B) X]. -Proof. -rewrite ring_measurableE => -[B [-> Bm Bfin Btriv]]. -exists (B `&` [set X | X != set0]); split. -- by apply: sub_finite_set Bfin; exact: subIsetl. -- by move=> ?/= [_ /set0P]. -- by move=> X Y/= [XB _] [YB _]; exact: Btriv. -- by move=> X/= /[!inE] -[] /Bm. -rewrite bigcup_mkcondr; apply: eq_bigcupr => X Bx; case: ifPn => //. -by rewrite notin_setE/= => /negP/negPn/eqP. -Qed. - -Definition decomp (A : set rT) : set (set T) := - if A == set0 then [set set0] else - if pselect (measurable A) is left mA then projT1 (cid (ring_finite_set mA)) - else [set A]. - -Lemma decomp_finite_set (A : set rT) : finite_set (decomp A). -Proof. -rewrite /decomp; case: ifPn => // A0; case: pselect => // X. -by case: cid => /= ? []. -Qed. - -Lemma decomp_triv (A : set rT) : trivIset (decomp A) id. -Proof. -rewrite /decomp; case: ifP => _; first by move=> i j/= -> ->. -case: pselect => // Am; first by case: cid => //= ? []. -by move=> i j /= -> ->. -Qed. -Hint Resolve decomp_triv : core. - -Lemma all_decomp_neq0 (A : set rT) : - A !=set0 -> (forall X, decomp A X -> X !=set0). -Proof. -move=> /set0P AN0; rewrite /decomp/= (negPf AN0). -case: pselect => //= Am; first by case: cid => //= ? []. -by move=> X ->; exact/set0P. -Qed. - -Lemma decomp_neq0 (A : set rT) X : A !=set0 -> X \in decomp A -> X !=set0. -Proof. by move=> /all_decomp_neq0/(_ X) /[!inE]. Qed. - -Lemma decomp_measurable (A : set rT) (X : set T) : - measurable A -> X \in decomp A -> measurable X. -Proof. -rewrite /decomp; case: ifP => _; first by rewrite inE => _ ->. -by case: pselect => // Am _; case: cid => //= ? [_ _ _ + _]; apply. -Qed. - -Lemma cover_decomp (A : set rT) : \bigcup_(X in decomp A) X = A. -Proof. -rewrite /decomp; case: ifP => [/eqP->|_]; first by rewrite bigcup0. -case: pselect => // Am; first by case: cid => //= ? []. -by rewrite bigcup_set1. -Qed. - -Lemma decomp_sub (A : set rT) (X : set T) : X \in decomp A -> X `<=` A. -Proof. -rewrite /decomp; case: ifP => _; first by rewrite inE/= => ->//. -case: pselect => //= Am; last by rewrite inE => ->. -by case: cid => //= D [_ _ _ _ ->] /[!inE] XD; apply: bigcup_sup. -Qed. - -Lemma decomp_set0 : decomp set0 = [set set0]. -Proof. by rewrite /decomp eqxx. Qed. - -Lemma decompN0 (A : set rT) : decomp A != set0. -Proof. -rewrite /decomp; case: ifPn => [_|AN0]; first by apply/set0P; exists set0. -case: pselect=> //= Am; last by apply/set0P; exists A. -case: cid=> //= D [_ _ _ _ Aeq]; apply: contra_neq AN0; rewrite Aeq => ->. -by rewrite bigcup_set0. -Qed. - -Definition measure (R : numDomainType) (mu : set T -> \bar R) - (A : set rT) : \bar R := \sum_(X \in decomp A) mu X. - -Section content. -Context {R : realFieldType} (mu : {content set T -> \bar R}). -Local Notation Rmu := (measure mu). -Arguments big_trivIset {I D T R idx op} A F. - -Lemma Rmu_fin_bigcup (I : choiceType) (D : set I) (F : I -> set T) : - finite_set D -> trivIset D F -> (forall i, i \in D -> measurable (F i)) -> - Rmu (\bigcup_(i in D) F i) = \sum_(i \in D) mu (F i). -Proof. -move=> Dfin Ftriv Fm; rewrite /measure. -have mUD : measurable (\bigcup_(i in D) F i : set rT). - apply: fin_bigcup_measurable => // *; apply: sub_gen_smallest. - exact/Fm/mem_set. -have [->|/set0P[i0 Di0]] := eqVneq D set0. - by rewrite bigcup_set0 decomp_set0 fsbig_set0 fsbig_set1. -set E := decomp _; have Em X := decomp_measurable mUD X. -transitivity (\sum_(X \in E) \sum_(i \in D) mu (X `&` F i)). - apply: eq_fsbigr => /= X XE; have XDF : X = \bigcup_(i in D) (X `&` F i). - by rewrite -setI_bigcupr setIidl//; exact: decomp_sub. - rewrite [in LHS]XDF content_fin_bigcup//; first exact: trivIset_setIl. - - by move=> i /mem_set Di; apply: measurableI; [exact: Em|exact: Fm]. - - by rewrite -XDF; exact: Em. -rewrite exchange_fsbig //; last exact: decomp_finite_set. -apply: eq_fsbigr => i Di; have Feq : F i = \bigcup_(X in E) (X `&` F i). - rewrite -setI_bigcupl setIidr// cover_decomp. - by apply/bigcup_sup; exact: set_mem. -rewrite -content_fin_bigcup -?Feq//; [exact/decomp_finite_set| | |exact/Fm]. -- exact/trivIset_setIr/decomp_triv. -- by move=> X /= XE; apply: measurableI; [apply: Em; rewrite inE | exact: Fm]. -Qed. - -Lemma RmuE (A : set T) : measurable A -> Rmu A = mu A. -Proof. -move=> Am; rewrite -[A in LHS](@bigcup_set1 _ unit _ tt). -by rewrite Rmu_fin_bigcup// ?fsbig_set1// => -[]. -Qed. - -Let Rmu0 : Rmu set0 = 0. -Proof. -rewrite -(bigcup_set0 (fun _ : void => set0)). -by rewrite Rmu_fin_bigcup// fsbig_set0. -Qed. - -Lemma Rmu_ge0 A : Rmu A >= 0. -Proof. by rewrite sume_ge0. Qed. - -Lemma Rmu_additive : semi_additive Rmu. -Proof. -apply/(additive2P Rmu0) => // A B /ring_finite_set[/= {}A [? _ Atriv Am ->]]. -move=> /ring_finite_set[/= {}B [? _ Btriv Bm ->]]. -rewrite -subset0 => coverAB0. -have AUBfin : finite_set (A `|` B) by rewrite finite_setU. -have AUBtriv : trivIset (A `|` B) id. - move=> X Y [] ABX [] ABY; do ?by [exact: Atriv|exact: Btriv]. - by move=> [u [Xu Yu]]; case: (coverAB0 u); split; [exists X|exists Y]. - by move=> [u [Xu Yu]]; case: (coverAB0 u); split; [exists Y|exists X]. -rewrite -bigcup_setU !Rmu_fin_bigcup//=. -- rewrite fsbigU//= => [X /= [XA XB]]; have [->//|/set0P[x Xx]] := eqVneq X set0. - by case: (coverAB0 x); split; exists X. -- by move=> X /set_mem [|] /mem_set ?; [exact: Am|exact: Bm]. -Qed. - -#[export] -HB.instance Definition _ := isContent.Build _ _ _ Rmu Rmu_ge0 Rmu_additive. - -End content. - -End SetRing. -Module Exports. -HB.reexport. -HB.reexport SetRing. -End Exports. -End SetRing. -Export SetRing.Exports. - -Notation "d .-ring" := (SetRing.display d) : measure_display_scope. -Notation "d .-ring.-measurable" := - ((d%mdisp.-ring).-measurable : set (set (SetRing.type _))) : classical_set_scope. - -Lemma le_measure d (R : realFieldType) (T : semiRingOfSetsType d) - (mu : {content set T -> \bar R}) : - {in measurable &, {homo mu : A B / A `<=` B >-> (A <= B)%E}}. -Proof. -move=> A B; rewrite ?inE => mA mB AB; have [|muBfin] := leP +oo%E (mu B). - by rewrite leye_eq => /eqP ->; rewrite leey. -rewrite -[leRHS]SetRing.RmuE// -[B](setDUK AB) measureU/= ?setDIK//. -- by rewrite SetRing.RmuE ?leeDl. -- exact: sub_gen_smallest. -- by apply: measurableD; exact: sub_gen_smallest. -Qed. - -Lemma measure_le0 d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : {content set T -> \bar R}) (A : set T) : - (mu A <= 0)%E = (mu A == 0)%E. -Proof. by case: ltgtP (measure_ge0 mu A). Qed. - -Section more_content_semiring_lemmas. -Context d (R : realFieldType) (T : semiRingOfSetsType d). -Variable mu : {content set T -> \bar R}. - -Lemma content_subadditive : subadditive mu. -Proof. -move=> X A n Am Xm XA; pose B i := A\_`I_n i `&` X. -have XE : X = \big[setU/set0]_(i < n) B i. - rewrite -big_distrl/= setIidr// => x /XA/=. - by rewrite -!bigcup_mkord => -[k nk Ax]; exists k; rewrite // patchT ?inE. -have Bm i : measurable (B i). - case: (ltnP i n) => ltin; last by rewrite /B patchC ?inE ?set0I//= leq_gtF. - by rewrite /B ?patchT ?inE//; apply: measurableI => //; apply: Am. -have subBA i : B i `<=` A i. - by rewrite /B/patch; case: ifP; rewrite // set0I//= => _ ?. -have subDUB i : seqDU B i `<=` A i by move=> x [/subBA]. -have DUBm i : measurable (seqDU B i : set (SetRing.type T)). - apply: measurableD; first exact: sub_gen_smallest. - by apply: bigsetU_measurable => ? _; apply: sub_gen_smallest. -have DU0 i : (i >= n)%N -> seqDU B i = set0. - move=> leni; rewrite -subset0 => x []; rewrite /B patchC ?inE/= ?leq_gtF//. - by case. -rewrite -SetRing.RmuE// XE bigsetU_seqDU measure_bigsetU//. -rewrite [leRHS](big_ord_widen n (mu \o A))//= [leRHS]big_mkcond/=. -rewrite lee_sum => // i _; case: ltnP => ltin; last by rewrite DU0 ?measure0. -rewrite -[leRHS]SetRing.RmuE; last exact: Am. -by rewrite le_measure ?inE//=; last by apply: sub_gen_smallest; apply: Am. -Qed. - -Lemma content_sub_fsum (I : choiceType) D (A : set T) (A_ : I -> set T) : - finite_set D -> - (forall i, D i -> measurable (A_ i)) -> - measurable A -> - A `<=` \bigcup_(i in D) A_ i -> mu A <= \sum_(i \in D) mu (A_ i). -Proof. -elim/choicePpointed: I => I in A_ D *. - rewrite !emptyE bigcup_set0// subset0 => _ _ _ ->. - by rewrite measure0 fsbig_set0. -move=> Dfin A_m Am Asub; have [n /ppcard_eqP[f]] := Dfin. -rewrite (reindex_fsbig f^-1%FUN `I_n)//= -fsbig_ord. -rewrite (@content_subadditive A (A_ \o f^-1%FUN))//=. - by move=> i ltin; apply: A_m; apply: funS. -rewrite (fsbig_ord _ _ (A_ \o f^-1%FUN))/= -(reindex_fsbig _ _ D)//=. -by rewrite fsbig_setU. -Qed. - -(* (* alternative proof *) *) -(* Theorem semi_Boole_inequality : sub_additive mu. *) -(* Proof. *) -(* move=> X A n Am Xm Xsub; rewrite -SetRing.RmuE//. *) -(* under eq_bigr => i do [rewrite -SetRing.RmuE; do ?by apply: Am=> /=]. *) -(* pose rT := SetRing.type T. *) -(* have {}Am i : `I_n i -> measurable (A i : set rT). *) -(* by move=> *; apply/SetRing.measurableW/Am => /=. *) -(* have {}Xm : measurable (X : set rT) by exact: SetRing.measurableW. *) -(* pose ammu := [additive_measure of SetRing.measure mu]. *) -(* rewrite (le_trans (le_measure ammu _ _ Xsub)) ?inE// {Xsub}. *) -(* by rewrite -bigcup_mkord; apply: fin_bigcup_measurable. *) -(* elim: n Am Xm => [|n IHn] Am Xm; first by rewrite !big_ord0 measure0. *) -(* have Anm : measurable (A n : set rT) by apply: Am => /=. *) -(* set B := \big[setU/set0]_(i < n) A i. *) -(* set C := \big[setU/set0]_(i < n.+1) A i. *) -(* have -> : C = B `|` (A n `\` B). *) -(* suff -> : A n `\` B = C `\` B by rewrite setDUK// /C big_ord_recr/=; left. *) -(* by rewrite /C big_ord_recr/= !setDE setIUl -!setDE setDv set0U. *) -(* have Bm : measurable (B : set rT). *) -(* by rewrite -[B]bigcup_mkord; apply: fin_bigcup_measurable => //= i /ltnW/Am. *) -(* rewrite measureU // ?setDIK//; last exact: measurableD. *) -(* rewrite (@le_trans _ _ (ammu B + ammu (A n))) // ?leeD2l //; last first. *) -(* by rewrite big_ord_recr /= leeD2r// IHn// => i /ltnW/Am. *) -(* by rewrite le_measure // ?inE// ?setDE//; exact: measurableD. *) -(* Qed. *) - -End more_content_semiring_lemmas. - -Section content_ring_lemmas. -Context d (R : realType) (T : ringOfSetsType d). -Variable mu : {content set T -> \bar R}. - -Lemma content_ring_sup_sigma_additive (A : nat -> set T) : - (forall i, measurable (A i)) -> measurable (\bigcup_i A i) -> - trivIset [set: nat] A -> \sum_(i Am UAm At; rewrite lime_le//; first exact: is_cvg_nneseries. -near=> n; rewrite big_mkord -measure_bigsetU//= le_measure ?inE//=. -- exact: bigsetU_measurable. -- by rewrite -bigcup_mkord; apply: bigcup_sub => i lein; apply: bigcup_sup. -Unshelve. all: by end_near. Qed. - -Lemma content_ring_sigma_additive : - measurable_subset_sigma_subadditive mu -> semi_sigma_additive mu. -Proof. -move=> mu_sub A Am Atriv UAm. -suff <- : \sum_(i \bar R}). -Local Notation Rmu := (SetRing.measure mu). -Import SetRing. - -Lemma ring_sigma_subadditive : - measurable_subset_sigma_subadditive mu -> - measurable_subset_sigma_subadditive Rmu. -Proof. -move=> muS; move=> /= D A Am Dm Dsub. -rewrite /Rmu -(eq_eseriesr (fun _ _ => esum_fset _ _))//; last first. - by move=> *; exact: decomp_finite_set. -rewrite nneseries_esum ?esum_esum//=; last by move=> *; rewrite esum_ge0. -set K := _ `*`` _. -have /ppcard_eqP[f] : (K #= [set: nat])%card. - apply: cardXR_eq_nat => [|i]. - by rewrite (_ : [set _ | true] = setT)//; exact/predeqP. - split; first by apply/finite_set_countable; exact: decomp_finite_set. - exact/set0P/decompN0. -have {Dsub} : D `<=` \bigcup_(k in K) k.2. - apply: (subset_trans Dsub); apply: bigcup_sub => i _. - rewrite -[A i]cover_decomp; apply: bigcup_sub => X/= XAi. - by move=> x Xx; exists (i, X). -rewrite -(image_eq [bij of f^-1%FUN])/=. -rewrite (esum_set_image _ f^-1)//= bigcup_image => Dsub. -have DXsub X : X \in decomp D -> X `<=` \bigcup_i ((f^-1%FUN i).2 `&` X). - move=> XD; rewrite -setI_bigcupl -[Y in Y `<=` _](setIidr (decomp_sub XD)). - by apply: setSI. -have mf i : measurable ((f^-1)%function i).2. - have [_ /mem_set/decomp_measurable] := 'invS_f (I : setT i). - by apply; exact: Am. -have mfD i X : X \in decomp D -> measurable (((f^-1)%FUN i).2 `&` X : set T). - by move=> XD; apply: measurableI; [exact: mf|exact: (decomp_measurable _ XD)]. -apply: (@le_trans _ _ - (\sum_(i X /[!in_fset_set]; last exact: decomp_finite_set. - move=> XD; have Xm := decomp_measurable Dm XD. - by apply: muS => // [i|]; [exact: mfD|exact: DXsub]. -apply: lee_lim => /=; do ?apply: is_cvg_nneseries=> //. - by move=> n _ _; exact: sume_ge0. -near=> n; rewrite [n in _ <= n]big_mkcond; apply: lee_sum => i _. -rewrite ifT ?inE//. -under eq_big_seq. - move=> x; rewrite in_fset_set=> [xD|]; last exact: decomp_finite_set. - rewrite -RmuE//; last exact: mfD. - over. -rewrite -fsbig_finite/=; last exact: decomp_finite_set. -rewrite -measure_fin_bigcup//=. -- rewrite -setI_bigcupr (cover_decomp D) -[leRHS]RmuE// ?le_measure ?inE//. - by apply: measurableI => //; apply: sub_gen_smallest; apply: mf. - by apply: sub_gen_smallest; apply: mf. -- exact: decomp_finite_set. -- by apply: trivIset_setIl; apply: decomp_triv. -- by move=> X /= XD; apply: sub_gen_smallest; apply: mfD; rewrite inE. -Unshelve. all: by end_near. Qed. - -Lemma ring_semi_sigma_additive : - measurable_subset_sigma_subadditive mu -> semi_sigma_additive Rmu. -Proof. -by move=> mu_sub; exact/content_ring_sigma_additive/ring_sigma_subadditive. -Qed. - -Lemma semiring_sigma_additive : - measurable_subset_sigma_subadditive mu -> semi_sigma_additive mu. -Proof. -move=> /ring_semi_sigma_additive Rmu_sigmadd F Fmeas Ftriv cupFmeas. -have Fringmeas i : d.-ring.-measurable (F i) by apply: measurable_subring. -have := Rmu_sigmadd F Fringmeas Ftriv (measurable_subring cupFmeas). -rewrite SetRing.RmuE//. -by under eq_fun do under eq_bigr do rewrite SetRing.RmuE//=. -Qed. - -End ring_sigma_subadditive_content. - -#[key="mu"] -HB.factory Record Content_SigmaSubAdditive_isMeasure d (R : realType) - (T : semiRingOfSetsType d) (mu : set T -> \bar R) of Content d mu := { - measure_sigma_subadditive : measurable_subset_sigma_subadditive mu }. - -HB.builders Context d (R : realType) (T : semiRingOfSetsType d) - (mu : set T -> \bar R) of Content_SigmaSubAdditive_isMeasure d R T mu. - -HB.instance Definition _ := Content_isMeasure.Build d T R mu - (semiring_sigma_additive (measure_sigma_subadditive)). - -HB.end. - -Section more_premeasure_ring_lemmas. -Context d (R : realType) (T : semiRingOfSetsType d). -Variable mu : {measure set T -> \bar R}. -Import SetRing. - -Lemma measure_sigma_subadditive : measurable_subset_sigma_subadditive mu. -Proof. -move=> X A Am Xm XA; pose B i := A i `&` X. -have XE : X = \bigcup_i B i by rewrite -setI_bigcupl setIidr. -have Bm i : measurable (B i) by rewrite /B; apply: measurableI. -have subBA i : B i `<=` A i by rewrite /B. -have subDUB i : seqDU B i `<=` A i by move=> x [/subBA]. -have DUBm i : measurable (seqDU B i : set (SetRing.type T)). - by apply: measurableD => //; - do 1?apply: bigsetU_measurable => *; apply: sub_gen_smallest. -rewrite XE; move: (XE); rewrite seqDU_bigcup_eq. -under eq_bigcupr do rewrite -[seqDU B _]cover_decomp//. -rewrite -bigcup_setX_dep; set K := _ `*`` _. -have /ppcard_eqP[f] : (K #= [set: nat])%card. - apply: cardXR_eq_nat=> // i; split; last by apply/set0P; rewrite decompN0. - exact/finite_set_countable/decomp_finite_set. -pose f' := f^-1%FUN; rewrite -(image_eq [bij of f'])/= bigcup_image/=. -pose g n := (f' n).2; have fVtriv : trivIset [set: nat] g. - move=> i j _ _; rewrite /g. - have [/= _ f'iB] : K (f' i) by apply: funS. - have [/= _ f'jB] : K (f' j) by apply: funS. - have [f'ij|f'ij] := eqVneq (f' i).1 (f' j).1. - move=> /(decomp_triv f'iB)/=; rewrite f'ij => /(_ f'jB) f'ij2. - apply: 'inj_f'; rewrite ?inE//= -!/(f' _); move: f'ij f'ij2. - by case: (f' i) (f' j) => [? ?] [? ?]//= -> ->. - move=> [x [f'ix f'jx]]; have Bij := @trivIset_seqDU _ B (f' i).1 (f' j).1 I I. - rewrite Bij ?eqxx// in f'ij; exists x; split. - - by move/mem_set : f'iB => /decomp_sub; apply. - - by move/mem_set : f'jB => /decomp_sub; apply. -have g_inj : set_inj [set i | g i != set0] g. - by apply: trivIset_inj=> [i /set0P//|]; apply: sub_trivIset fVtriv. -move=> XEbig; rewrite measure_semi_bigcup//= -?XEbig//; last first. - move=> i; have [/= _ /mem_set] : K (f' i) by apply: funS. - exact: decomp_measurable. -rewrite [leLHS](_ : _ = \sum_(i i _; rewrite ifT ?inE//=; case: ifPn => //. - by rewrite notin_setE /= -/(g _) => /negP/negPn/eqP ->. -rewrite -(esum_pred_image mu g)//. -rewrite [leLHS](_ : _ = \esum_(X in range g) mu X); last first. - rewrite esum_mkcond [RHS]esum_mkcond; apply: eq_esum. - move=> Y _; case: ifPn; rewrite ?(inE, notin_setE)/=. - by move=> [i giN0 giY]; rewrite ifT// ?inE//=; exists i. - move=> Ngx; case: ifPn; rewrite ?(inE, notin_setE)//=. - move=> [i _ giY]; apply: contra_not_eq Ngx; rewrite -giY => mugi. - by exists i => //; apply: contra_neq mugi => ->; rewrite measure0. -have -> : range g = \bigcup_i (decomp (seqDU B i)). - apply/predeqP => /= Y; split => [[n _ gnY]|[n _ /= YBn]]. - have [/= _ f'nB] : K (f' n) by apply: funS. - by exists (f' n).1 => //=; rewrite -gnY. - by exists (f (n, Y)) => //; rewrite /g /f' funK//= inE. -rewrite esum_bigcup//; last first. - move=> i j /=. - have [->|/set0P DUBiN0] := eqVneq (seqDU B i) set0. - rewrite decomp_set0 ?set_fset1 => /negP[]. - apply/eqP/predeqP=> x; split=> [[Y/=->]|->]//; first by rewrite measure0. - by exists set0. - have [->|/set0P DUBjN0] := eqVneq (seqDU B j) set0. - rewrite decomp_set0 ?set_fset1 => _ /negP[]. - apply/eqP/predeqP=> x; split=> [[Y/=->]|->]//=; first by rewrite measure0. - by exists set0. - move=> _ _ [Y /= [/[dup] +]]. - move=> /mem_set /decomp_sub YBi /mem_set + /mem_set /decomp_sub YBj. - move=> /(decomp_neq0 DUBiN0) [y Yy]. - apply: (@trivIset_seqDU _ B) => //; exists y. - by split => //; [exact: YBi|exact: YBj]. -rewrite nneseries_esumT// le_esum// => i _. -rewrite [leLHS](_ : _ = \sum_(j \in decomp (seqDU B i)) mu j); last first. - by rewrite esum_fset//; exact: decomp_finite_set. -rewrite -SetRing.Rmu_fin_bigcup//=; last 3 first. - exact: decomp_finite_set. - exact: decomp_triv. - by move=> ?; exact: decomp_measurable. -rewrite -[leRHS]SetRing.RmuE// le_measure//; last by rewrite cover_decomp. -- rewrite inE; apply: fin_bigcup_measurable; first exact: decomp_finite_set. - move=> j /mem_set jdec; apply: sub_gen_smallest. - exact: decomp_measurable jdec. -- by rewrite inE; apply: sub_gen_smallest; exact: Am. -Qed. - -End more_premeasure_ring_lemmas. - -Lemma measure_sigma_subadditive_tail d (R : realType) (T : semiRingOfSetsType d) - (mu : {measure set T -> \bar R}) (A : set T) (F : nat -> set T) N : - (forall n, measurable (F n)) -> measurable A -> - A `<=` \bigcup_(n in ~` `I_N) F n -> - (mu A <= \sum_(N <= n mF mA AF; rewrite eseries_cond eseries_mkcondr. -rewrite (@eq_eseriesr _ _ (fun n => mu (if (N <= n)%N then F n else set0))). -- apply: measure_sigma_subadditive => //. - + by move=> n; case: ifPn. - + move: AF; rewrite bigcup_mkcond. - by under eq_bigcupr do rewrite mem_not_I. -- by move=> o _; rewrite (fun_if mu) measure0. -Qed. - -Section ring_sigma_content. -Context d (R : realType) (T : semiRingOfSetsType d) - (mu : {measure set T -> \bar R}). -Local Notation Rmu := (SetRing.measure mu). -Import SetRing. - -Let ring_sigma_content : semi_sigma_additive Rmu. -Proof. exact/ring_semi_sigma_additive/measure_sigma_subadditive. Qed. - -HB.instance Definition _ := Content_isMeasure.Build _ _ _ Rmu - ring_sigma_content. - -End ring_sigma_content. - -Definition fin_num_fun d (T : semiRingOfSetsType d) (R : numDomainType) - (mu : set T -> \bar R) := forall U, measurable U -> mu U \is a fin_num. - -Lemma fin_num_fun_lty d (T : algebraOfSetsType d) (R : realFieldType) - (mu : set T -> \bar R) : fin_num_fun mu -> mu setT < +oo. -Proof. by move=> h; rewrite ltey_eq h. Qed. - -Lemma lty_fin_num_fun d (T : algebraOfSetsType d) - (R : realFieldType) (mu : {measure set T -> \bar R}) : - mu setT < +oo -> fin_num_fun mu. -Proof. -move=> h U mU; rewrite fin_real// (lt_le_trans _ (measure_ge0 mu U))//=. -by rewrite (le_lt_trans _ h)//= le_measure// inE. -Qed. - -Definition sfinite_measure d (T : sigmaRingType d) (R : realType) - (mu : set T -> \bar R) := - exists2 s : {measure set T -> \bar R}^nat, - forall n, fin_num_fun (s n) & - forall U, measurable U -> mu U = mseries s 0 U. - -Definition sigma_finite d (T : semiRingOfSetsType d) (R : numDomainType) - (A : set T) (mu : set T -> \bar R) := - exists2 F : (set T)^nat, A = \bigcup_(i : nat) F i & - forall i, measurable (F i) /\ mu (F i) < +oo. - -Lemma fin_num_fun_sigma_finite d (T : algebraOfSetsType d) - (R : realFieldType) (mu : set T -> \bar R) : mu set0 < +oo -> - fin_num_fun mu -> sigma_finite setT mu. -Proof. -move=> muoo; exists (fun i => if i \in [set 0%N] then setT else set0). - by rewrite -bigcup_mkcondr setTI bigcup_const//; exists 0%N. -by move=> n; split; case: ifPn => // _; rewrite fin_num_fun_lty. -Qed. - -Lemma sfinite_measure_sigma_finite d (T : measurableType d) - (R : realType) (mu : {measure set T -> \bar R}) : - sigma_finite setT mu -> sfinite_measure mu. -Proof. -move=> [F UF mF]; rewrite /sfinite_measure. -have mDF k : measurable (seqDU F k). - apply: measurableD; first exact: (mF k).1. - by apply: bigsetU_measurable => i _; exact: (mF i).1. -exists (fun k => mrestr mu (mDF k)) => [n|U mU]. -- apply: lty_fin_num_fun => //=. - rewrite /mrestr setTI (@le_lt_trans _ _ (mu (F n)))//. - + apply: le_measure; last exact: subDsetl. - * rewrite inE; apply: measurableD; first exact: (mF n).1. - by apply: bigsetU_measurable => i _; exact: (mF i).1. - * by rewrite inE; exact: (mF n).1. - + exact: (mF n).2. -rewrite /mseries/= /mrestr/=; apply/esym/cvg_lim => //. -rewrite -[X in _ --> mu X]setIT UF seqDU_bigcup_eq setI_bigcupr. -apply: (@measure_sigma_additive _ _ _ mu (fun k => U `&` seqDU F k)). - by move=> i; exact: measurableI. -exact/trivIset_setIl/trivIset_seqDU. -Qed. - -HB.mixin Record isSFinite d (T : sigmaRingType d) (R : realType) - (mu : set T -> \bar R) := { - s_finite : sfinite_measure mu }. - -HB.structure Definition SFiniteMeasure d (T : sigmaRingType d) (R : realType) := - {mu of @Measure _ T R mu & isSFinite _ T R mu }. -Arguments s_finite {d T R} _. - -Notation "{ 'sfinite_measure' 'set' T '->' '\bar' R }" := - (SFiniteMeasure.type T R) : ring_scope. - -HB.mixin Record isSigmaFinite d (T : semiRingOfSetsType d) (R : numFieldType) - (mu : set T -> \bar R) := { sigma_finiteT : sigma_finite setT mu }. - -#[short(type="sigma_finite_content")] -HB.structure Definition SigmaFiniteContent d T R := - { mu of @Content d T R mu & isSigmaFinite d T R mu }. - -Arguments sigma_finiteT {d T R} s. -#[global] Hint Resolve sigma_finiteT : core. - -Notation "{ 'sigma_finite_content' 'set' T '->' '\bar' R }" := - (sigma_finite_content T R) : ring_scope. - -#[short(type="sigma_finite_measure")] -HB.structure Definition SigmaFiniteMeasure d T R := - { mu of @SFiniteMeasure d T R mu & isSigmaFinite d T R mu }. - -Notation "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }" := - (sigma_finite_measure T R) : ring_scope. - -HB.factory Record Measure_isSigmaFinite d (T : measurableType d) - (R : realType) (mu : set T -> \bar R) of isMeasure _ _ _ mu := - { sigma_finiteT : sigma_finite setT mu }. - -HB.builders Context d (T : measurableType d) (R : realType) - mu of @Measure_isSigmaFinite d T R mu. - -Lemma sfinite : sfinite_measure mu. -Proof. exact/sfinite_measure_sigma_finite/sigma_finiteT. Qed. - -HB.instance Definition _ := @isSFinite.Build _ _ _ mu sfinite. - -HB.instance Definition _ := @isSigmaFinite.Build _ _ _ mu sigma_finiteT. - -HB.end. - -Lemma sigma_finite_mzero d (T : measurableType d) (R : realFieldType) : - sigma_finite setT (@mzero d T R). -Proof. by apply: fin_num_fun_sigma_finite => //; rewrite measure0. Qed. - -HB.instance Definition _ d (T : measurableType d) (R : realFieldType) := - @isSigmaFinite.Build d T R mzero (@sigma_finite_mzero d T R). - -Lemma sfinite_mzero d (T : measurableType d) (R : realType) : - sfinite_measure (@mzero d T R). -Proof. exact/sfinite_measure_sigma_finite/sigma_finite_mzero. Qed. - -HB.instance Definition _ d (T : measurableType d) (R : realType) := - @isSFinite.Build d T R mzero (@sfinite_mzero d T R). - -HB.mixin Record isFinite d (T : semiRingOfSetsType d) (R : numDomainType) - (k : set T -> \bar R) := { fin_num_measure : fin_num_fun k }. - -HB.structure Definition FinNumFun d (T : semiRingOfSetsType d) - (R : numFieldType) := { k of isFinite _ T R k }. - -HB.structure Definition FiniteMeasure d (T : sigmaRingType d) (R : realType) := - { k of @SigmaFiniteMeasure _ _ _ k & isFinite _ T R k }. -Arguments fin_num_measure {d T R} _. - -Notation "{ 'finite_measure' 'set' T '->' '\bar' R }" := - (FiniteMeasure.type T R) : ring_scope. - -HB.factory Record Measure_isFinite d (T : measurableType d) - (R : realType) (k : set T -> \bar R) - of isMeasure _ _ _ k := { fin_num_measure : fin_num_fun k }. - -HB.builders Context d (T : measurableType d) (R : realType) k - of Measure_isFinite d T R k. - -Let sfinite : sfinite_measure k. -Proof. -apply: sfinite_measure_sigma_finite. -by apply: fin_num_fun_sigma_finite; [rewrite measure0|exact: fin_num_measure]. -Qed. - -HB.instance Definition _ := @isSFinite.Build d T R k sfinite. - -Let sigma_finite : sigma_finite setT k. -Proof. -by apply: fin_num_fun_sigma_finite; [rewrite measure0|exact: fin_num_measure]. -Qed. - -HB.instance Definition _ := @isSigmaFinite.Build d T R k sigma_finite. - -Let finite : fin_num_fun k. Proof. exact: fin_num_measure. Qed. - -HB.instance Definition _ := @isFinite.Build d T R k finite. - -HB.end. - -Section finite_restr. -Context d (T : measurableType d) (R : realType). -Variables (mu : {finite_measure set T -> \bar R}) (D : set T). -Hypothesis mD : measurable D. - -Local Notation restr := (mrestr mu mD). - -Let fin_num_restr : fin_num_fun restr. -Proof. -move=> A mA; have := fin_num_measure mu A mA. -rewrite !ge0_fin_numE//=; apply: le_lt_trans. -by rewrite /mrestr; apply: le_measure => //; rewrite inE//=; exact: measurableI. -Qed. - -HB.instance Definition _ := @Measure_isFinite.Build _ T _ restr fin_num_restr. - -End finite_restr. - -Section finite_mscale. -Context d (T : measurableType d) (R : realType). -Variables (mu : {finite_measure set T -> \bar R}) (r : {nonneg R}). - -Local Notation scale := (mscale r mu). - -Let fin_num_scale : fin_num_fun scale. -Proof. -by move=> A mA; have muA := fin_num_measure mu A mA; rewrite fin_numM. -Qed. - -HB.instance Definition _ := @Measure_isFinite.Build _ T _ scale fin_num_scale. - -End finite_mscale. - -HB.factory Record Measure_isSFinite d (T : sigmaRingType d) - (R : realType) (k : set T -> \bar R) of isMeasure _ _ _ k := { - s_finite : exists s : {finite_measure set T -> \bar R}^nat, - forall U, measurable U -> k U = mseries s 0 U }. - -HB.builders Context d (T : sigmaRingType d) (R : realType) - k of Measure_isSFinite d T R k. - -Let sfinite : sfinite_measure k. -Proof. -have [s sE] := s_finite. -by exists s => //=> n; exact: fin_num_measure. -Qed. - -HB.instance Definition _ := @isSFinite.Build d T R k sfinite. - -HB.end. - -Section sfinite_measure. -Context d (T : measurableType d) (R : realType) - (mu : {sfinite_measure set T -> \bar R}). - -Let s : (set T -> \bar R)^nat := let: exist2 x _ _ := cid2 (s_finite mu) in x. - -Let s0 n : s n set0 = 0. -Proof. by rewrite /s; case: cid2. Qed. - -Let s_ge0 n x : 0 <= s n x. -Proof. by rewrite /s; case: cid2. Qed. - -Let s_semi_sigma_additive n : semi_sigma_additive (s n). -Proof. -by rewrite /s; case: cid2 => s' s'1 s'2; exact: measure_semi_sigma_additive. -Qed. - -HB.instance Definition _ n := @isMeasure.Build _ _ _ (s n) (s0 n) (s_ge0 n) - (@s_semi_sigma_additive n). - -Let s_fin n : fin_num_fun (s n). -Proof. by rewrite /s; case: cid2 => F finF muE; exact: finF. Qed. - -HB.instance Definition _ n := @Measure_isFinite.Build d T R (s n) (s_fin n). - -Definition sfinite_measure_seq : {finite_measure set T -> \bar R}^nat := s. - -Lemma sfinite_measure_seqP U : measurable U -> - mu U = mseries sfinite_measure_seq O U. -Proof. -by move=> mU; rewrite /mseries /= /s; case: cid2 => // x xfin ->. -Qed. - -End sfinite_measure. - -Definition mfrestr d (T : measurableType d) (R : realFieldType) (D : set T) - (f : set T -> \bar R) (mD : measurable D) of f D < +oo := - mrestr f mD. - -Section measure_frestr. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). -Hypothesis moo : mu D < +oo. - -Local Notation restr := (mfrestr mD moo). - -HB.instance Definition _ := Measure.on restr. - -Let restr_fin : fin_num_fun restr. -Proof. -move=> U mU; rewrite /restr /mrestr ge0_fin_numE ?measure_ge0//. -by rewrite (le_lt_trans _ moo)// le_measure// ?inE//; exact: measurableI. -Qed. - -HB.instance Definition _ := Measure_isFinite.Build _ _ _ restr restr_fin. - -End measure_frestr. - -HB.mixin Record isSubProbability d (T : sigmaRingType d) (R : realType) - (P : set T -> \bar R) := { sprobability_setT : P setT <= 1%E }. - -#[short(type=subprobability)] -HB.structure Definition SubProbability d (T : measurableType d) (R : realType) - := {mu of @FiniteMeasure d T R mu & isSubProbability d T R mu }. - -HB.factory Record Measure_isSubProbability d (T : measurableType d) - (R : realType) (P : set T -> \bar R) of isMeasure _ _ _ P := - { sprobability_setT : P setT <= 1%E }. - -HB.builders Context d (T : measurableType d) (R : realType) - P of Measure_isSubProbability d T R P. - -Let finite : @Measure_isFinite d T R P. -Proof. -split; apply: lty_fin_num_fun. -by rewrite (le_lt_trans (@sprobability_setT))// ltey. -Qed. - -HB.instance Definition _ := finite. - -HB.instance Definition _ := @isSubProbability.Build _ _ _ P sprobability_setT. - -HB.end. - -HB.mixin Record isProbability d (T : measurableType d) (R : realType) - (P : set T -> \bar R) := { probability_setT : P setT = 1%E }. - -#[short(type=probability)] -HB.structure Definition Probability d (T : measurableType d) (R : realType) := - {P of @SubProbability d T R P & isProbability d T R P }. - -Arguments probability_setT {d T R} s. - -HB.instance Definition _ d (T : measurableType d) (R : realType) := - gen_eqMixin (probability T R). -HB.instance Definition _ d (T : measurableType d) (R : realType) := - gen_choiceMixin (probability T R). - -Section probability_lemmas. -Context d (T : measurableType d) (R : realType) (P : probability T R). - -Lemma probability_le1 (A : set T) : measurable A -> P A <= 1. -Proof. by move=> mA; rewrite -(probability_setT P) ?le_measure ?in_setE. Qed. - -Lemma probability_setC (A : set T) : measurable A -> P (~` A) = 1 - P A. -Proof. -move=> mA; rewrite -(probability_setT P) -(setvU A) measureU ?addeK ?setICl//. -- by rewrite fin_num_measure. -- exact: measurableC. -Qed. - -End probability_lemmas. - -HB.factory Record Measure_isProbability d (T : measurableType d) - (R : realType) (P : set T -> \bar R) of isMeasure _ _ _ P := - { probability_setT : P setT = 1%E }. - -HB.builders Context d (T : measurableType d) (R : realType) - P of Measure_isProbability d T R P. - -Let subprobability : @Measure_isSubProbability d T R P. -Proof. by split; rewrite probability_setT. Qed. - -HB.instance Definition _ := subprobability. - -HB.instance Definition _ := @isProbability.Build _ _ _ P probability_setT. - -HB.end. - -Section mnormalize. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (P : probability T R). - -Definition mnormalize := - let evidence := mu [set: T] in - if (evidence == 0) || (evidence == +oo) then fun U => P U - else fun U => mu U * (fine evidence)^-1%:E. - -Let mnormalize0 : mnormalize set0 = 0. -Proof. -by rewrite /mnormalize; case: ifPn => // _; rewrite measure0 mul0e. -Qed. - -Let mnormalize_ge0 U : 0 <= mnormalize U. -Proof. by rewrite /mnormalize; case: ifPn. Qed. - -Let mnormalize_sigma_additive : semi_sigma_additive mnormalize. -Proof. -move=> F mF tF mUF; rewrite /mnormalize/=. -case: ifPn => [_|_]; first exact: measure_semi_sigma_additive. -rewrite [X in X @ _ --> _](_ : _ = (fun n => \sum_(0 <= i < n) mu (F i)) \* - cst (fine (mu setT))^-1%:E); last first. - by apply/funext => n; rewrite -ge0_sume_distrl. -by apply: cvgeZr => //; exact: measure_semi_sigma_additive. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ mnormalize - mnormalize0 mnormalize_ge0 mnormalize_sigma_additive. - -Let mnormalize1 : mnormalize [set: T] = 1. -Proof. -rewrite /mnormalize; case: ifPn; first by rewrite probability_setT. -rewrite negb_or => /andP[ft0 ftoo]. -have ? : mu setT \is a fin_num by rewrite ge0_fin_numE// ltey. -by rewrite -{1}(@fineK _ (mu setT))// -EFinM divff// fine_eq0. -Qed. - -HB.instance Definition _ := - Measure_isProbability.Build _ _ _ mnormalize mnormalize1. - -End mnormalize. - -Lemma mnormalize_id d (T : measurableType d) (R : realType) - (P P' : probability T R) : mnormalize P P' = P. -Proof. -apply/funext => x; rewrite /mnormalize/= probability_setT. -by rewrite onee_eq0/= invr1 mule1. -Qed. - -Section pdirac. -Context d (T : measurableType d) (R : realType). - -HB.instance Definition _ x := - Measure_isProbability.Build _ _ _ (@dirac _ T x R) (diracT R x). - -End pdirac. - -HB.instance Definition _ d (T : measurableType d) (R : realType) := - isPointed.Build (probability T R) (dirac point). - -Section dist_sigma_algebra_instance. -Context d (T : measurableType d) (R : realType). - -Definition mset (U : set T) (r : R) := [set mu : probability T R | mu U < r%:E]. - -Lemma lt0_mset (U : set T) (r : R) : (r < 0)%R -> mset U r = set0. -Proof. -move=> r0; apply/seteqP; split => // x/=. -by apply/negP; rewrite -leNgt (@le_trans _ _ 0)// lee_fin ltW. -Qed. - -Lemma gt1_mset (U : set T) (r : R) : - measurable U -> (1 < r)%R -> mset U r = [set: probability T R]. -Proof. -move=> mU r1; apply/seteqP; split => // x/= _. -by rewrite /mset/= (le_lt_trans (probability_le1 _ _)). -Qed. - -Definition pset : set (set (probability T R)) := - [set mset U r | r in `[0%R,1%R] & U in measurable]. - -Definition pprobability : measurableType pset.-sigma := - g_sigma_algebraType pset. - -End dist_sigma_algebra_instance. - -Lemma sigma_finite_counting (R : realType) : - sigma_finite [set: nat] (@counting _ R). -Proof. -exists (fun n => `I_n.+1); first by apply/seteqP; split=> //x _; exists x => /=. -by move=> k; split => //; rewrite /counting/= asboolT// ltry. -Qed. -HB.instance Definition _ R := - @isSigmaFinite.Build _ _ _ (@counting _ R) (sigma_finite_counting R). - -Section content_semiRingOfSetsType. -Context d (T : semiRingOfSetsType d) (R : realFieldType). -Variables (mu : {content set T -> \bar R}) (A B : set T). -Hypotheses (mA : measurable A) (mB : measurable B). - -Lemma measureIl : mu (A `&` B) <= mu A. -Proof. by rewrite le_measure ?inE//; apply: measurableI. Qed. - -Lemma measureIr : mu (A `&` B) <= mu B. -Proof. by rewrite le_measure ?inE//; apply: measurableI. Qed. - -Lemma subset_measure0 : A `<=` B -> mu B = 0 -> mu A = 0. -Proof. by move=> ? B0; apply/eqP; rewrite -measure_le0 -B0 le_measure ?inE. Qed. - -End content_semiRingOfSetsType. - -Section content_ringOfSetsType. -Context d (T : ringOfSetsType d) (R : realFieldType). -Variable mu : {content set T -> \bar R}. -Implicit Types A B : set T. - -Lemma measureDI A B : measurable A -> measurable B -> - mu A = mu (A `\` B) + mu (A `&` B). -Proof. -move=> mA mB; rewrite -measure_semi_additive2. -- by rewrite -setDDr setDv setD0. -- exact: measurableD. -- exact: measurableI. -- by apply: measurableU; [exact: measurableD |exact: measurableI]. -- by rewrite setDE setIACA setICl setI0. -Qed. - -Lemma measureD A B : measurable A -> measurable B -> - mu A < +oo -> mu (A `\` B) = mu A - mu (A `&` B). -Proof. -move=> mA mB mAoo. -rewrite (measureDI mA mB) addeK// fin_numE 1?gt_eqF 1?lt_eqF//. -- by rewrite (le_lt_trans _ mAoo)// le_measure // ?inE//; exact: measurableI. -- by rewrite (lt_le_trans _ (measure_ge0 _ _)). -Qed. - -Lemma measureU2 A B : measurable A -> measurable B -> - mu (A `|` B) <= mu A + mu B. -Proof. -move=> ? ?; rewrite -bigcup2inE bigcup_mkord. -rewrite (le_trans (@content_subadditive _ _ _ mu _ (bigcup2 A B) 2%N _ _ _))//. -by move=> -[//|[//|[|]]]. -by apply: bigsetU_measurable => -[] [//|[//|[|]]]. -by rewrite big_ord_recr/= big_ord_recr/= big_ord0 add0e. -Qed. - -End content_ringOfSetsType. - -Section measureU. -Context d (T : ringOfSetsType d) (R : realFieldType). -Variable mu : {measure set T -> \bar R}. - -Lemma measureUfinr A B : measurable A -> measurable B -> mu B < +oo -> - mu (A `|` B) = mu A + mu B - mu (A `&` B). -Proof. -move=> Am Bm mBfin; rewrite -[B in LHS](setDUK (@subIsetl _ _ A)) setUA. -rewrite [A `|` _]setUidl; last exact: subIsetr. -rewrite measureU//=; [|rewrite setDIr setDv set0U ?setDIK//..]. -- by rewrite measureD// ?setIA ?setIid 1?setIC ?addeA//; exact: measurableI. -- exact: measurableD. -Qed. - -Lemma measureUfinl A B : measurable A -> measurable B -> mu A < +oo -> - mu (A `|` B) = mu A + mu B - mu (A `&` B). -Proof. by move=> *; rewrite setUC measureUfinr// setIC [mu B + _]addeC. Qed. - -Lemma null_set_setU A B : measurable A -> measurable B -> - mu A = 0 -> mu B = 0 -> mu (A `|` B) = 0. -Proof. -move=> mA mB A0 B0; rewrite measureUfinl/= ?A0//= ?B0 ?add0e. -by apply/eqP; rewrite oppe_eq0 -measure_le0/= -A0 measureIl. -Qed. - -Lemma measureU0 A B : measurable A -> measurable B -> mu B = 0 -> - mu (A `|` B) = mu A. -Proof. -move=> mA mB B0; rewrite measureUfinr/= ?B0// adde0. -by rewrite (@subset_measure0 _ _ _ _ (A `&` B) B) ?sube0//; exact: measurableI. -Qed. - -End measureU. - -Lemma eq_measureU d (T : ringOfSetsType d) (R : realFieldType) (A B : set T) - (mu mu' : {measure set T -> \bar R}): - measurable A -> measurable B -> - mu A = mu' A -> mu B = mu' B -> mu (A `&` B) = mu' (A `&` B) -> - mu (A `|` B) = mu' (A `|` B). -Proof. -move=> mA mB muA muB muAB; have [mu'ANoo|] := ltP (mu' A) +oo. - by rewrite !measureUfinl/= ?muA ?muB ?muAB. -rewrite leye_eq => /eqP mu'A; transitivity (+oo : \bar R); apply/eqP. - by rewrite -leye_eq -mu'A -muA le_measure ?inE//=; apply: measurableU. -by rewrite eq_sym -leye_eq -mu'A le_measure ?inE//=; apply: measurableU. -Qed. - -Section measure_continuity. - -Local Open Scope ereal_scope. - -Lemma nondecreasing_cvg_mu d (T : ringOfSetsType d) (R : realFieldType) - (mu : {measure set T -> \bar R}) (F : (set T) ^nat) : - (forall i, measurable (F i)) -> measurable (\bigcup_n F n) -> - nondecreasing_seq F -> - mu \o F @ \oo --> mu (\bigcup_n F n). -Proof. -move=> mF mbigcupF ndF. -have Binter : trivIset setT (seqD F) := trivIset_seqD ndF. -have FBE : forall n, F n.+1 = F n `|` seqD F n.+1 := setU_seqD ndF. -have FE n : \big[setU/set0]_(i < n.+1) (seqD F) i = F n := - nondecreasing_bigsetU_seqD n ndF. -rewrite -eq_bigcup_seqD. -have mB i : measurable (seqD F i) by elim: i => * //=; exact: measurableD. -apply: cvg_trans (measure_semi_sigma_additive _ mB Binter _); last first. - by rewrite eq_bigcup_seqD. -apply: (@cvg_trans _ (\sum_(i < n.+1) mu (seqD F i) @[n --> \oo])). - rewrite [X in _ --> X @ \oo](_ : _ = mu \o F) // funeqE => n. - by rewrite -measure_semi_additive ?FE// => -[|]. -move=> S [n _] nS; exists n => // m nm. -under eq_fun do rewrite -(big_mkord predT (mu \o seqD F)). -exact/(nS m.+1)/(leq_trans nm). -Qed. - -Lemma nonincreasing_cvg_mu d (T : algebraOfSetsType d) (R : realFieldType) - (mu : {measure set T -> \bar R}) (F : (set T) ^nat) : - mu (F 0%N) < +oo -> - (forall i, measurable (F i)) -> measurable (\bigcap_n F n) -> - nonincreasing_seq F -> mu \o F @ \oo --> mu (\bigcap_n F n). -Proof. -move=> F0pos mF mbigcapF niF; pose G n := F O `\` F n. -have ? : mu (F 0%N) \is a fin_num by rewrite ge0_fin_numE. -have F0E r : mu (F 0%N) - (mu (F 0%N) - r) = r. - by rewrite oppeB ?addeA ?subee ?add0e// fin_num_adde_defr. -rewrite -[x in _ --> x] F0E. -have -> : mu \o F = fun n => mu (F 0%N) - (mu (F 0%N) - mu (F n)). - by apply: funext => n; rewrite F0E. -apply: cvgeB; rewrite ?fin_num_adde_defr//; first exact: cvg_cst. -have -> : \bigcap_n F n = F 0%N `&` \bigcap_n F n. - by rewrite setIidr//; exact: bigcap_inf. -rewrite -measureD // setDE setC_bigcap setI_bigcupr -[x in bigcup _ x]/G. -have -> : (fun n => mu (F 0%N) - mu (F n)) = mu \o G. - by apply: funext => n /=; rewrite measureD// setIidr//; exact/subsetPset/niF. -apply: nondecreasing_cvg_mu. -- by move=> ?; apply: measurableD; exact: mF. -- rewrite -setI_bigcupr; apply: measurableI; first exact: mF. - by rewrite -@setC_bigcap; exact: measurableC. -- by move=> n m NM; apply/subsetPset; apply: setDS; apply/subsetPset/niF. -Qed. - -End measure_continuity. - -Definition lim_sup_set T (F : (set T)^nat) := \bigcap_n \bigcup_(j >= n) F j. - -Section borel_cantelli_realFieldType. -Context {d} {T : measurableType d} {R : realFieldType} - (mu : {measure set T -> \bar R}). -Implicit Types F : (set T)^nat. -Local Open Scope ereal_scope. - -Lemma lim_sup_set_ub F n : (forall k, measurable (F k)) -> - mu (lim_sup_set F) <= mu (\bigcup_(k >= n) F k). -Proof. -move=> mF; rewrite /lim_sup_set le_measure// ?inE/=. -- by apply: bigcap_measurable => // k _; exact: bigcup_measurable. -- exact: bigcup_measurable. -- exact: bigcap_inf. -Qed. - -Lemma lim_sup_set_cvg F : (forall k, measurable (F k)) -> - mu (\bigcup_(k >= 0) F k) < +oo -> - mu (\bigcup_(k >= n) F k) @[n --> \oo] --> mu (lim_sup_set F). -Proof. -move=> mF mFoo; apply: nonincreasing_cvg_mu => //. -- by move=> i; apply: bigcup_measurable => k /= _; exact: mF. -- apply: bigcap_measurable => // k _. - by apply: bigcup_measurable => j /= _; exact: mF. -- move=> m n mn; apply/subsetPset => t [k /= nk Akt]. - by exists k => //=; rewrite (leq_trans mn). -Qed. - -End borel_cantelli_realFieldType. -Arguments lim_sup_set_cvg {d T R} mu F. - -Section borel_cantelli. -Context d (T : measurableType d) {R : realType} (mu : {measure set T -> \bar R}). -Implicit Types F : (set T)^nat. -Local Open Scope ereal_scope. - -Lemma lim_sup_set_cvg0 F : (forall k, measurable (F k)) -> - \sum_(n mu (lim_sup_set F) = 0. -Proof. -move=> mF bigUoo; apply/eqP; rewrite eq_le measure_ge0 andbT. -have /cvg_lim <- // : (\sum_(i <= n \oo] --> 0%E. - exact: nneseries_tail_cvg. -apply: lime_ge; first by apply/cvg_ex; exists 0; exact: nneseries_tail_cvg. -apply: nearW => n; rewrite (le_trans (lim_sup_set_ub mu n mF))//. -by apply: measure_sigma_subadditive_tail => //; - [exact: bigcup_measurable|rewrite -setC_I]. -Qed. - -End borel_cantelli. - -Section g_sigma_algebra_measure_unique_trace. -Context d (R : realType) (T : measurableType d). -Variables (G : set (set T)) (D : set T) (mD : measurable D). -Let H := [set X | G X /\ X `<=` D] (* "trace" of G wrt D *). -Hypotheses (Hm : H `<=` measurable) (setIH : setI_closed H). -Variables m1 m2 : {measure set T -> \bar R}. -Hypothesis m1m2D : m1 D = m2 D. -Hypotheses (m1m2 : forall A, H A -> m1 A = m2 A) (m1oo : (m1 D < +oo)%E). - -Lemma g_sigma_algebra_measure_unique_trace : - (forall X, (<>) X -> X `<=` D) -> forall X, <> X -> - m1 X = m2 X. -Proof. -move=> sDHD; set E := [set A | [/\ measurable A, m1 A = m2 A & A `<=` D] ]. -have HE : H `<=` E. - by move=> X HX; rewrite /E /=; split; [exact: Hm|exact: m1m2|case: HX]. -have setDE : setSD_closed E. - move=> A B BA [mA m1m2A AD] [mB m1m2B BD]; split; first exact: measurableD. - - rewrite measureD//; last first. - by rewrite (le_lt_trans _ m1oo)//; apply: le_measure => // /[!inE]. - rewrite setIidr//= m1m2A m1m2B measureD// ?setIidr//. - by rewrite (le_lt_trans _ m1oo)//= -m1m2A; apply: le_measure => // /[!inE]. - - by rewrite setDE; apply: subIset; left. -have ndE : ndseq_closed E. - move=> A ndA EA; split; have mA n : measurable (A n) by have [] := EA n. - - exact: bigcupT_measurable. - - transitivity (limn (m1 \o A)). - apply/esym/cvg_lim=>//. - exact/(nondecreasing_cvg_mu mA _ ndA)/bigcupT_measurable. - transitivity (limn (m2 \o A)). - by apply/congr_lim/funext => n; have [] := EA n. - apply/cvg_lim => //. - exact/(nondecreasing_cvg_mu mA _ ndA)/bigcupT_measurable. - - by apply: bigcup_sub => n; have [] := EA n. -have sDHE : <> `<=` E. - by apply: lambda_system_subset => //; split => //; [move=> ? []|split]. -by move=> X /sDHE[]. -Qed. - -End g_sigma_algebra_measure_unique_trace. -Arguments g_sigma_algebra_measure_unique_trace {d R T} G D. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_measure_unique_trace`")] -Notation g_salgebra_measure_unique_trace := g_sigma_algebra_measure_unique_trace (only parsing). - -Section boole_inequality. -Context d (R : realFieldType) (T : ringOfSetsType d). -Variable mu : {content set T -> \bar R}. - -Theorem Boole_inequality (A : (set T) ^nat) n : - (forall i, (i < n)%N -> measurable (A i)) -> - mu (\big[setU/set0]_(i < n) A i) <= \sum_(i < n) mu (A i). -Proof. -move=> Am; rewrite content_subadditive// -bigcup_mkord. -exact: fin_bigcup_measurable. -Qed. - -End boole_inequality. -Notation le_mu_bigsetU := Boole_inequality. - -Section sigma_finite_lemma. -Context d (T : ringOfSetsType d) (R : realFieldType) (A : set T) - (mu : {content set T -> \bar R}). - -Lemma sigma_finiteP : sigma_finite A mu <-> - exists F, [/\ A = \bigcup_i F i, - nondecreasing_seq F & forall i, measurable (F i) /\ mu (F i) < +oo]. -Proof. -split=> [[F AUF mF]|[F [? ? ?]]]; last by exists F. -exists (fun n => \big[setU/set0]_(i < n.+1) F i); split. -- rewrite AUF; apply/seteqP; split. - by apply: subset_bigcup => i _; exact: bigsetU_sup. - by apply: bigcup_sub => i _; exact: bigsetU_bigcup. -- by move=> i j ij; exact/subsetPset/subset_bigsetU. -- move=> i; split; first by apply: bigsetU_measurable => j _; exact: (mF j).1. - rewrite (le_lt_trans (Boole_inequality _ _))//. - by move=> j _; exact: (mF _).1. - by apply/lte_sum_pinfty => j _; exact: (mF j).2. -Qed. - -End sigma_finite_lemma. - -Section generalized_boole_inequality. -Context d (T : ringOfSetsType d) (R : realType). -Variable mu : {measure set T -> \bar R}. - -Theorem generalized_Boole_inequality (A : (set T) ^nat) : - (forall i, measurable (A i)) -> measurable (\bigcup_n A n) -> - mu (\bigcup_n A n) <= \sum_(i Am UAm; rewrite measure_sigma_subadditive. Qed. - -End generalized_boole_inequality. -Notation le_mu_bigcup := generalized_Boole_inequality. - -Section negligible. -Context d (T : semiRingOfSetsType d) (R : realFieldType). - -Definition negligible (mu : set T -> \bar R) N := - exists A, [/\ measurable A, mu A = 0 & N `<=` A]. - -Local Notation "mu .-negligible" := (negligible mu). - -Variable mu : {content set T -> \bar R}. - -Lemma negligibleP A : measurable A -> mu.-negligible A <-> mu A = 0. -Proof. -move=> mA; split => [[B [mB mB0 AB]]|mA0]; last by exists A; split. -by apply/eqP; rewrite -measure_le0 -mB0 le_measure ?inE. -Qed. - -Lemma negligible_set0 : mu.-negligible set0. -Proof. exact/negligibleP. Qed. - -Lemma measure_negligible (A : set T) : - measurable A -> mu.-negligible A -> mu A = 0%E. -Proof. by move=> mA /negligibleP ->. Qed. - -Lemma negligibleS A B : B `<=` A -> mu.-negligible A -> mu.-negligible B. -Proof. -by move=> BA [N [mN N0 AN]]; exists N; split => //; exact: subset_trans AN. -Qed. - -Lemma negligibleI A B : - mu.-negligible A -> mu.-negligible B -> mu.-negligible (A `&` B). -Proof. -move=> [N [mN N0 AN]] [M [mM M0 BM]]; exists (N `&` M); split => //. -- exact: measurableI. -- by apply/eqP; rewrite -measure_le0 -N0 le_measure ?inE//; exact: measurableI. -- exact: setISS. -Qed. - -End negligible. -Notation "mu .-negligible" := (negligible mu) : type_scope. - -Definition measure_is_complete d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : set T -> \bar R) := - mu.-negligible `<=` measurable. - -Section negligible_ringOfSetsType. -Context d (T : ringOfSetsType d) (R : realFieldType). -Variable mu : {content set T -> \bar R}. - -Lemma negligibleU A B : - mu.-negligible A -> mu.-negligible B -> mu.-negligible (A `|` B). -Proof. -move=> [N [mN N0 AN]] [M [mM M0 BM]]; exists (N `|` M); split => //. -- exact: measurableU. -- apply/eqP; rewrite -measure_le0 -N0 -[leRHS]adde0 -M0 -bigsetU_bigcup2. - apply: le_trans. - + apply: (@content_subadditive _ _ _ _ _ (bigcup2 N M) 2%N) => //. - * by move=> [|[|[|]]]. - * apply: bigsetU_measurable => // i _; rewrite /bigcup2. - by case: ifPn => // i0; case: ifPn. - + by rewrite big_ord_recr/= big_ord_recr/= big_ord0 add0e. -- exact: setUSS. -Qed. - -Lemma negligible_bigsetU (F : (set T)^nat) s (P : pred nat) : - (forall k, P k -> mu.-negligible (F k)) -> - mu.-negligible (\big[setU/set0]_(k <- s | P k) F k). -Proof. -by move=> PF; elim/big_ind : _ => //; - [exact: negligible_set0|exact: negligibleU]. -Qed. - -End negligible_ringOfSetsType. - -Lemma negligible_bigcup d (T : sigmaRingType d) (R : realFieldType) - (mu : {measure set T -> \bar R}) (F : (set T)^nat) : - (forall k, mu.-negligible (F k)) -> mu.-negligible (\bigcup_k F k). -Proof. -move=> mF; exists (\bigcup_k sval (cid (mF k))); split. -- by apply: bigcupT_measurable => // k; have [] := svalP (cid (mF k)). -- rewrite seqDU_bigcup_eq measure_bigcup//; last first. - move=> k _; apply: measurableD; first by case: cid => //= A []. - by apply: bigsetU_measurable => i _; case: cid => //= A []. - rewrite eseries0// => k _ _. - have [mFk mFk0 ?] := svalP (cid (mF k)). - rewrite measureD//=. - + rewrite mFk0 sub0e eqe_oppLRP oppe0; apply/eqP; rewrite -measure_le0. - rewrite -[leRHS]mFk0 le_measure//= ?inE//; apply: measurableI => //. - by apply: bigsetU_measurable => i _; case: cid => // A []. - + by apply: bigsetU_measurable => i _; case: cid => // A []. - + by rewrite mFk0. -- by apply: subset_bigcup => k _; rewrite /sval/=; by case: cid => //= A []. -Qed. - -Section ae. - -Definition almost_everywhere d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : set T -> \bar R) : set_system T := - fun P => mu.-negligible (~` [set x | P x]). - -Let almost_everywhereT d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : {content set T -> \bar R}) : almost_everywhere mu setT. -Proof. by rewrite /almost_everywhere setCT; exact: negligible_set0. Qed. - -Let almost_everywhereS d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : {measure set T -> \bar R}) A B : A `<=` B -> - almost_everywhere mu A -> almost_everywhere mu B. -Proof. by move=> AB; apply: negligibleS; exact: subsetC. Qed. - -Let almost_everywhereI d (T : ringOfSetsType d) (R : realFieldType) - (mu : {measure set T -> \bar R}) A B : - almost_everywhere mu A -> almost_everywhere mu B -> - almost_everywhere mu (A `&` B). -Proof. -by rewrite /almost_everywhere => mA mB; rewrite setCI; exact: negligibleU. -Qed. - -Definition ae_filter_ringOfSetsType d {T : ringOfSetsType d} (R : realFieldType) - (mu : {measure set T -> \bar R}) : Filter (almost_everywhere mu). -Proof. -by split; [exact: almost_everywhereT|exact: almost_everywhereI| - exact: almost_everywhereS]. -Qed. - -Definition ae_properfilter_algebraOfSetsType d {T : algebraOfSetsType d} - (R : realFieldType) (mu : {measure set T -> \bar R}) : - mu [set: T] > 0 -> ProperFilter (almost_everywhere mu). -Proof. -move=> muT; split=> [|]; last exact: ae_filter_ringOfSetsType. -rewrite /almost_everywhere setC0 => /(measure_negligible measurableT). -by move/eqP; rewrite -measure_le0 leNgt => /negP. -Qed. - -End ae. - -#[global] Hint Extern 0 (Filter (almost_everywhere _)) => - (apply: ae_filter_ringOfSetsType) : typeclass_instances. -#[global] Hint Extern 0 (Filter (nbhs (almost_everywhere _))) => - (apply: ae_filter_ringOfSetsType) : typeclass_instances. - -#[global] Hint Extern 0 (ProperFilter (almost_everywhere _)) => - (apply: ae_properfilter_algebraOfSetsType) : typeclass_instances. -#[global] Hint Extern 0 (ProperFilter (nbhs (almost_everywhere _))) => - (apply: ae_properfilter_algebraOfSetsType) : typeclass_instances. - -Notation "{ 'ae' m , P }" := {near almost_everywhere m, P} : type_scope. -Notation "\forall x \ae mu , P" := (\forall x \near almost_everywhere mu, P) - : type_scope. -Definition ae_eq d (T : semiRingOfSetsType d) (R : realType) - (mu : {measure set T -> \bar R}) (V : T -> Type) D (f g : forall x, V x) := - \forall x \ae mu, D x -> f x = g x. -Notation "f = g %[ae mu 'in' D ]" := (\forall x \ae mu, D x -> f x = g x). -Notation "f = g %[ae mu ]" := (f = g %[ae mu in setT ]). - -Lemma measure0_ae d {T : algebraOfSetsType d} {R : realType} - (mu : {measure set T -> \bar R}) (P : set T) : - mu [set: T] = 0 -> \forall x \ae mu, P x. -Proof. by move=> x; exists setT. Qed. - -Lemma aeW {d} {T : semiRingOfSetsType d} {R : realFieldType} - (mu : {measure set _ -> \bar R}) (P : T -> Prop) : - (forall x, P x) -> \forall x \ae mu, P x. -Proof. -move=> aP; have -> : P = setT by rewrite predeqE => t; split. -by apply/negligibleP; [rewrite setCT|rewrite setCT measure0]. -Qed. - -Instance ae_eq_equiv d (T : ringOfSetsType d) R mu V D : - RelationClasses.Equivalence (@ae_eq d T R mu V D). -Proof. -split. -- by move=> f; near=> x. -- by move=> f g eqfg; near=> x => Dx; rewrite (near eqfg). -- by move=> f g h eqfg eqgh; near=> x => Dx; rewrite (near eqfg) ?(near eqgh). -Unshelve. all: by end_near. Qed. - -Section ae_eq. -Local Open Scope ring_scope. -Context d (T : sigmaRingType d) (R : realType). -Implicit Types (U V : Type) (W : ringType). -Variables (mu : {measure set T -> \bar R}) (D : set T). -Local Notation ae_eq := (ae_eq mu D). - -Lemma ae_eq0 U (f g : T -> U) : measurable D -> mu D = 0 -> f = g %[ae mu in D]. -Proof. by move=> mD D0; exists D; split => // t/= /not_implyP[]. Qed. - -Instance comp_ae_eq U V (j : T -> U -> V) : - Proper (ae_eq ==> ae_eq) (fun f x => j x (f x)). -Proof. by move=> f g; apply: filterS => x /[apply] /= ->. Qed. - -Instance comp_ae_eq2 U U' V (j : T -> U -> U' -> V) : - Proper (ae_eq ==> ae_eq ==> ae_eq) (fun f g x => j x (f x) (g x)). -Proof. by move=> f f' + g g'; apply: filterS2 => x + + Dx => -> // ->. Qed. - -Instance comp_ae_eq2' U U' V (j : U -> U' -> V) : - Proper (ae_eq ==> ae_eq ==> ae_eq) (fun f g x => j (f x) (g x)). -Proof. by move=> f f' + g g'; apply: filterS2 => x + + Dx => -> // ->. Qed. - -Instance sub_ae_eq2 : Proper (ae_eq ==> ae_eq ==> ae_eq) (@GRing.sub_fun T R). -Proof. exact: (@comp_ae_eq2' _ _ R (fun x y => x - y)). Qed. - -Lemma ae_eq_refl U (f : T -> U) : ae_eq f f. Proof. exact/aeW. Qed. -Hint Resolve ae_eq_refl : core. - -Lemma ae_eq_comp U V (j : U -> V) f g : - ae_eq f g -> ae_eq (j \o f) (j \o g). -Proof. by move->. Qed. - -Lemma ae_eq_comp2 U V (j : T -> U -> V) f g : - ae_eq f g -> ae_eq (fun x => j x (f x)) (fun x => j x (g x)). -Proof. by apply: filterS => x /[swap] + ->. Qed. - -Lemma ae_eq_funeposneg (f g : T -> \bar R) : - ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-. -Proof. -split=> [fg|[pfg nfg]]. - by split; near=> x => Dx; rewrite !(funeposE,funenegE) (near fg). -by near=> x => Dx; rewrite (funeposneg f) (funeposneg g) ?(near pfg, near nfg). -Unshelve. all: by end_near. Qed. - -Lemma ae_eq_sym U (f g : T -> U) : ae_eq f g -> ae_eq g f. -Proof. by symmetry. Qed. - -Lemma ae_eq_trans U (f g h : T -> U) : ae_eq f g -> ae_eq g h -> ae_eq f h. -Proof. by apply transitivity. Qed. - -Lemma ae_eq_sub W (f g h i : T -> W) : ae_eq f g -> ae_eq h i -> ae_eq (f \- h) (g \- i). -Proof. by apply: filterS2 => x + + Dx => /= /(_ Dx) -> /(_ Dx) ->. Qed. - -Lemma ae_eq_mul2r W (f g h : T -> W) : ae_eq f g -> ae_eq (f \* h) (g \* h). -Proof. by move=>/(ae_eq_comp2 (fun x y => y * h x)). Qed. - -Lemma ae_eq_mul2l W (f g h : T -> W) : ae_eq f g -> ae_eq (h \* f) (h \* g). -Proof. by move=>/(ae_eq_comp2 (fun x y => h x * y)). Qed. - -Lemma ae_eq_mul1l W (f g : T -> W) : ae_eq f (cst 1) -> ae_eq g (g \* f). -Proof. by apply: filterS => x /= /[apply] ->; rewrite mulr1. Qed. - -Lemma ae_eq_abse (f g : T -> \bar R) : ae_eq f g -> ae_eq (abse \o f) (abse \o g). -Proof. by apply: filterS => x /[apply] /= ->. Qed. - -Lemma ae_foralln (P : nat -> T -> Prop) : - (forall n, \forall x \ae mu, P n x) -> \forall x \ae mu, forall n, P n x. -Proof. -move=> /(_ _)/cid - /all_sig[A /all_and3[Ameas muA0 NPA]]. -have seqDUAmeas := seqDU_measurable Ameas. -exists (\bigcup_n A n); split => //. -- exact/bigcup_measurable. -- rewrite seqDU_bigcup_eq measure_bigcup// eseries0// => i _ _. - by rewrite (@subset_measure0 _ _ _ _ _ (A i))//=; apply: subset_seqDU. -- by move=> x /=; rewrite -existsNP => -[n NPnx]; exists n => //; apply: NPA. -Qed. - -End ae_eq. - -Section ae_eq_lemmas. -Context d (T : sigmaRingType d) (R : realType) (U : Type). -Implicit Types (mu : {measure set T -> \bar R}) (A : set T) (f g : T -> U). - -Lemma ae_eq_subset mu A B f g : B `<=` A -> ae_eq mu A f g -> ae_eq mu B f g. -Proof. by move=> BA; apply: filterS => x + /BA; apply. Qed. - -End ae_eq_lemmas. - -Section ae_eqe. -Context d (T : sigmaRingType d) (R : realType). -Implicit Types (mu : {measure set T -> \bar R}) (D : set T) (f g h : T -> \bar R). - -Lemma ae_eqe_mul2l mu D f g h : ae_eq mu D f g -> ae_eq mu D (h \* f)%E (h \* g). -Proof. by apply: filterS => x /= /[apply] ->. Qed. - -End ae_eqe. - -Definition sigma_subadditive {T} {R : numFieldType} - (mu : set T -> \bar R) := forall (F : (set T) ^nat), - mu (\bigcup_n (F n)) <= \sum_(i \bar R) := { - outer_measure0 : mu set0 = 0 ; - outer_measure_ge0 : forall x, 0 <= mu x ; - le_outer_measure : {homo mu : A B / A `<=` B >-> A <= B} ; - outer_measure_sigma_subadditive : sigma_subadditive mu }. - -#[short(type=outer_measure)] -HB.structure Definition OuterMeasure (R : numFieldType) (T : Type) := - {mu & isOuterMeasure R T mu}. - -Notation "{ 'outer_measure' 'set' T '->' '\bar' R }" := (outer_measure R T) - : ring_scope. - -#[global] Hint Extern 0 (_ set0 = 0%R) => solve [apply: outer_measure0] : core. -#[global] Hint Extern 0 (sigma_subadditive _) => - solve [apply: outer_measure_sigma_subadditive] : core. - -Arguments outer_measure0 {R T} _. -Arguments outer_measure_ge0 {R T} _. -Arguments le_outer_measure {R T} _. -Arguments outer_measure_sigma_subadditive {R T} _. - -HB.factory Record isSubsetOuterMeasure - (R : realType) (T : Type) (mu : set T -> \bar R) := { - outer_measure0 : mu set0 = 0 ; - outer_measure_ge0 : forall x, 0 <= mu x ; - subset_outer_measure_sigma_subadditive : - forall A F, subset_sigma_subadditive mu A F}. - -HB.builders Context {R : realType} T mu of isSubsetOuterMeasure R T mu. - -Lemma le_outer_measure : {homo mu : A B / A `<=` B >-> A <= B}. -Proof. -move=> A B AB; pose B_ k := if k is 0%N then B else set0. -have -> : mu B = \sum_(n *; rewrite outer_measure_ge0. - rewrite eseries_cond/= eseries0 ?adde0// => -[|]//= k _ _. - by rewrite outer_measure0. -apply: subset_outer_measure_sigma_subadditive => //. -by rewrite bigcup_recl/= bigcup0 ?setU0// => -[/negP|]. -Qed. - -Lemma outer_measure_sigma_subadditive : sigma_subadditive mu. -Proof. by move=> F; exact: subset_outer_measure_sigma_subadditive. Qed. - -HB.instance Definition _ := isOuterMeasure.Build R T mu outer_measure0 - outer_measure_ge0 le_outer_measure outer_measure_sigma_subadditive. - -HB.end. - -Lemma outer_measure_sigma_subadditive_tail (T : Type) (R : realType) - (mu : {outer_measure set T -> \bar R}) N (F : (set T) ^nat) : - (mu (\bigcup_(n in ~` `I_N) (F n)) <= \sum_(N <= i if n \in ~` `I_N then F n else set0). -move/le_trans; apply. -rewrite [in leRHS]eseries_cond [in leRHS]eseries_mkcondr; apply: lee_nneseries. -- by move=> k _ _; exact: outer_measure_ge0. -- move=> k _; rewrite fun_if; case: ifPn => Nk; first by rewrite mem_not_I Nk. - by rewrite mem_not_I (negbTE Nk) outer_measure0. -Qed. - -Section outer_measureU. -Context (T : Type) (R : realType). -Variable mu : {outer_measure set T -> \bar R}. -Local Open Scope ereal_scope. - -Lemma outer_measure_subadditive (F : (set T)^nat) n : - mu (\big[setU/set0]_(i < n) F i) <= \sum_(i < n) mu (F i). -Proof. -pose F' := fun k => if (k < n)%N then F k else set0. -rewrite -(big_mkord xpredT F) big_nat (eq_bigr F')//; last first. - by move=> k /= kn; rewrite /F' kn. -rewrite -big_nat big_mkord. -have := outer_measure_sigma_subadditive mu F'. -rewrite (bigcup_splitn n) (_ : bigcup _ _ = set0) ?setU0; last first. - by rewrite bigcup0 // => k _; rewrite /F' /= ltnNge leq_addr. -move/le_trans; apply. -rewrite (nneseries_split _ n); last by move=> ? ?; exact: outer_measure_ge0. -rewrite [X in _ + X]eseries0 ?adde0; last first. - by move=> k nk _; rewrite /F' ltnNge nk/= outer_measure0. -by rewrite big_mkord; apply: lee_sum => i _; rewrite /F' ltn_ord. -Qed. - -Lemma outer_measureU2 A B : mu (A `|` B) <= mu A + mu B. -Proof. -have := outer_measure_subadditive (bigcup2 A B) 2. -by rewrite !big_ord_recl/= !big_ord0 setU0 adde0. -Qed. - -End outer_measureU. - -Lemma le_outer_measureIC (R : realFieldType) T - (mu : {outer_measure set T -> \bar R}) (A X : set T) : - mu X <= mu (X `&` A) + mu (X `&` ~` A). -Proof. -pose B : (set T) ^nat := bigcup2 (X `&` A) (X `&` ~` A). -have cvg_mu : (fun n => \sum_(i < n) mu (B i)) @ \oo --> mu (B 0%N) + mu (B 1%N). - rewrite -2!cvg_shiftS /=. - rewrite [X in X @ \oo --> _](_ : _ = (fun=> mu (B 0%N) + mu (B 1%N))); last first. - rewrite funeqE => i; rewrite 2!big_ord_recl /= big1 ?adde0 // => j _. - by rewrite /B /bigcup2 /=. - exact: cvg_cst. -have := outer_measure_sigma_subadditive mu B. -suff : \bigcup_n B n = X. - move=> -> /le_trans; apply; under eq_fun do rewrite big_mkord. - by rewrite (cvg_lim _ cvg_mu). -transitivity (\big[setU/set0]_(i < 2) B i). - by rewrite (bigcup_splitn 2) // -bigcup_mkord setUidl// => t -[]. -by rewrite 2!big_ord_recl big_ord0 setU0 /= -setIUr setUCr setIT. -Unshelve. all: by end_near. Qed. - -Definition caratheodory_measurable (R : realType) (T : Type) - (mu : set T -> \bar R) (A : set T) := forall X, - mu X = mu (X `&` A) + mu (X `&` ~` A). - -Local Notation "mu .-caratheodory" := - (caratheodory_measurable mu) : classical_set_scope. - -Lemma le_caratheodory_measurable (R : realType) T - (mu : {outer_measure set T -> \bar R}) (A : set T) : - (forall X, mu (X `&` A) + mu (X `&` ~` A) <= mu X) -> - mu.-caratheodory A. -Proof. -move=> suf X; apply/eqP; rewrite eq_le; apply/andP; split; - [exact: le_outer_measureIC | exact: suf]. -Qed. - -Section caratheodory_theorem_sigma_algebra. -Variables (R : realType) (T : Type) (mu : {outer_measure set T -> \bar R}). - -Lemma outer_measure_bigcup_lim (A : (set T) ^nat) X : - mu (X `&` \bigcup_k A k) <= \sum_(k X `&` A n))). -by apply/le_outer_measure; rewrite setI_bigcupr. -Qed. - -Let M := mu.-caratheodory. - -Lemma caratheodory_measurable_set0 : M set0. -Proof. by move=> X /=; rewrite setI0 outer_measure0 add0e setC0 setIT. Qed. - -Lemma caratheodory_measurable_setC A : M A -> M (~` A). -Proof. by move=> MA X; rewrite setCK addeC -MA. Qed. - -Lemma caratheodory_measurable_setU_le (X A B : set T) : - mu.-caratheodory A -> mu.-caratheodory B -> - mu (X `&` (A `|` B)) + mu (X `&` ~` (A `|` B)) <= mu X. -Proof. -move=> mA mB; pose Y := X `&` A `|` X `&` B `&` ~` A. -have /(leeD2r (mu (X `&` ~` (A `|` B)))) : - mu Y <= mu (X `&` A) + mu (X `&` B `&` ~` A). - pose Z := bigcup2 (X `&` A) (X `&` B `&` ~` A). - have -> : Y = \bigcup_k Z k. - rewrite predeqE => t; split=> [[?|?]|[]]; [by exists O|by exists 1%N|]. - by move=> [_ ?|[_ ?|//]]; [left|right]. - rewrite (le_trans (outer_measure_sigma_subadditive mu Z))//. - rewrite le_eqVlt; apply/orP; left; apply/eqP. - apply/cvg_lim => //; rewrite -(cvg_shiftn 2)/=; apply: cvg_near_cst. - apply: nearW => k; rewrite big_mkord addn2 2!big_ord_recl big1 ?adde0//. - by move=> ? _; exact: outer_measure0. -have /le_trans : mu (X `&` (A `|` B)) + mu (X `&` ~` (A `|` B)) <= - mu Y + mu (X `&` ~` (A `|` B)). - rewrite setIUr (_ : X `&` A `|` X `&` B = Y) //. - rewrite /Y -[in LHS](setIT B) -(setUCr A) 2!setIUr setUC -[in RHS]setIA. - rewrite setUC setUA; congr (_ `|` _). - by rewrite setUidPl setICA; apply: subIset; right. -suff -> : mu (X `&` A) + mu (X `&` B `&` ~` A) + - mu (X `&` (~` (A `|` B))) = mu X by exact. -by rewrite setCU setIA -(setIA X) setICA (setIC B) -addeA -mB -mA. -Qed. - -Lemma caratheodory_measurable_setU A B : M A -> M B -> M (A `|` B). -Proof. -move=> mA mB X; apply/eqP; rewrite eq_le. -by rewrite le_outer_measureIC andTb caratheodory_measurable_setU_le. -Qed. - -Lemma caratheodory_measurable_bigsetU (A : (set T) ^nat) : - (forall n, M (A n)) -> forall n, M (\big[setU/set0]_(i < n) A i). -Proof. -move=> MA n; elim/big_ind : _ => //; first exact: caratheodory_measurable_set0. -exact: caratheodory_measurable_setU. -Qed. - -Lemma caratheodory_measurable_setI A B : M A -> M B -> M (A `&` B). -Proof. -move=> mA mB; rewrite -(setCK A) -(setCK B) -setCU. -by apply/caratheodory_measurable_setC/caratheodory_measurable_setU; - exact/caratheodory_measurable_setC. -Qed. - -Lemma caratheodory_measurable_setD A B : M A -> M B -> M (A `\` B). -Proof. -move=> mA mB; rewrite setDE; apply: caratheodory_measurable_setI => //. -exact: caratheodory_measurable_setC. -Qed. - -Section additive_ext_lemmas. -Variable A B : set T. -Hypothesis (mA : M A) (mB : M B). - -Let caratheodory_decomp X : - mu X = mu (X `&` A `&` B) + mu (X `&` A `&` ~` B) + - mu (X `&` ~` A `&` B) + mu (X `&` ~` A `&` ~` B). -Proof. by rewrite mA mB [X in _ + _ + X = _]mB addeA. Qed. - -(* TODO: not used? *) -Let caratheodory_decompIU X : mu (X `&` (A `|` B)) = - mu (X `&` A `&` B) + mu (X `&` ~` A `&` B) + mu (X `&` A `&` ~` B). -Proof. -rewrite caratheodory_decomp -!addeA; congr (mu _ + _). - rewrite -!setIA; congr (_ `&` _). - by rewrite setIC; apply/setIidPl; apply: subIset; left; exact: subsetUl. -rewrite addeA addeC [X in mu X + _](_ : _ = set0); last first. - by rewrite -setIA -setCU -setIA setICr setI0. -rewrite outer_measure0 add0e addeC -!setIA; congr (mu (X `&` _) + mu (X `&` _)). - by rewrite setIC; apply/setIidPl; apply: subIset; right; exact: subsetUr. -by rewrite setIC; apply/setIidPl; apply: subIset; left; exact: subsetUl. -Qed. - -Lemma disjoint_caratheodoryIU X : [disjoint A & B] -> - mu (X `&` (A `|` B)) = mu (X `&` A) + mu (X `&` B). -Proof. -move=> /eqP AB; rewrite caratheodory_decomp -setIA AB setI0 outer_measure0. -rewrite add0e addeC -setIA -setCU -setIA setICr setI0 outer_measure0 add0e. -rewrite -!setIA; congr (mu (X `&` _ ) + mu (X `&` _)). -rewrite (setIC A) setIA setIC; apply/setIidPl. -- by rewrite setIUl setICr setU0 subsetI; move/disjoints_subset in AB; split. -- rewrite setIA setIC; apply/setIidPl; rewrite setIUl setICr set0U. - by move: AB; rewrite setIC => /disjoints_subset => AB; rewrite subsetI; split. -Qed. - -End additive_ext_lemmas. - -Lemma caratheodory_additive (A : (set T) ^nat) : (forall n, M (A n)) -> - trivIset setT A -> forall n X, - mu (X `&` \big[setU/set0]_(i < n) A i) = \sum_(i < n) mu (X `&` A i). -Proof. -move=> MA ta; elim=> [|n ih] X; first by rewrite !big_ord0 setI0 outer_measure0. -rewrite big_ord_recr /= disjoint_caratheodoryIU // ?ih ?big_ord_recr //. -- exact: caratheodory_measurable_bigsetU. -- by apply/eqP/(@trivIset_bigsetUI _ predT) => //; rewrite /predT /= trueE. -Qed. - -Lemma caratheodory_lime_le (A : (set T) ^nat) : (forall n, M (A n)) -> - trivIset setT A -> forall X, - \sum_(k MA tA X. -set A' := \bigcup_k A k; set B := fun n => \big[setU/set0]_(k < n) (A k). -suff : forall n, \sum_(k < n) mu (X `&` A k) + mu (X `&` ~` A') <= mu X. - move=> XA; rewrite (_ : limn _ = ereal_sup - ((fun n => \sum_(k < n) mu (X `&` A k)) @` setT)); last first. - under eq_fun do rewrite big_mkord. - apply/cvg_lim => //; apply: ereal_nondecreasing_cvgn. - apply: (lee_sum_nneg_ord (fun n => mu (X `&` A n)) xpredT) => n _. - exact: outer_measure_ge0. - move XAx : (mu (X `&` ~` A')) => [x| |]. - - rewrite -leeBrDr //; apply: ub_ereal_sup => /= _ [n _] <-. - by rewrite EFinN leeBrDr // -XAx XA. - - suff : mu X = +oo by move=> ->; rewrite leey. - by apply/eqP; rewrite -leye_eq -XAx le_outer_measure. - - by rewrite addeNy leNye. -move=> n. -apply: (@le_trans _ _ (\sum_(k < n) mu (X `&` A k) + mu (X `&` ~` B n))). - apply/leeD2l/le_outer_measure; apply: setIS; exact/subsetC/bigsetU_bigcup. -rewrite [in leRHS](caratheodory_measurable_bigsetU MA n) leeD2r//. -by rewrite caratheodory_additive. -Qed. - -Lemma caratheodory_measurable_trivIset_bigcup (A : (set T) ^nat) : - (forall n, M (A n)) -> trivIset setT A -> M (\bigcup_k (A k)). -Proof. -move=> MA tA; apply: le_caratheodory_measurable => X /=. -have /(leeD2r (mu (X `&` ~` (\bigcup_k A k)))) := outer_measure_bigcup_lim A X. -by move/le_trans; apply; exact: caratheodory_lime_le. -Qed. - -Lemma caratheodory_measurable_bigcup (A : (set T) ^nat) : (forall n, M (A n)) -> - M (\bigcup_k (A k)). -Proof. -move=> MA; rewrite -eq_bigcup_seqD_bigsetU. -apply/caratheodory_measurable_trivIset_bigcup; last first. - by apply: trivIset_seqD => m n mn; exact/subsetPset/subset_bigsetU. -by case=> [|n /=]; [| apply/caratheodory_measurable_setD => //]; - exact/caratheodory_measurable_bigsetU. -Qed. - -End caratheodory_theorem_sigma_algebra. - -Definition caratheodory_type (R : realType) (T : Type) - (mu : set T -> \bar R) := T. - -Definition caratheodory_display R T : (set T -> \bar R) -> measure_display. -Proof. exact. Qed. - -Section caratheodory_sigma_algebra. -Variables (R : realType) (T : pointedType) (mu : {outer_measure set T -> \bar R}). - -HB.instance Definition _ := Pointed.on (caratheodory_type mu). -HB.instance Definition _ := @isMeasurable.Build (caratheodory_display mu) - (caratheodory_type mu) mu.-caratheodory - (caratheodory_measurable_set0 mu) - (@caratheodory_measurable_setC _ _ mu) - (@caratheodory_measurable_bigcup _ _ mu). - -End caratheodory_sigma_algebra. - -Notation "mu .-cara" := (caratheodory_display mu) : measure_display_scope. -Notation "mu .-cara.-measurable" := - (measurable : set (set (caratheodory_type mu))) : classical_set_scope. - -Section caratheodory_measure. -Variables (R : realType) (T : pointedType). -Variable mu : {outer_measure set T -> \bar R}. -Let U := caratheodory_type mu. - -Lemma caratheodory_measure0 : mu (set0 : set U) = 0. -Proof. exact: outer_measure0. Qed. - -Lemma caratheodory_measure_ge0 (A : set U) : 0 <= mu A. -Proof. exact: outer_measure_ge0. Qed. - -Lemma caratheodory_measure_sigma_additive : - semi_sigma_additive (mu : set U -> _). -Proof. -move=> A mA tA mbigcupA; set B := \bigcup_k A k. -suff : forall X, mu X = \sum_(k _) = fun n => \sum_(k < n) mu (A k)); last first. - rewrite funeqE => n; rewrite big_mkord; apply: eq_bigr => i _; congr (mu _). - by rewrite setIC; apply/setIidPl; exact: bigcup_sup. - move=> ->. - have := fun n (_ : xpredT n) (_ : xpredT n) => outer_measure_ge0 mu (A n). - move/(@is_cvg_nneseries _ _ _ 0) => /cvg_ex[l] hl. - under [in X in _ --> X]eq_fun do rewrite -(big_mkord xpredT (mu \o A)). - by move/cvg_lim : (hl) => ->. -move=> X. -have mB : mu.-cara.-measurable B := caratheodory_measurable_bigcup mA. -apply/eqP; rewrite eq_le (caratheodory_lime_le mA tA X) andbT. -have /(leeD2r (mu (X `&` ~` B))) := outer_measure_bigcup_lim mu A X. -by rewrite -le_caratheodory_measurable // => ?; rewrite -mB. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ - (mu : set (caratheodory_type mu) -> _) - caratheodory_measure0 caratheodory_measure_ge0 - caratheodory_measure_sigma_additive. - -Lemma measure_is_complete_caratheodory : - measure_is_complete (mu : set (caratheodory_type mu) -> _). -Proof. -move=> B [A [mA muA0 BA]]; apply: le_caratheodory_measurable => X. -suff -> : mu (X `&` B) = 0. - by rewrite add0e le_outer_measure //; apply: subIset; left. -have muB0 : mu B = 0. - apply/eqP; rewrite eq_le outer_measure_ge0 andbT. - by apply: (le_trans (le_outer_measure mu _ _ BA)); rewrite -muA0. -apply/eqP; rewrite eq_le outer_measure_ge0 andbT. -have : X `&` B `<=` B by apply: subIset; right. -by move/(le_outer_measure mu); rewrite muB0 => ->. -Qed. - -End caratheodory_measure. - -Lemma epsilon_trick (R : realType) (A : (\bar R)^nat) e - (P : pred nat) : (forall n, 0 <= A n) -> (0 <= e)%R -> - \sum_(i A0 /nonnegP[{}e]. -rewrite (@le_trans _ _ (lim ((fun n => (\sum_(0 <= i < n | P i) A i) + - \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) @ \oo))) //. - rewrite nneseriesD // limeD //. - - rewrite leeD2l //; apply: lee_lim => //. - + exact: is_cvg_nneseries. - + exact: is_cvg_nneseries. - + by near=> n; exact: lee_sum_nneg_subset. - - exact: is_cvg_nneseries. - - exact: is_cvg_nneseries. - - exact: adde_def_nneseries. -suff cvggeo : (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) @ \oo --> - e%:num%:E. - rewrite limeD //. - - by rewrite leeD2l // (cvg_lim _ cvggeo). - - exact: is_cvg_nneseries. - - by apply: is_cvg_nneseries => ?; rewrite lee_fin divr_ge0. - - by rewrite (cvg_lim _ cvggeo) //= fin_num_adde_defl. -rewrite (_ : (fun n => _) = EFin \o - (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ (i + 1))%:R))%R); last first. - rewrite funeqE => n /=; rewrite (@big_morph _ _ EFin 0 adde)//. - by under [in RHS]eq_bigr do rewrite addn1. -apply: cvg_comp; last by apply cvg_refl. -have := cvg_geometric_series_half e%:num O. -by rewrite expr0 divr1; apply: cvg_trans. -Unshelve. all: by end_near. Qed. - -Lemma epsilon_trick0 (R : realType) (eps : R) (P : pred nat) : - (0 <= eps)%R -> \sum_(i epspos; have := epsilon_trick P (fun=> lexx 0) epspos. -(* TODO: breaks coq 8.15 and below *) -(* (under eq_eseriesr do rewrite add0e) => /le_trans; apply. *) -rewrite (@eq_eseriesr _ (fun n => 0 + _) (fun n => (eps/(2^n.+1)%:R)%:E)). - by move/le_trans; apply; rewrite eseries0 ?add0e; [exact: lexx | move=> ? ?]. -by move=> ? ?; rewrite add0e. -Qed. - -Section measurable_cover. -Context d (T : semiRingOfSetsType d). -Implicit Types (X : set T) (F : (set T)^nat). - -Definition measurable_cover X := [set F : (set T)^nat | - (forall i, measurable (F i)) /\ X `<=` \bigcup_k (F k)]. - -Lemma cover_measurable X F : measurable_cover X F -> forall k, measurable (F k). -Proof. by move=> + k; rewrite /measurable_cover => -[] /(_ k). Qed. - -Lemma cover_subset X F : measurable_cover X F -> X `<=` \bigcup_k (F k). -Proof. by case. Qed. - -End measurable_cover. - -Lemma measurable_uncurry (T1 T2 : Type) d (T : semiRingOfSetsType d) - (G : T1 -> T2 -> set T) (x : T1 * T2) : - measurable (G x.1 x.2) <-> measurable (uncurry G x). -Proof. by case: x. Qed. - -Section outer_measure_construction. -Context d (T : semiRingOfSetsType d) (R : realType). -Variable mu : set T -> \bar R. -Hypothesis (measure0 : mu set0 = 0) (measure_ge0 : forall X, mu X >= 0). -Hint Resolve measure_ge0 measure0 : core. - -Definition mu_ext (X : set T) : \bar R := - ereal_inf [set \sum_(k -> A <= B}. -Proof. -move=> A B AB; apply/le_ereal_inf => x [B' [mB' BB']]. -by move=> <-{x}; exists B' => //; split => //; apply: subset_trans AB BB'. -Qed. - -Lemma mu_ext_ge0 A : 0 <= mu^* A. -Proof. -apply: lb_ereal_inf => x [B [mB AB] <-{x}]; rewrite lime_ge //=. - exact: is_cvg_nneseries. -by near=> n; rewrite sume_ge0. -Unshelve. all: by end_near. Qed. - -Lemma mu_ext0 : mu^* set0 = 0. -Proof. -apply/eqP; rewrite eq_le; apply/andP; split; last exact/mu_ext_ge0. -rewrite /mu_ext; apply: ereal_inf_lbound; exists (fun=> set0); first by split. -by apply: lim_near_cst => //; near=> n => /=; rewrite big1. -Unshelve. all: by end_near. Qed. - -Lemma mu_ext_sigma_subadditive : sigma_subadditive mu^*. -Proof. -move=> A; have [[i ioo]|] := pselect (exists i, mu^* (A i) = +oo). - rewrite (eseries_pinfty _ _ ioo) ?leey// => n _. - by rewrite -ltNye (lt_le_trans _ (mu_ext_ge0 _)). -rewrite -forallNE => Aoo. -suff add2e (e : {posnum R}) : - mu^* (\bigcup_n A n) <= \sum_(i _/posnumP[]. -rewrite (le_trans _ (epsilon_trick _ _ _))//; last first. - by move=> n; exact: mu_ext_ge0. -pose P n (B : (set T)^nat) := measurable_cover (A n) B /\ - \sum_(k n; rewrite /P /mu_ext. - set S := (X in ereal_inf X); move infS : (ereal_inf S) => iS. - case: iS infS => [r Sr|Soo|Soo]. - - have en1 : (0 < e%:num / (2 ^ n.+1)%:R)%R by []. - have /(lb_ereal_inf_adherent en1) : ereal_inf S \is a fin_num by rewrite Sr. - move=> [x [B [mB AnB muBx] xS]]. - by exists B; split => //; rewrite muBx -Sr; exact/ltW. - - by have := Aoo n; rewrite /mu^* Soo. - - suff : lbound S 0 by move/lb_ereal_inf; rewrite Soo. - by move=> /= _ [B [mB AnB] <-]; exact: nneseries_ge0. -have muG_ge0 x : 0 <= (mu \o uncurry G) x by exact: measure_ge0. -apply: (@le_trans _ _ (\esum_(i in setT) (mu \o uncurry G) i)). - rewrite /mu_ext; apply: ereal_inf_lbound => /=. - have /card_esym/ppcard_eqP[f] := card_nat2. - exists (uncurry G \o f). - split => [i|]; first exact/measurable_uncurry/(PG (f i).1).1.1. - apply: (@subset_trans _ (\bigcup_n \bigcup_k G n k)) => [t [i _]|]. - by move=> /(cover_subset (PG i).1) -[j _ ?]; exists i => //; exists j. - move=> t [i _ [j _ Bijt]]; exists (f^-1%FUN (i, j)) => //=. - by rewrite invK ?inE. - rewrite -(esum_pred_image (mu \o uncurry G) _ xpredT) ?[fun=> _]set_true//. - by rewrite image_eq. -rewrite (_ : esum _ _ = \sum_(i set (nat * nat) := fun i => [set (i, j) | j in setT]. - rewrite (_ : setT = \bigcup_k J k); last first. - by rewrite predeqE => -[a b]; split => // _; exists a => //; exists b. - rewrite esum_bigcupT /=; last 2 first. - - apply/trivIsetP => i j _ _ ij. - rewrite predeqE => -[n m] /=; split => //= -[] [_] _ [<-{n} _]. - by move=> [m' _] [] /esym/eqP; rewrite (negbTE ij). - - by move=> /= [n m]; apply: measure_ge0; exact: (cover_measurable (PG n).1). - rewrite -(image_id [set: nat]) -fun_true esum_pred_image//; last first. - by move=> n _; exact: esum_ge0. - apply: eq_eseriesr => /= j _. - rewrite -(esum_pred_image (mu \o uncurry G) (pair j) predT)//=; last first. - by move=> ? ? _ _; exact: (@can_inj _ _ _ snd). - by congr esum; rewrite predeqE => -[a b]; split; move=> [i _ <-]; exists i. -apply: lee_lim. -- apply: is_cvg_nneseries => n *. - by apply: nneseries_ge0 => m *; exact: (muG_ge0 (n, m)). -- by apply: is_cvg_nneseries => n *; apply: adde_ge0 => //; exact: mu_ext_ge0. -- by near=> n; apply: lee_sum => i _; exact: (PG i).2. -Unshelve. all: by end_near. Qed. - -End outer_measure_construction. -Declare Scope measure_scope. -Delimit Scope measure_scope with mu. -Notation "mu ^*" := (mu_ext mu) : measure_scope. -Local Open Scope measure_scope. - -Section outer_measure_of_content. -Context d (R : realType) (T : semiRingOfSetsType d). -Variable mu : {content set T -> \bar R}. - -HB.instance Definition _ := isOuterMeasure.Build - R T _ (@mu_ext0 _ _ _ _ (measure0 mu) (measure_ge0 mu)) - (mu_ext_ge0 (measure_ge0 mu)) - (le_mu_ext mu) - (mu_ext_sigma_subadditive (measure_ge0 mu)). - -End outer_measure_of_content. - -Section g_sigma_algebra_measure_unique. -Context d (R : realType) (T : measurableType d). -Variable G : set (set T). -Hypothesis Gm : G `<=` measurable. -Variable g : (set T)^nat. -Hypotheses Gg : forall i, G (g i). -Hypothesis g_cover : \bigcup_k (g k) = setT. -Variables m1 m2 : {measure set T -> \bar R}. - -Lemma g_sigma_algebra_measure_unique_cover : - (forall n A, <> A -> m1 (g n `&` A) = m2 (g n `&` A)) -> - forall A, <> A -> m1 A = m2 A. -Proof. -pose GT : ringOfSetsType G.-sigma:= g_sigma_algebraType G. -move=> sGm1m2; pose g' k := \bigcup_(i < k) g i. -have sGm := smallest_sub (@sigma_algebra_measurable _ T) Gm. -have Gg' i : <> (g' i). - apply: (@fin_bigcup_measurable _ GT) => //. - by move=> n _; apply: sub_sigma_algebra. -have sG'm1m2 n A : <> A -> m1 (g' n `&` A) = m2 (g' n `&` A). - move=> sGA; rewrite setI_bigcupl bigcup_mkord. - elim: n => [|n IHn] in A sGA *; rewrite (big_ord0, big_ord_recr) ?measure0//=. - have sGgA i : <> (g i `&` A). - by apply: (@measurableI _ GT) => //; exact: sub_sigma_algebra. - apply: eq_measureU; rewrite ?sGm1m2 ?IHn//; last first. - - by rewrite -big_distrl -setIA big_distrl/= IHn// setICA setIid. - - exact/sGm. - - by apply: bigsetU_measurable => i _; apply/sGm. -have g'_cover : \bigcup_k (g' k) = setT. - by rewrite -subTset -g_cover => x [k _ gx]; exists k.+1 => //; exists k => /=. -have nd_g' : nondecreasing_seq g'. - move=> m n lemn; rewrite subsetEset => x [k km gx]; exists k => //=. - exact: leq_trans lemn. -move=> A gA. -have -> : A = \bigcup_n (g' n `&` A) by rewrite -setI_bigcupl g'_cover setTI. -transitivity (lim (m1 (g' n `&` A) @[n --> \oo])). - apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. - - by move=> n; apply: measurableI; exact/sGm. - - by apply: bigcupT_measurable => k; apply: measurableI; exact/sGm. - - by move=> ? ? ?; apply/subsetPset; apply: setSI; exact/subsetPset/nd_g'. -transitivity (lim (m2 (g' n `&` A) @[n --> \oo])). - by apply/congr_lim/funext => x; apply: sG'm1m2 => //; exact/sGm. -apply/cvg_lim => //; apply: nondecreasing_cvg_mu. -- by move=> k; apply: measurableI => //; exact/sGm. -- by apply: bigcupT_measurable => k; apply: measurableI; exact/sGm. -- by move=> a b ab; apply/subsetPset; apply: setSI; exact/subsetPset/nd_g'. -Qed. - -Hypothesis setIG : setI_closed G. -Hypothesis m1m2 : forall A, G A -> m1 A = m2 A. -Hypothesis m1goo : forall k, (m1 (g k) < +oo)%E. - -Lemma g_sigma_algebra_measure_unique : forall E, <> E -> m1 E = m2 E. -Proof. -pose G_ n := [set X | G X /\ X `<=` g n]. (* "trace" *) -have G_E n : G_ n = [set g n `&` C | C in G]. - rewrite eqEsubset; split. - by move=> X [GX Xgn] /=; exists X => //; rewrite setIidr. - by rewrite /G_ => X [Y GY <-{X}]; split; [exact: setIG|apply: subIset; left]. -have gIsGE n : [set g n `&` A | A in <>] = - <>. - rewrite g_sigma_preimageE eqEsubset; split. - by move=> _ /= [Y sGY <-]; exists Y => //; rewrite preimage_id setIC. - by move=> _ [Y mY <-] /=; exists Y => //; rewrite preimage_id setIC. -have preimg_gGE n : preimage_set_system (g n) id G = G_ n. - rewrite eqEsubset; split => [_ [Y GY <-]|]. - by rewrite preimage_id G_E /=; exists Y => //; rewrite setIC. - by move=> X [GX Xgn]; exists X => //; rewrite preimage_id setIidr. -apply: g_sigma_algebra_measure_unique_cover => //. -move=> n A sGA; apply: (g_sigma_algebra_measure_unique_trace G (g n)) => //. -- exact: Gm. -- by move=> ? [? _]; exact/Gm. -- by move=> ? ? [? ?] [? ?]; split; [exact: setIG|apply: subIset; tauto]. -- exact: m1m2. -- by move=> ? [? ?]; exact: m1m2. -- move=> X; rewrite -/(G_ n) -preimg_gGE -gIsGE. - by case=> B sGB <-{X}; apply: subIset; left. -- by rewrite -/(G_ n) -preimg_gGE -gIsGE; exists A. -Qed. - -End g_sigma_algebra_measure_unique. -Arguments g_sigma_algebra_measure_unique {d R T} G. -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_measure_unique_cover`")] -Notation g_salgebra_measure_unique_cover := g_sigma_algebra_measure_unique_cover (only parsing). -#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_measure_unique`")] -Notation g_salgebra_measure_unique := g_sigma_algebra_measure_unique (only parsing). - -Section measure_unique. -Context d (R : realType) (T : measurableType d). -Variables (G : set (set T)) (g : (set T)^nat). -Hypotheses (mG : measurable = <>) (setIG : setI_closed G). -Hypothesis Gg : forall i, G (g i). -Hypothesis g_cover : \bigcup_k (g k) = setT. -Variables m1 m2 : {measure set T -> \bar R}. -Hypothesis m1m2 : forall A, G A -> m1 A = m2 A. -Hypothesis m1goo : forall k, (m1 (g k) < +oo)%E. - -Lemma measure_unique A : measurable A -> m1 A = m2 A. -Proof. -move=> mA; apply: (g_sigma_algebra_measure_unique G); rewrite -?mG//. -by rewrite mG; exact: sub_sigma_algebra. -Qed. - -End measure_unique. -Arguments measure_unique {d R T} G g. - -Lemma measurable_mu_extE d (R : realType) (T : semiRingOfSetsType d) - (mu : {measure set T -> \bar R}) X : - measurable X -> mu^* X = mu X. -Proof. -move=> mX; apply/eqP; rewrite eq_le; apply/andP; split. - apply: ereal_inf_lbound; exists (fun n => if n is 0%N then X else set0). - by split=> [[]// _|t Xt]; exists 0%N. - apply/cvg_lim => //; rewrite -cvg_shiftS. - rewrite (_ : [sequence _]_n = cst (mu X)); first exact: cvg_cst. - by rewrite funeqE => n /=; rewrite big_nat_recl//= big1 ?adde0. -apply/lb_ereal_inf => x [A [mA XA] <-{x}]. -have XUA : X = \bigcup_n (X `&` A n). - rewrite predeqE => t; split => [Xt|[i _ []//]]. - by have [i _ Ait] := XA _ Xt; exists i. -apply: (@le_trans _ _ (\sum_(i // i; apply: measurableI. -apply: lee_lim; [exact: is_cvg_nneseries|exact: is_cvg_nneseries|]. -by apply: nearW => n; apply: lee_sum => i _; exact: measureIr. -Qed. - -Section Rmu_ext. -Import SetRing. - -Lemma Rmu_ext d (R : realType) (T : semiRingOfSetsType d) - (mu : {content set T -> \bar R}) : - (measure mu)^* = mu^*. -Proof. -apply/funeqP => /= X; rewrite /mu_ext/=; apply/eqP; rewrite eq_le. -rewrite ?lb_ereal_inf// => _ [F [Fm XS] <-]; rewrite ereal_inf_lbound//; last first. - exists F; first by split=> // i; exact: sub_gen_smallest. - by rewrite (eq_eseriesr (fun _ _ => RmuE _ (Fm _))). -pose K := [set: nat] `*`` fun i => decomp (F i). -have /ppcard_eqP[f] : (K #= [set: nat])%card. - apply: cardXR_eq_nat => // i; split; last by apply/set0P; rewrite decompN0. - by apply: finite_set_countable => //; exact: decomp_finite_set. -pose g i := (f^-1%FUN i).2; exists g; first split. -- move=> k; have [/= _ /mem_set] : K (f^-1%FUN k) by apply: funS. - exact: decomp_measurable. -- move=> i /XS [k _]; rewrite -[F k]cover_decomp => -[D /= DFk Di]. - by exists (f (k, D)) => //; rewrite /g invK// inE. -rewrite !nneseries_esumT//= /measure. -transitivity (\esum_(i in setT) \sum_(X0 \in decomp (F i)) mu X0); last first. - by apply: eq_esum => /= k _; rewrite fsbig_finite//; exact: decomp_finite_set. -rewrite -(eq_esum (fun _ _ => esum_fset _ _))//; last first. - by move=> ? _; exact: decomp_finite_set. -rewrite esum_esum//= (reindex_esum K setT f) => //=. -by apply: eq_esum => i Ki; rewrite /g funK ?inE. -Qed. - -End Rmu_ext. - -Lemma measurable_Rmu_extE d (R : realType) (T : semiRingOfSetsType d) - (mu : {measure set T -> \bar R}) X : - d.-ring.-measurable X -> mu^* X = SetRing.measure mu X. -Proof. by move=> Xm/=; rewrite -Rmu_ext/= measurable_mu_extE. Qed. - -Section measure_extension. -Context d (T : semiRingOfSetsType d) (R : realType). -Variable mu : {measure set T -> \bar R}. -Let Rmu := SetRing.measure mu. -Notation rT := (SetRing.type T). - -Lemma sub_caratheodory : - (d.-measurable).-sigma.-measurable `<=` mu^*.-cara.-measurable. -Proof. -suff: <> `<=` mu^*.-cara.-measurable. - by apply: subset_trans; apply: sub_smallest2r => //; exact: sub_smallest. -apply: smallest_sub. - split => //; [by move=> X mX; rewrite setTD; exact: measurableC | - by move=> u_ mu_; exact: bigcupT_measurable]. -move=> A mA; apply le_caratheodory_measurable => // X. -apply lb_ereal_inf => _ [B [mB XB] <-]. -rewrite -(eq_eseriesr (fun _ _ => SetRing.RmuE _ (mB _))) => //. -have RmB i : measurable (B i : set rT) by exact: sub_gen_smallest. -set BA := eseries (fun n => Rmu (B n `&` A)). -set BNA := eseries (fun n => Rmu (B n `&` ~` A)). -apply: (@le_trans _ _ (limn BA + limn BNA)); [apply: leeD|]. - - rewrite (_ : BA = eseries (fun n => mu_ext mu (B n `&` A))); last first. - rewrite funeqE => n; apply: eq_bigr => k _. - by rewrite /= measurable_Rmu_extE //; exact: measurableI. - apply: (@le_trans _ _ (mu_ext mu (\bigcup_k (B k `&` A)))). - by apply: le_mu_ext; rewrite -setI_bigcupl; exact: setISS. - exact: outer_measure_sigma_subadditive. - - rewrite (_ : BNA = eseries (fun n => mu_ext mu (B n `\` A))); last first. - rewrite funeqE => n; apply: eq_bigr => k _. - by rewrite /= measurable_Rmu_extE //; exact: measurableD. - apply: (@le_trans _ _ (mu_ext mu (\bigcup_k (B k `\` A)))). - by apply: le_mu_ext; rewrite -setI_bigcupl; exact: setISS. - exact: outer_measure_sigma_subadditive. -have cBNA : cvg (BNA @ \oo) by exact: is_cvg_nneseries. -have cBA : cvg (BA @ \oo) by exact: is_cvg_nneseries. -have cB : cvg (eseries (Rmu \o B) @ \oo) by exact: is_cvg_nneseries. -have [def|] := boolP (lim (BA @ \oo) +? lim (BNA @ \oo)); last first. - rewrite /adde_def negb_and !negbK=> /orP[/andP[BAoo BNAoo]|/andP[BAoo BNAoo]]. - - suff -> : limn (eseries (Rmu \o B)) = +oo by rewrite leey. - apply/eqP; rewrite -leye_eq -(eqP BAoo); apply/(lee_lim cBA cB). - near=> n; apply: lee_sum => m _; apply: le_measure; rewrite /mkset; by - [rewrite inE; exact: measurableI | rewrite inE | apply: subIset; left]. - - suff -> : limn (eseries (Rmu \o B)) = +oo by rewrite leey. - apply/eqP; rewrite -leye_eq -(eqP BNAoo); apply/(lee_lim cBNA cB). - by near=> n; apply: lee_sum => m _; rewrite -setDE; apply: le_measure; - rewrite /mkset ?inE//; apply: measurableD. -rewrite -(limeD cBA cBNA) // (_ : (fun _ => _) = - eseries (fun k => Rmu (B k `&` A) + Rmu (B k `&` ~` A))); last first. - by rewrite funeqE => n; rewrite -big_split /=; exact: eq_bigr. -apply/lee_lim => //. - by apply/is_cvg_nneseries => // n *; exact: adde_ge0. -near=> n; apply: lee_sum => i _; rewrite -measure_semi_additive2. -- apply: le_measure; rewrite /mkset ?inE//; [|by rewrite -setIUr setUCr setIT]. - by apply: measurableU; [exact:measurableI|rewrite -setDE; exact:measurableD]. -- exact: measurableI. -- by rewrite -setDE; exact: measurableD. -- by apply: measurableU; [exact:measurableI|rewrite -setDE; exact:measurableD]. -- by rewrite setIACA setICr setI0. -Unshelve. all: by end_near. Qed. - -Let I : measurableType _ := g_sigma_algebraType (@measurable _ T). - -Definition measure_extension : set I -> \bar R := mu^*. - -Local Lemma measure_extension0 : measure_extension set0 = 0. -Proof. exact: mu_ext0. Qed. - -Local Lemma measure_extension_ge0 (A : set I) : 0 <= measure_extension A. -Proof. exact: mu_ext_ge0. Qed. - -Local Lemma measure_extension_semi_sigma_additive : - semi_sigma_additive measure_extension. -Proof. -move=> F mF tF mUF; rewrite /measure_extension. -apply: caratheodory_measure_sigma_additive => //; last exact: sub_caratheodory. -by move=> i; exact: (sub_caratheodory (mF i)). -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ measure_extension - measure_extension0 measure_extension_ge0 - measure_extension_semi_sigma_additive. - -Lemma measure_extension_sigma_finite : @sigma_finite _ T _ setT mu -> - @sigma_finite _ _ _ setT measure_extension. -Proof. -move=> -[S setTS mS]; exists S => //; move=> i; split. - by have := (mS i).1; exact: sub_sigma_algebra. -by rewrite /measure_extension /= measurable_mu_extE //; - [exact: (mS i).2 | exact: (mS i).1]. -Qed. - -Lemma measure_extension_unique : sigma_finite [set: T] mu -> - (forall mu' : {measure set I -> \bar R}, - (forall X, d.-measurable X -> mu X = mu' X) -> - (forall X, (d.-measurable).-sigma.-measurable X -> - measure_extension X = mu' X)). -Proof. -move=> [F TF /all_and2[Fm muF]] mu' mu'mu X mX. -apply: (@measure_unique _ _ I d.-measurable F) => //. -- by move=> A B Am Bm; apply: measurableI. -- by move=> A Am; rewrite /= /measure_extension measurable_mu_extE// mu'mu. -- by move=> k; rewrite /= /measure_extension measurable_mu_extE. -Qed. - -End measure_extension. - -Lemma caratheodory_measurable_mu_ext d (R : realType) (T : semiRingOfSetsType d) - (mu : {measure set T -> \bar R}) A : - d.-measurable A -> mu^*.-cara.-measurable A. -Proof. -by move=> Am; apply: sub_caratheodory => //; apply: sub_sigma_algebra. -Qed. - -Section completed_measure_extension. -Local Open Scope ereal_scope. -Context d (T : semiRingOfSetsType d) (R : realType). -Variable mu : {measure set T -> \bar R}. -Notation rT := (SetRing.type T). -Let Rmu : set rT -> \bar R := SetRing.measure mu. - -Let I : measurableType _ := caratheodory_type (mu^*)%mu. - -Definition completed_measure_extension : set I -> \bar R := (mu^*)%mu. - -Let measure0 : completed_measure_extension set0 = 0. -Proof. exact: mu_ext0. Qed. - -Let measure_ge0 (A : set I) : 0 <= completed_measure_extension A. -Proof. exact: mu_ext_ge0. Qed. - -Let measure_semi_sigma_additive : - semi_sigma_additive completed_measure_extension. -Proof. -move=> F mF tF mUF; rewrite /completed_measure_extension. -exact: caratheodory_measure_sigma_additive. -Qed. - -HB.instance Definition _ := isMeasure.Build _ _ _ completed_measure_extension - measure0 measure_ge0 measure_semi_sigma_additive. - -Lemma completed_measure_extension_sigma_finite : @sigma_finite _ T _ setT mu -> - @sigma_finite _ _ _ setT completed_measure_extension. -Proof. -move=> -[S setTS mS]; exists S => //; move=> i; split. -- apply: sub_caratheodory; apply: sub_sigma_algebra. - exact: (mS i).1. -- by rewrite /completed_measure_extension /= measurable_mu_extE //; - [exact: (mS i).2 | exact: (mS i).1]. -Qed. - -End completed_measure_extension. - -Definition g_sigma_preimageU d1 d2 - (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2) (T : Type) - (f1 : T -> T1) (f2 : T -> T2) := - <>. -#[deprecated(since="mathcomp-analysis 1.9.0", - note="renamed to `g_sigma_preimageU`")] -Notation preimage_classes := g_sigma_preimageU (only parsing). - -Section product_lemma. -Context d1 d2 (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2). -Variables (T : pointedType) (f1 : T -> T1) (f2 : T -> T2). -Variables (T3 : Type) (g : T3 -> T). - -Lemma g_sigma_preimageU_comp : g_sigma_preimageU (f1 \o g) (f2 \o g) = - preimage_set_system setT g (g_sigma_preimageU f1 f2). -Proof. -rewrite {1}/g_sigma_preimageU -g_sigma_preimageE; congr (<>). -rewrite predeqE => C; split. -- move=> [[A mA <-{C}]|[A mA <-{C}]]. - + by exists (f1 @^-1` A) => //; left; exists A => //; rewrite setTI. - + by exists (f2 @^-1` A) => //; right; exists A => //; rewrite setTI. -- move=> [A [[B mB <-{A} <-{C}]|[B mB <-{A} <-{C}]]]. - + by left; rewrite !setTI; exists B => //; rewrite setTI. - + by right; rewrite !setTI; exists B => //; rewrite setTI. -Qed. - -End product_lemma. -#[deprecated(since="mathcomp-analysis 1.9.0", - note="renamed to `g_sigma_preimageU_comp`")] -Notation preimage_classes_comp := g_sigma_preimageU_comp (only parsing). - -Definition measure_prod_display : - (measure_display * measure_display) -> measure_display. -Proof. exact. Qed. - -Section product_salgebra_instance. -Context d1 d2 (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2). -Let f1 := @fst T1 T2. -Let f2 := @snd T1 T2. - -Let prod_salgebra_set0 : g_sigma_preimageU f1 f2 (set0 : set (T1 * T2)). -Proof. exact: sigma_algebra0. Qed. - -Let prod_salgebra_setC A : g_sigma_preimageU f1 f2 A -> - g_sigma_preimageU f1 f2 (~` A). -Proof. exact: sigma_algebraC. Qed. - -Let prod_salgebra_bigcup (F : _^nat) : - (forall i, g_sigma_preimageU f1 f2 (F i)) -> - g_sigma_preimageU f1 f2 (\bigcup_i (F i)). -Proof. exact: sigma_algebra_bigcup. Qed. - -HB.instance Definition _ := Pointed.on (T1 * T2)%type. -HB.instance Definition prod_salgebra_mixin := - @isMeasurable.Build (measure_prod_display (d1, d2)) - (T1 * T2)%type (g_sigma_preimageU f1 f2) - (prod_salgebra_set0) (prod_salgebra_setC) (prod_salgebra_bigcup). - -End product_salgebra_instance. -Notation "p .-prod" := (measure_prod_display p) : measure_display_scope. -Notation "p .-prod.-measurable" := - ((p.-prod).-measurable : set (set (_ * _))) : - classical_set_scope. - -Lemma measurableX d1 d2 (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2) - (A : set T1) (B : set T2) : - measurable A -> measurable B -> measurable (A `*` B). -Proof. -move=> mA mB. -have -> : A `*` B = (A `*` setT) `&` (setT `*` B) :> set (T1 * T2). - by rewrite -{1}(setIT A) -{1}(setTI B) setXI. -rewrite setXT setTX; apply: measurableI. -- by apply: sub_sigma_algebra; left; exists A => //; rewrite setTI. -- by apply: sub_sigma_algebra; right; exists B => //; rewrite setTI. -Qed. -#[deprecated(since="mathcomp-analysis 1.3.0", note="renamed `measurableX`")] -Notation measurableM := measurableX (only parsing). - -Section product_salgebra_algebraOfSetsType. -Context d1 d2 (T1 : algebraOfSetsType d1) (T2 : algebraOfSetsType d2). -Let M1 := @measurable _ T1. -Let M2 := @measurable _ T2. -Let M1xM2 := [set A `*` B | A in M1 & B in M2]. - -Lemma measurable_prod_measurableType : - (d1, d2).-prod.-measurable = <>. -Proof. -rewrite eqEsubset; split. - apply: smallest_sub; first exact: smallest_sigma_algebra. - rewrite subUset; split. - - have /subset_trans : preimage_set_system setT fst M1 `<=` M1xM2. - by move=> _ [X MX <-]; exists X=> //; exists setT; rewrite /M2 // setIC//. - by apply; exact: sub_sigma_algebra. - - have /subset_trans : preimage_set_system setT snd M2 `<=` M1xM2. - by move=> _ [Y MY <-]; exists setT; rewrite /M1 //; exists Y. - by apply; exact: sub_sigma_algebra. -apply: smallest_sub; first exact: smallest_sigma_algebra. -by move=> _ [A ?] [B ?] <-; apply: measurableX => //; exact: sub_sigma_algebra. -Qed. - -End product_salgebra_algebraOfSetsType. - -Section product_salgebra_g_measurableTypeR. -Context d1 (T1 : algebraOfSetsType d1) (T2 : pointedType) (C2 : set (set T2)). -Hypothesis setTC2 : setT `<=` C2. - -(* NB: useful? *) -Lemma measurable_prod_g_measurableTypeR : - @measurable _ (T1 * g_sigma_algebraType C2)%type - = <>. -Proof. -rewrite measurable_prod_measurableType //; congr (<>). -rewrite predeqE => X; split=> [[A mA] [B mB] <-{X}|[A C1A] [B C2B] <-{X}]. - by exists A => //; exists B => //; exact: setTC2. -by exists A => //; exists B => //; exact: sub_sigma_algebra. -Qed. - -End product_salgebra_g_measurableTypeR. - -Section product_salgebra_g_measurableType. -Variables (T1 T2 : pointedType) (C1 : set (set T1)) (C2 : set (set T2)). -Hypotheses (setTC1 : setT `<=` C1) (setTC2 : setT `<=` C2). - -Lemma measurable_prod_g_measurableType : - @measurable _ (g_sigma_algebraType C1 * g_sigma_algebraType C2)%type = - <>. -Proof. -rewrite measurable_prod_measurableType //; congr (<>). -rewrite predeqE => X; split=> [[A mA] [B mB] <-{X}|[A C1A] [B C2B] <-{X}]. - by exists A; [exact: setTC1|exists B => //; exact: setTC2]. -by exists A; [exact: sub_sigma_algebra|exists B => //; exact: sub_sigma_algebra]. -Qed. - -End product_salgebra_g_measurableType. - -Section prod_measurable_fun. -Context d d1 d2 (T : measurableType d) (T1 : measurableType d1) - (T2 : measurableType d2). - -Lemma measurable_fun_pairP (h : T -> T1 * T2) : measurable_fun setT h <-> - measurable_fun setT (fst \o h) /\ measurable_fun setT (snd \o h). -Proof. -apply: (@iff_trans _ (g_sigma_preimageU (fst \o h) (snd \o h) `<=` measurable)). -- rewrite g_sigma_preimageU_comp; split=> [mf A [C HC <-]|f12]; first exact: mf. - by move=> _ A mA; apply: f12; exists A. -- split => [h12|[mf1 mf2]]. - split => _ A mA; apply: h12; apply: sub_sigma_algebra; - by [left; exists A|right; exists A]. - apply: smallest_sub; first exact: sigma_algebra_measurable. - by rewrite subUset; split=> [|] A [C mC <-]; [exact: mf1|exact: mf2]. -Qed. - -Lemma measurable_fun_pair (f : T -> T1) (g : T -> T2) : - measurable_fun setT f -> measurable_fun setT g -> - measurable_fun setT (fun x => (f x, g x)). -Proof. by move=> mf mg; exact/measurable_fun_pairP. Qed. - -End prod_measurable_fun. -#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `measurable_fun_pair`")] -Notation measurable_fun_prod := measurable_fun_pair (only parsing). -#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `measurable_fun_pairP`")] -Notation prod_measurable_funP := measurable_fun_pairP (only parsing). - -Section prod_measurable_proj. -Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2). - -Lemma measurable_fst : measurable_fun [set: T1 * T2] fst. -Proof. -by have /measurable_fun_pairP[] := @measurable_id _ (T1 * T2)%type setT. -Qed. -#[local] Hint Resolve measurable_fst : core. - -Lemma measurable_snd : measurable_fun [set: T1 * T2] snd. -Proof. -by have /measurable_fun_pairP[] := @measurable_id _ (T1 * T2)%type setT. -Qed. -#[local] Hint Resolve measurable_snd : core. - -Lemma measurable_swap : measurable_fun [set: _] (@swap T1 T2). -Proof. exact: measurable_fun_pair. Qed. - -End prod_measurable_proj. -Arguments measurable_fst {d1 d2 T1 T2}. -Arguments measurable_snd {d1 d2 T1 T2}. -#[global] Hint Extern 0 (measurable_fun _ fst) => - solve [apply: measurable_fst] : core. -#[global] Hint Extern 0 (measurable_fun _ snd) => - solve [apply: measurable_snd] : core. - -Definition g_sigma_preimage d (rT : semiRingOfSetsType d) (aT : Type) - (n : nat) (f : 'I_n -> aT -> rT) : set (set aT) := - <>. - -Lemma g_sigma_preimage_comp d1 {T1 : semiRingOfSetsType d1} n - {T : pointedType} (f : 'I_n -> T -> T1) {T2 : Type} (g : T2 -> T) : - g_sigma_preimage (fun i => f i \o g) = - preimage_set_system [set: T2] g (g_sigma_preimage f). -Proof. -rewrite -[RHS]g_sigma_preimageE; congr (<>). -case: n => [|n] in f *; first by rewrite !big_ord0 preimage_set_system0. -rewrite predeqE => B; split. -- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{B}]]. - have iE : Ordinal Ii = inord i by apply/val_inj => /=; rewrite inordK. - exists (f (inord i) @^-1` A) => //. - rewrite -bigcup_mkord_ord; exists i => //. - by exists A => //; rewrite -iE setTI. -- move=> [C]. - rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]] <-{B}. - rewrite -bigcup_mkord_ord; exists i => //. - by exists A => //; rewrite !setTI -comp_preimage. -Qed. - -Definition measure_tuple_display : measure_display -> measure_display. -Proof. exact. Qed. - -Section measurable_tuple. -Context {d} {T : sigmaRingType d}. -Variable n : nat. - -Let coors : 'I_n -> n.-tuple T -> T := fun i x => @tnth n T x i. - -Let tuple_set0 : g_sigma_preimage coors set0. -Proof. exact: sigma_algebra0. Qed. - -Let tuple_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). -Proof. exact: sigma_algebraC. Qed. - -Let tuple_bigcup (F : _^nat) : (forall i, g_sigma_preimage coors (F i)) -> - g_sigma_preimage coors (\bigcup_i (F i)). -Proof. exact: sigma_algebra_bigcup. Qed. - -HB.instance Definition _ := @isMeasurable.Build (measure_tuple_display d) - (n.-tuple T) (g_sigma_preimage coors) tuple_set0 tuple_setC tuple_bigcup. - -End measurable_tuple. - -Lemma measurable_tnth d (T : sigmaRingType d) n (i : 'I_n) : - measurable_fun [set: n.-tuple T] (@tnth _ T ^~ i). -Proof. -move=> _ Y mY; rewrite setTI; apply: sub_sigma_algebra => /=. -rewrite -bigcup_seq/=; exists i => /=; first by rewrite mem_index_enum. -by exists Y => //; rewrite setTI. -Qed. - -Section measurable_cons. -Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2). - -Lemma measurable_fun_tnthP n (f : T1 -> n.-tuple T2) : - measurable_fun [set: T1] f <-> - forall i, measurable_fun [set: T1] (@tnth n T2 ^~ i \o f). -Proof. -apply: (@iff_trans _ (g_sigma_preimage - (fun i => @tnth n T2 ^~ i \o f) `<=` measurable)). - rewrite g_sigma_preimage_comp; split=> [mf A [/= C preC <-]|prefS]. - exact: mf. - by move=> _ A mA; apply: prefS; exists A. -split=> [tnthfS i|mf]. -- move=> _ A mA. - apply: tnthfS; apply: sub_sigma_algebra. - case: n i => [[] []//|n i] in f *. - rewrite -bigcup_mkord_ord. - exists i; first exact: ltn_ord. - by exists A => //; rewrite inord_val. -- apply: smallest_sub; first exact: sigma_algebra_measurable. - case: n => [|n] in f mf *; first by rewrite big_ord0. - rewrite -bigcup_mkord_ord; apply: bigcup_sub => i Ii. - by move=> A [B mB <-]; exact: mf. -Qed. - -Lemma measurable_cons (f : T1 -> T2) n (g : T1 -> n.-tuple T2) : - measurable_fun [set: T1] f -> measurable_fun [set: T1] g -> - measurable_fun [set: T1] (fun x => [the n.+1.-tuple T2 of f x :: g x]). -Proof. -move=> mf mg; apply/measurable_fun_tnthP => /= i. -have [->//|i0] := eqVneq i ord0. -have i1n : (i.-1 < n)%N by rewrite prednK ?lt0n// -ltnS. -pose j := Ordinal i1n. -rewrite (_ : _ \o _ = fun x => tnth (g x) j)//. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x j)) => //=. - exact: measurable_tnth. -apply/funext => x /=. -rewrite (_ : i = lift ord0 j) ?tnthS//. -by apply/val_inj => /=; rewrite /bump/= add1n prednK// lt0n. -Qed. - -End measurable_cons. - -Lemma measurable_behead d (T : measurableType d) n : - measurable_fun [set: n.+1.-tuple T] (fun x => [tuple of behead x]). -Proof. -move=> _ Y mY; rewrite setTI. -set f := fun x : (n.+1).-tuple T => [tuple of behead x] : n.-tuple T. -move: mY; rewrite /measurable/= => + F [] sF. -pose F' := image_set_system setT f F. -move=> /(_ F') /=. -have -> : F' Y = F (f @^-1` Y) by rewrite /F' /image_set_system /= setTI. -move=> /[swap] bigF; apply; split; first exact: sigma_algebra_image. -move=> A; rewrite /= {}/F' /image_set_system /= setTI. -set bign := (X in X A -> _) => bignA. -apply: bigF; rewrite big_ord_recl /=; right. -set bign1 := (X in X (_ @^-1` _)). -have -> : bign1 = preimage_set_system [set: n.+1.-tuple T] f bign. - rewrite (big_morph _ (preimage_set_systemU _ _) (preimage_set_system0 _ _)). - apply: eq_bigr => i _; rewrite -preimage_set_system_comp. - congr preimage_set_system. - by apply: funext=> t/=; rewrite [in LHS](tuple_eta t) tnthS. -by exists A => //; rewrite setTI. -Qed. - -Lemma measurable_fun_if_pair d d' (X : measurableType d) - (Y : measurableType d') (x y : X -> Y) : - measurable_fun setT x -> measurable_fun setT y -> - measurable_fun setT (fun tb => if tb.2 then x tb.1 else y tb.1). -Proof. -by move=> mx my; apply: measurable_fun_ifT => //=; exact: measurableT_comp. -Qed. - -Section partial_measurable_fun. -Context d d1 d2 (T : measurableType d) (T1 : measurableType d1) - (T2 : measurableType d2). -Variable f : T1 * T2 -> T. - -Lemma pair1_measurable (x : T1) : measurable_fun [set: T2] (pair x). -Proof. -have m1pairx : measurable_fun [set: T2] (fst \o pair x) by exact/measurable_cst. -have m2pairx : measurable_fun [set: T2] (snd \o pair x) by exact/measurable_id. -exact/measurable_fun_pairP. -Qed. - -Lemma pair2_measurable (y : T2) : measurable_fun [set: T1] (pair^~ y). -Proof. -have m1pairy : measurable_fun [set: T1] (fst \o pair^~y) by exact/measurable_id. -have m2pairy : measurable_fun [set: T1] (snd \o pair^~y) by exact/measurable_cst. -exact/measurable_fun_pairP. -Qed. - -End partial_measurable_fun. -#[global] Hint Extern 0 (measurable_fun _ (pair _)) => - solve [apply: pair1_measurable] : core. -#[global] Hint Extern 0 (measurable_fun _ (pair^~ _)) => - solve [apply: pair2_measurable] : core. -#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `pair1_measurable`")] -Notation measurable_pair1 := pair1_measurable (only parsing). -#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `pair2_measurable`")] -Notation measurable_pair2 := pair2_measurable (only parsing). - -(* [Lemma 14.13, Klenke 2014] *) -Section measurable_section. -Context d1 d2 d3 (T1 : measurableType d1) (T2 : measurableType d2) - (T3 : measurableType d3). - -Lemma measurable_xsection (A : set (T1 * T2)) (x : T1) : - measurable A -> measurable (xsection A x). -Proof. -move=> mA; pose i (y : T2) := (x, y). -have mi : measurable_fun setT i by exact: pair1_measurable. -by rewrite xsectionE -[X in measurable X]setTI; exact: mi. -Qed. - -Lemma measurable_ysection (A : set (T1 * T2)) (y : T2) : - measurable A -> measurable (ysection A y). -Proof. -move=> mA; pose i (x : T1) := (x, y). -have mi : measurable_fun setT i by exact: pair2_measurable. -by rewrite ysectionE -[X in measurable X]setTI; exact: mi. -Qed. - -Lemma measurable_fun_pair1 (f : T1 * T2 -> T3) (y : T2) : - measurable_fun setT f -> measurable_fun setT (fun x => f (x, y)). -Proof. by move=> mf; exact: measurableT_comp. Qed. - -Lemma measurable_fun_pair2 (f : T1 * T2 -> T3) (x : T1) : - measurable_fun setT f -> measurable_fun setT (fun y => f (x, y)). -Proof. by move=> mf; exact: measurableT_comp. Qed. - -End measurable_section. - -Section absolute_continuity. -Context d (T : semiRingOfSetsType d) (R : realType). -Implicit Types m : set T -> \bar R. - -Definition measure_dominates m1 m2 := - forall A, measurable A -> m2 A = 0 -> m1 A = 0. - -Local Notation "m1 `<< m2" := (measure_dominates m1 m2). - -Lemma measure_dominates_trans m1 m2 m3 : m1 `<< m2 -> m2 `<< m3 -> m1 `<< m3. -Proof. by move=> m12 m23 A mA /m23-/(_ mA) /m12; exact. Qed. - -End absolute_continuity. -Notation "m1 `<< m2" := (measure_dominates m1 m2). - -Section absolute_continuity_lemmas. -Context d (T : measurableType d) (R : realType) (U : Type). -Implicit Types (m : {measure set T -> \bar R}) (f g : T -> U). - -Lemma measure_dominates_ae_eq m1 m2 f g E : measurable E -> - m2 `<< m1 -> ae_eq m1 E f g -> ae_eq m2 E f g. -Proof. by move=> mE m21 [A [mA A0 ?]]; exists A; split => //; exact: m21. Qed. - -End absolute_continuity_lemmas. diff --git a/theories/measure_theory/counting_measure.v b/theories/measure_theory/counting_measure.v new file mode 100644 index 0000000000..4c3fd50910 --- /dev/null +++ b/theories/measure_theory/counting_measure.v @@ -0,0 +1,110 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure measure_function. + +(**md**************************************************************************) +(* # The Counting Measure *) +(* *) +(* ``` *) +(* counting T R == counting measure *) +(* ``` *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Definition counting (T : choiceType) (R : realType) (X : set T) : \bar R := + if `[< finite_set X >] then (#|` fset_set X |)%:R%:E else +oo%E. +Arguments counting {T R}. + +Section measure_count. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realType). +Variables (D : set T) (mD : measurable D). + +Local Notation counting := (@counting T R). + +Let counting0 : counting set0 = 0. +Proof. by rewrite /counting asboolT// fset_set0. Qed. + +Let counting_ge0 (A : set T) : 0 <= counting A. +Proof. by rewrite /counting; case: ifPn; rewrite ?lee_fin// lee_pinfty. Qed. + +Let counting_sigma_additive : semi_sigma_additive counting. +Proof. +move=> F mF tF mU. +have [[i Fi]|infinF] := pselect (exists k, infinite_set (F k)). + have -> : counting (\bigcup_n F n) = +oo. + rewrite /counting asboolF//. + by apply: contra_not Fi; exact/sub_finite_set/bigcup_sup. + apply/cvgeyPge => M; near=> n. + have ni : (i < n)%N by near: n; exists i.+1. + rewrite (bigID (xpred1 i))/= big_mkord (big_pred1 (Ordinal ni))//=. + rewrite [X in X + _]/(counting _) asboolF// addye ?leey//. + by rewrite gt_eqF// (@lt_le_trans _ _ 0)//; exact: sume_ge0. +have {infinF}finF : forall i, finite_set (F i) by exact/not_forallP. +pose u : nat^nat := fun n => #|` fset_set (F n) |. +have sumFE n : \sum_(i < n) counting (F i) = + #|` fset_set (\big[setU/set0]_(k < n) F k) |%:R%:E. + rewrite -trivIset_sum_card// natr_sum -sumEFin. + by apply: eq_bigr => // i _; rewrite /counting asboolT. +have [cvg_u|dvg_u] := pselect (cvg (nseries u @ \oo)). + have [N _ Nu] : \forall n \near \oo, u n = 0%N by apply: cvg_nseries_near. + rewrite [X in _ --> X](_ : _ = \sum_(i < N) counting (F i)); last first. + have -> : \bigcup_i (F i) = \big[setU/set0]_(i < N) F i. + rewrite (bigcupID (`I_N)) setTI bigcup_mkord. + rewrite [X in _ `|` X](_ : _ = set0) ?setU0// bigcup0// => i [_ /negP]. + by rewrite -leqNgt => /Nu/eqP/[!cardfs_eq0]/eqP/fset_set_set0 ->. + by rewrite /counting /= asboolT ?sumFE// -bigcup_mkord; exact: bigcup_finite. + rewrite -(cvg_shiftn N)/=. + rewrite (_ : (fun n => _) = (fun=> \sum_(i < N) counting (F i))). + exact: cvg_cst. + apply/funext => n; rewrite /index_iota subn0 (addnC n) iotaD big_cat/=. + rewrite [X in _ + X](_ : _ = 0) ?adde0. + by rewrite -{1}(subn0 N) big_mkord. + rewrite add0n big_seq big1// => i /[!mem_iota] => /andP[NI iNn]. + by rewrite /counting asboolT//= -/(u _) Nu. +have {dvg_u}cvg_F : (fun n => \sum_(i < n) counting (F i)) @ \oo --> +oo. + rewrite (_ : (fun n => _) = [sequence (\sum_(0 <= i < n) (u i))%:R%:E]_n). + exact/cvgenyP/dvg_nseries. + apply/funext => n /=; under eq_bigr. + by rewrite /counting => i _; rewrite asboolT//; over. + by rewrite sumEFin natr_sum big_mkord. +have [UFoo|/contrapT[k UFk]] := pselect (infinite_set (\bigcup_n F n)). + rewrite /counting asboolF//. + by under eq_fun do rewrite big_mkord. +suff: false by []. +move: cvg_F =>/cvgeyPge/(_ k.+1%:R) [K _] /(_ K (leqnn _)) /=; apply: contra_leT => _. +rewrite sumFE lte_fin ltr_nat ltnS. +have -> : k = #|` fset_set (\bigcup_n F n) |. + by apply/esym/card_eq_fsetP; rewrite fset_setK//; exists k. +apply/fsubset_leq_card; rewrite -fset_set_sub //. +- by move=> /= t; rewrite -bigcup_mkord => -[m _ Fmt]; exists m. +- by rewrite -bigcup_mkord; exact: bigcup_finite. +- by exists k. +Unshelve. all: by end_near. Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ counting + counting0 counting_ge0 counting_sigma_additive. + +End measure_count. + +Lemma sigma_finite_counting (R : realType) : + sigma_finite [set: nat] (@counting _ R). +Proof. +exists (fun n => `I_n.+1); first by apply/seteqP; split=> //x _; exists x => /=. +by move=> k; split => //; rewrite /counting/= asboolT// ltry. +Qed. +HB.instance Definition _ R := + @isSigmaFinite.Build _ _ _ (@counting _ R) (sigma_finite_counting R). diff --git a/theories/measure_theory/dirac_measure.v b/theories/measure_theory/dirac_measure.v new file mode 100644 index 0000000000..b520dbdb4d --- /dev/null +++ b/theories/measure_theory/dirac_measure.v @@ -0,0 +1,114 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure measure_function. + +(**md**************************************************************************) +(* # The Dirac Measure *) +(* *) +(* ``` *) +(* \d_a == Dirac measure *) +(* ``` *) +(* *) +(******************************************************************************) + +Reserved Notation "'\d_' a" (at level 8, a at level 2, format "'\d_' a"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Section dirac_measure. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (a : T) (R : realFieldType). + +Definition dirac (A : set T) : \bar R := (\1_A a)%:E. + +Let dirac0 : dirac set0 = 0. Proof. by rewrite /dirac indic0. Qed. + +Let dirac_ge0 B : 0 <= dirac B. Proof. by rewrite /dirac indicE. Qed. + +Let dirac_sigma_additive : semi_sigma_additive dirac. +Proof. +move=> F mF tF mUF; rewrite /dirac indicE; have [|aFn] /= := boolP (a \in _). + rewrite inE => -[n _ Fna]. + have naF m : m != n -> a \notin F m. + move=> mn; rewrite notin_setE => Fma. + move/trivIsetP : tF => /(_ _ _ Logic.I Logic.I mn). + by rewrite predeqE => /(_ a)[+ _]; exact. + apply/cvg_ballP => _/posnumP[e]; near=> m. + have mn : (n < m)%N by near: m; exists n.+1. + rewrite big_mkord (bigID (xpred1 (Ordinal mn)))//= big_pred1_eq/= big1/=. + by rewrite adde0 indicE mem_set//; exact: ballxx. + by move=> j ij; rewrite indicE (negbTE (naF _ _)). +rewrite [X in X @ \oo --> _](_ : _ = cst 0); first exact: cvg_cst. +apply/funext => n; rewrite big1// => i _; rewrite indicE; apply/eqP. +by rewrite eqe pnatr_eq0 eqb0; apply: contra aFn => /[!inE] aFn; exists i. +Unshelve. all: by end_near. Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ + dirac dirac0 dirac_ge0 dirac_sigma_additive. + +End dirac_measure. +Arguments dirac {d T} _ {R}. + +Notation "\d_ a" := (dirac a) : ring_scope. + +Section dirac_lemmas_realFieldType. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realFieldType). + +Lemma diracE a (A : set T) : \d_a A = (a \in A)%:R%:E :> \bar R. +Proof. by rewrite /dirac indicE. Qed. + +Lemma dirac0 (a : T) : \d_a set0 = 0 :> \bar R. +Proof. by rewrite diracE in_set0. Qed. + +Lemma diracT (a : T) : \d_a setT = 1 :> \bar R. +Proof. by rewrite diracE in_setT. Qed. + +End dirac_lemmas_realFieldType. + +Section dirac_lemmas. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realType). + +Lemma finite_card_sum (A : set T) : finite_set A -> + \esum_(i in A) 1 = (#|` fset_set A|%:R)%:E :> \bar R. +Proof. +move=> finA; rewrite esum_fset// (eq_fsbigr (cst 1))//. +by rewrite card_fset_sum1// natr_sum -sumEFin fsbig_finite. +Qed. + +Lemma finite_card_dirac (A : set T) : finite_set A -> + \esum_(i in A) \d_ i A = (#|` fset_set A|%:R)%:E :> \bar R. +Proof. +move=> finA; rewrite esum_fset// (eq_fsbigr (cst 1))//. + by rewrite card_fset_sum1// natr_sum -sumEFin fsbig_finite. +by move=> i iA; rewrite diracE iA. +Qed. + +Lemma infinite_card_dirac (A : set T) : infinite_set A -> + \esum_(i in A) \d_ i A = +oo :> \bar R. +Proof. +move=> infA; apply/eqyP => r r0. +have [B BA Br] := infinite_set_fset (trunc r).+1 infA. +apply: esum_ge; exists [set` B] => //. +apply: (@le_trans _ _ (trunc r).+1%:R%:E). + by rewrite lee_fin ltW// truncnS_gt. +move: Br; rewrite -(@ler_nat R) -lee_fin => /le_trans; apply. +rewrite (eq_fsbigr (cst 1))/=; last first. + by move=> i /[!inE] /BA /mem_set iA; rewrite diracE iA. +by rewrite fsbig_finite//= card_fset_sum1 sumEFin natr_sum// set_fsetK. +Qed. + +End dirac_lemmas. diff --git a/theories/measure_theory/measurable_function.v b/theories/measure_theory/measurable_function.v new file mode 100644 index 0000000000..c43a271cbf --- /dev/null +++ b/theories/measure_theory/measurable_function.v @@ -0,0 +1,559 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure. + +(**md**************************************************************************) +(* # Measurable Functions *) +(* *) +(* ``` *) +(* measurable_fun D f == the function f with domain D is measurable *) +(* {mfun aT >-> rT} == type of measurable functions *) +(* aT and rT are sigmaRingType's. *) +(* f \in mfun == holds for f : {mfun _ >-> _} *) +(* ``` *) +(* *) +(******************************************************************************) + +Reserved Notation "{ 'mfun' aT >-> T }" + (at level 0, format "{ 'mfun' aT >-> T }"). +Reserved Notation "[ 'mfun' 'of' f ]" + (at level 0, format "[ 'mfun' 'of' f ]"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Definition measurable_fun d d' (T : sigmaRingType d) (U : sigmaRingType d') + (D : set T) (f : T -> U) := + measurable D -> forall Y, measurable Y -> measurable (D `&` f @^-1` Y). + +HB.mixin Record isMeasurableFun d d' (aT : sigmaRingType d) (rT : sigmaRingType d') + (f : aT -> rT) := { + measurable_funPT : measurable_fun [set: aT] f +}. + +HB.structure Definition MeasurableFun d d' aT rT := + {f of @isMeasurableFun d d' aT rT f}. +Arguments measurable_funPT {d d' aT rT} s. + +Notation "{ 'mfun' aT >-> T }" := (@MeasurableFun.type _ _ aT T) : form_scope. +Notation "[ 'mfun' 'of' f ]" := [the {mfun _ >-> _} of f] : form_scope. +#[global] Hint Extern 0 (measurable_fun [set: _] _) => + solve [apply: measurable_funPT] : core. + +Lemma measurable_funP {d d' : measure_display} + {aT : measurableType d} {rT : sigmaRingType d'} + (D : set aT) (s : {mfun aT >-> rT}) : measurable_fun D s. +Proof. +move=> mD Y mY; apply: measurableI => //. +by rewrite -(setTI (_ @^-1` _)); exact: measurable_funPT. +Qed. +Arguments measurable_funP {d d' aT rT D} s. + +Lemma measurable_funPTI {d d'} {aT : measurableType d} {rT : measurableType d'} + (f : {mfun aT >-> rT}) (Y : set rT) : measurable Y -> measurable (f @^-1` Y). +Proof. by move=> mY; rewrite -[f @^-1` _]setTI; exact: measurable_funP. Qed. + +#[deprecated(since="mathcomp-analysis 1.13.0", note="renamed to `measurable_funPTI`")] +Notation measurable_sfunP := measurable_funPTI (only parsing). + +Section mfun_pred. +Context {d d'} {aT : sigmaRingType d} {rT : sigmaRingType d'}. +Definition mfun : {pred aT -> rT} := mem [set f | measurable_fun setT f]. +Definition mfun_key : pred_key mfun. Proof. exact. Qed. +Canonical mfun_keyed := KeyedPred mfun_key. +End mfun_pred. + +Section measurable_fun. +Context d1 d2 d3 (T1 : sigmaRingType d1) (T2 : sigmaRingType d2) + (T3 : sigmaRingType d3). +Implicit Type D E : set T1. + +Lemma measurable_id D : measurable_fun D id. +Proof. by move=> mD A mA; apply: measurableI. Qed. + +Lemma measurable_comp F (f : T2 -> T3) E (g : T1 -> T2) : + measurable F -> g @` E `<=` F -> + measurable_fun F f -> measurable_fun E g -> measurable_fun E (f \o g). +Proof. +move=> mF FgE mf mg /= mE A mA. +rewrite comp_preimage. +rewrite (_ : _ `&` _ = E `&` g @^-1` (F `&` f @^-1` A)); last first. + apply/seteqP; split=> [|? [?] []//]. + by move=> x/= [Ex Afgx]; split => //; split => //; exact: FgE. +by apply/mg => //; exact: mf. +Qed. + +Lemma eq_measurable_fun D (f g : T1 -> T2) : + {in D, f =1 g} -> measurable_fun D f -> measurable_fun D g. +Proof. +by move=> fg mf mD A mA; rewrite [X in measurable X](_ : _ = D `&` f @^-1` A); + [exact: mf|exact/esym/eq_preimage]. +Qed. + +Lemma measurable_fun_eqP D (f g : T1 -> T2) : + {in D, f =1 g} -> measurable_fun D f <-> measurable_fun D g. +Proof. +by move=> eq_fg; split; apply/eq_measurable_fun => // ? ?; rewrite eq_fg. +Qed. + +Lemma measurable_cst D (r : T2) : measurable_fun D (cst r : T1 -> _). +Proof. +by move=> mD /= Y mY; rewrite preimage_cst; case: ifPn; rewrite ?setIT ?setI0. +Qed. + +Lemma measurable_fun_bigcup (E : (set T1)^nat) (f : T1 -> T2) : + (forall i, measurable (E i)) -> + measurable_fun (\bigcup_i E i) f <-> (forall i, measurable_fun (E i) f). +Proof. +move=> mE; split => [|mf /= _ A mA]; last first. + by rewrite setI_bigcupl; apply: bigcup_measurable => i _; exact: mf. +move=> mf i _ A /mf => /(_ (bigcup_measurable (fun k _ => mE k))). +move=> /(measurableI (E i))-/(_ (mE i)). +by rewrite setICA setIA (@setIidr _ _ (E i))//; exact: bigcup_sup. +Qed. + +Lemma measurable_funU D E (f : T1 -> T2) : measurable D -> measurable E -> + measurable_fun (D `|` E) f <-> measurable_fun D f /\ measurable_fun E f. +Proof. +move=> mD mE; rewrite -bigcup2E; apply: (iff_trans (measurable_fun_bigcup _ _)). + by move=> [//|[//|//=]]. +split=> [mf|[Df Dg] [//|[//|/= _ _ Y mY]]]; last by rewrite set0I. +by split; [exact: (mf 0%N)|exact: (mf 1%N)]. +Qed. + +Lemma measurable_funS E D (f : T1 -> T2) : + measurable E -> D `<=` E -> measurable_fun E f -> + measurable_fun D f. +Proof. +move=> mE DE mf mD; have mC : measurable (E `\` D) by exact: measurableD. +move: (mD). +have := measurable_funU f mD mC. +suff -> : D `|` (E `\` D) = E by move=> [[]] //. +by rewrite setDUK. +Qed. + +Lemma measurable_fun_if (g h : T1 -> T2) D (mD : measurable D) + (f : T1 -> bool) (mf : measurable_fun D f) : + measurable_fun (D `&` (f @^-1` [set true])) g -> + measurable_fun (D `&` (f @^-1` [set false])) h -> + measurable_fun D (fun t => if f t then g t else h t). +Proof. +move=> mx my /= _ B mB; rewrite (_ : _ @^-1` B = + ((f @^-1` [set true]) `&` (g @^-1` B)) `|` + ((f @^-1` [set false]) `&` (h @^-1` B))). + rewrite setIUr; apply: measurableU. + - by rewrite setIA; apply: mx => //; exact: mf. + - by rewrite setIA; apply: my => //; exact: mf. +apply/seteqP; split=> [t /=| t /= [] [] ->//]. +by case: ifPn => ft; [left|right]. +Qed. + +Lemma measurable_fun_set0 (f : T1 -> T2) : measurable_fun set0 f. +Proof. by move=> A B _; rewrite set0I. Qed. + +Lemma measurable_fun_set1 a (f : T1 -> T2) : measurable_fun [set a] f. +Proof. by move=> ? ? ?; rewrite set1I; case: ifP. Qed. + +End measurable_fun. +#[global] Hint Extern 0 (measurable_fun _ (fun=> _)) => + solve [apply: measurable_cst] : core. +#[global] Hint Extern 0 (measurable_fun _ (cst _)) => + solve [apply: measurable_cst] : core. +#[global] Hint Extern 0 (measurable_fun _ id) => + solve [apply: measurable_id] : core. +Arguments eq_measurable_fun {d1 d2 T1 T2 D} f {g}. +Arguments measurable_fun_eqP {d1 d2 T1 T2 D} f {g}. + +Section mfun. +Context {d d'} {aT : sigmaRingType d} {rT : sigmaRingType d'}. +Notation T := {mfun aT >-> rT}. +Notation mfun := (@mfun _ _ aT rT). + +Section Sub. +Context (f : aT -> rT) (fP : f \in mfun). +Definition mfun_Sub_subproof := @isMeasurableFun.Build d _ aT rT f (set_mem fP). +#[local] HB.instance Definition _ := mfun_Sub_subproof. +Definition mfun_Sub := [mfun of f]. +End Sub. + +Lemma mfun_rect (K : T -> Type) : + (forall f (Pf : f \in mfun), K (mfun_Sub Pf)) -> forall u : T, K u. +Proof. +move=> Ksub [f [[Pf]]]/=. +by suff -> : Pf = (set_mem (@mem_set _ [set f | _] f Pf)) by apply: Ksub. +Qed. + +Lemma mfun_valP f (Pf : f \in mfun) : mfun_Sub Pf = f :> (_ -> _). +Proof. by []. Qed. + +HB.instance Definition _ := isSub.Build _ _ T mfun_rect mfun_valP. + +Lemma mfuneqP (f g : {mfun aT >-> rT}) : f = g <-> f =1 g. +Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. + +HB.instance Definition _ := [Choice of {mfun aT >-> rT} by <:]. + +HB.instance Definition _ x := isMeasurableFun.Build d _ aT rT (cst x) + (@measurable_cst _ _ aT rT setT x). + +End mfun. + +Section measurable_fun_measurableType. +Context d1 d2 d3 (T1 : measurableType d1) (T2 : measurableType d2) + (T3 : measurableType d3). +Implicit Type D E : set T1. + +Lemma measurableT_comp (f : T2 -> T3) E (g : T1 -> T2) : + measurable_fun [set: T2] f -> measurable_fun E g -> measurable_fun E (f \o g). +Proof. exact: measurable_comp. Qed. + +Lemma measurable_funTS D (f : T1 -> T2) : + measurable_fun [set: T1] f -> measurable_fun D f. +Proof. exact: measurable_funS. Qed. + +Lemma measurable_restrict D E (f : T1 -> T2) : measurable D -> measurable E -> + measurable_fun (E `&` D) f <-> measurable_fun E (f \_ D). +Proof. +move=> mD mE; split => mf _ /= Y mY. +- rewrite preimage_restrict; case: ifPn => ptX; last first. + by rewrite set0U setIA; apply: mf => //; exact: measurableI. + rewrite setIUr; apply: measurableU. + by apply: measurableI => //; exact: measurableC. + by rewrite setIA; apply: mf => //; exact: measurableI. +- have := mf mE _ mY; rewrite preimage_restrict; case: ifP => ptY; last first. + by rewrite set0U setIA. + rewrite setUIr setvU setTI setIUr => /(measurableI _ _ mD). + by rewrite setIUr setIA setIAC setICr set0I set0U setICA setIA. +Qed. + +Lemma measurable_restrictT D (f : T1 -> T2) : measurable D -> + measurable_fun D f <-> measurable_fun [set: T1] (f \_ D). +Proof. +by move=> mD; have := measurable_restrict f mD measurableT; rewrite setTI. +Qed. + +Lemma measurable_fun_ifT (g h : T1 -> T2) (f : T1 -> bool) + (mf : measurable_fun [set: T1] f) : + measurable_fun [set: T1] g -> measurable_fun [set: T1] h -> + measurable_fun [set: T1] (fun t => if f t then g t else h t). +Proof. +by move=> mx my; apply: measurable_fun_if => //; + [exact: measurable_funS mx|exact: measurable_funS my]. +Qed. + +Section measurable_fun_bool. +Implicit Types f g : T1 -> bool. + +Let measurable_fun_TF D f : + measurable (D `&` f @^-1` [set true]) -> + measurable (D `&` f @^-1` [set false]) -> + measurable_fun D f. +Proof. +move=> mT mF mD /= Y mY. +have := @subsetT _ Y; rewrite setT_bool => YT. +move: mY; have [-> _|-> _|-> _ |-> _] := subset_set2 YT. +- by rewrite preimage0 ?setI0. +- exact: mT. +- exact: mF. +- by rewrite -setT_bool preimage_setT setIT. +Qed. + +Lemma measurable_fun_bool D f b : + measurable (D `&` f @^-1` [set b]) -> measurable_fun D f. +Proof. +move=> mb mD; have mDb : measurable (D `&` f @^-1` [set ~~ b]). + rewrite (_ : [set ~~ b] = [set~ b]); last first. + by apply/seteqP; split=> -[] /=; case: b {mb}. + by rewrite -preimage_setC; exact: measurableID. +by case: b => /= in mb mDb *; exact: measurable_fun_TF. +Qed. +#[global] Arguments measurable_fun_bool {D f} _. + +Lemma measurable_and D f g : measurable_fun D f -> measurable_fun D g -> + measurable_fun D (fun x => f x && g x). +Proof. +move=> mf mg mD; apply: (measurable_fun_bool true) => //. +rewrite [X in measurable X](_ : _ = D `&` f @^-1` [set true] `&` + (D `&` g @^-1` [set true])); last first. + by rewrite setIACA setIid; congr (_ `&` _); apply/seteqP; split => x /andP. +by apply: measurableI; [exact: mf|exact: mg]. +Qed. + +Lemma measurable_neg D f : + measurable_fun D f -> measurable_fun D (fun x => ~~ f x). +Proof. +move=> mf mD; apply: (measurable_fun_bool true) => //. +rewrite [X in measurable X](_ : _ = (D `&` f @^-1` [set false])). + exact: mf. +by apply/seteqP; split => [x [Dx/= /negbTE]|x [Dx/= ->]]. +Qed. + +Lemma measurable_or D f g : measurable_fun D f -> measurable_fun D g -> + measurable_fun D (fun x => f x || g x). +Proof. +move=> mf mg. +rewrite [X in measurable_fun _ X](_ : _ = (fun x => ~~ (~~ f x && ~~ g x))). + by apply: measurable_neg; apply: measurable_and; exact: measurable_neg. +by apply/funext=> x; rewrite -negb_or negbK. +Qed. + +End measurable_fun_bool. + +End measurable_fun_measurableType. +#[global] Hint Extern 0 (measurable_fun _ (fun=> _)) => + solve [apply: measurable_cst] : core. +#[global] Hint Extern 0 (measurable_fun _ (cst _)) => + solve [apply: measurable_cst] : core. +#[global] Hint Extern 0 (measurable_fun _ id) => + solve [apply: measurable_id] : core. +Arguments eq_measurable_fun {d1 d2 T1 T2 D} f {g}. +Arguments measurable_fun_bool {d1 T1 D f} b. + +Section mfun_measurableType. +Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} + {d3} {T3 : measurableType d3}. +Variables (f : {mfun T2 >-> T3}) (g : {mfun T1 >-> T2}). + +Let measurableT_comp_subproof : measurable_fun setT (f \o g). +Proof. exact: measurableT_comp. Qed. + +HB.instance Definition _ := isMeasurableFun.Build _ _ _ _ (f \o g) + measurableT_comp_subproof. + +End mfun_measurableType. + +Section measurability. + +(* f is measurable on the sigma-algebra generated by itself *) +Lemma preimage_set_system_measurable_fun d (aT : pointedType) + (rT : measurableType d) (D : set aT) (f : aT -> rT) : + measurable_fun + (D : set (g_sigma_algebraType (preimage_set_system D f measurable))) f. +Proof. by move=> mD A mA; apply: sub_sigma_algebra; exists A. Qed. + +Lemma measurability d d' (aT : measurableType d) (rT : measurableType d') + (D : set aT) (f : aT -> rT) (G : set (set rT)) : + @measurable _ rT = <> -> preimage_set_system D f G `<=` @measurable _ aT -> + measurable_fun D f. +Proof. +move=> sG_rT fG_aT mD. +suff h : preimage_set_system D f (@measurable _ rT) `<=` @measurable _ aT. + by move=> A mA; apply: h; exists A. +have -> : preimage_set_system D f (@measurable _ rT) = + <>. + by rewrite [in LHS]sG_rT [in RHS]g_sigma_preimageE. +apply: smallest_sub => //; split => //. +- by move=> A mA; exact: measurableD. +- by move=> F h; exact: bigcupT_measurable. +Qed. + +End measurability. +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `preimage_set_system_measurable_fun`")] +Notation preimage_class_measurable_fun := preimage_set_system_measurable_fun (only parsing). +Arguments measurability {d d' aT rT D f} _. + +Section prod_measurable_fun. +Context d d1 d2 (T : measurableType d) (T1 : measurableType d1) + (T2 : measurableType d2). + +Lemma measurable_fun_pairP (h : T -> T1 * T2) : measurable_fun setT h <-> + measurable_fun setT (fst \o h) /\ measurable_fun setT (snd \o h). +Proof. +apply: (@iff_trans _ (g_sigma_preimageU (fst \o h) (snd \o h) `<=` measurable)). +- rewrite g_sigma_preimageU_comp; split=> [mf A [C HC <-]|f12]; first exact: mf. + by move=> _ A mA; apply: f12; exists A. +- split => [h12|[mf1 mf2]]. + split => _ A mA; apply: h12; apply: sub_sigma_algebra; + by [left; exists A|right; exists A]. + apply: smallest_sub; first exact: sigma_algebra_measurable. + by rewrite subUset; split=> [|] A [C mC <-]; [exact: mf1|exact: mf2]. +Qed. + +Lemma measurable_fun_pair (f : T -> T1) (g : T -> T2) : + measurable_fun setT f -> measurable_fun setT g -> + measurable_fun setT (fun x => (f x, g x)). +Proof. by move=> mf mg; exact/measurable_fun_pairP. Qed. + +End prod_measurable_fun. +#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `measurable_fun_pair`")] +Notation measurable_fun_prod := measurable_fun_pair (only parsing). +#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `measurable_fun_pairP`")] +Notation prod_measurable_funP := measurable_fun_pairP (only parsing). + +Section prod_measurable_proj. +Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2). + +Lemma measurable_fst : measurable_fun [set: T1 * T2] fst. +Proof. +by have /measurable_fun_pairP[] := @measurable_id _ (T1 * T2)%type setT. +Qed. +#[local] Hint Resolve measurable_fst : core. + +Lemma measurable_snd : measurable_fun [set: T1 * T2] snd. +Proof. +by have /measurable_fun_pairP[] := @measurable_id _ (T1 * T2)%type setT. +Qed. +#[local] Hint Resolve measurable_snd : core. + +Lemma measurable_swap : measurable_fun [set: _] (@swap T1 T2). +Proof. exact: measurable_fun_pair. Qed. + +End prod_measurable_proj. +Arguments measurable_fst {d1 d2 T1 T2}. +Arguments measurable_snd {d1 d2 T1 T2}. +#[global] Hint Extern 0 (measurable_fun _ fst) => + solve [apply: measurable_fst] : core. +#[global] Hint Extern 0 (measurable_fun _ snd) => + solve [apply: measurable_snd] : core. + +Lemma measurable_tnth d (T : sigmaRingType d) n (i : 'I_n) : + measurable_fun [set: n.-tuple T] (@tnth _ T ^~ i). +Proof. +move=> _ Y mY; rewrite setTI; apply: sub_sigma_algebra => /=. +rewrite -bigcup_seq/=; exists i => /=; first by rewrite mem_index_enum. +by exists Y => //; rewrite setTI. +Qed. + +Section measurable_cons. +Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2). + +Lemma measurable_fun_tnthP n (f : T1 -> n.-tuple T2) : + measurable_fun [set: T1] f <-> + forall i, measurable_fun [set: T1] (@tnth n T2 ^~ i \o f). +Proof. +apply: (@iff_trans _ (g_sigma_preimage + (fun i => @tnth n T2 ^~ i \o f) `<=` measurable)). + rewrite g_sigma_preimage_comp; split=> [mf A [/= C preC <-]|prefS]. + exact: mf. + by move=> _ A mA; apply: prefS; exists A. +split=> [tnthfS i|mf]. +- move=> _ A mA. + apply: tnthfS; apply: sub_sigma_algebra. + case: n i => [[] []//|n i] in f *. + rewrite -bigcup_mkord_ord. + exists i; first exact: ltn_ord. + by exists A => //; rewrite inord_val. +- apply: smallest_sub; first exact: sigma_algebra_measurable. + case: n => [|n] in f mf *; first by rewrite big_ord0. + rewrite -bigcup_mkord_ord; apply: bigcup_sub => i Ii. + by move=> A [B mB <-]; exact: mf. +Qed. + +Lemma measurable_cons (f : T1 -> T2) n (g : T1 -> n.-tuple T2) : + measurable_fun [set: T1] f -> measurable_fun [set: T1] g -> + measurable_fun [set: T1] (fun x => [the n.+1.-tuple T2 of f x :: g x]). +Proof. +move=> mf mg; apply/measurable_fun_tnthP => /= i. +have [->//|i0] := eqVneq i ord0. +have i1n : (i.-1 < n)%N by rewrite prednK ?lt0n// -ltnS. +pose j := Ordinal i1n. +rewrite (_ : _ \o _ = fun x => tnth (g x) j)//. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x j)) => //=. + exact: measurable_tnth. +apply/funext => x /=. +rewrite (_ : i = lift ord0 j) ?tnthS//. +by apply/val_inj => /=; rewrite /bump/= add1n prednK// lt0n. +Qed. + +End measurable_cons. + +Lemma measurable_behead d (T : measurableType d) n : + measurable_fun [set: n.+1.-tuple T] (fun x => [tuple of behead x]). +Proof. +move=> _ Y mY; rewrite setTI. +set f := fun x : (n.+1).-tuple T => [tuple of behead x] : n.-tuple T. +move: mY; rewrite /measurable/= => + F [] sF. +pose F' := image_set_system setT f F. +move=> /(_ F') /=. +have -> : F' Y = F (f @^-1` Y) by rewrite /F' /image_set_system /= setTI. +move=> /[swap] bigF; apply; split; first exact: sigma_algebra_image. +move=> A; rewrite /= {}/F' /image_set_system /= setTI. +set bign := (X in X A -> _) => bignA. +apply: bigF; rewrite big_ord_recl /=; right. +set bign1 := (X in X (_ @^-1` _)). +have -> : bign1 = preimage_set_system [set: n.+1.-tuple T] f bign. + rewrite (big_morph _ (preimage_set_systemU _ _) (preimage_set_system0 _ _)). + apply: eq_bigr => i _; rewrite -preimage_set_system_comp. + congr preimage_set_system. + by apply: funext=> t/=; rewrite [in LHS](tuple_eta t) tnthS. +by exists A => //; rewrite setTI. +Qed. + +Lemma measurable_fun_if_pair d d' (X : measurableType d) + (Y : measurableType d') (x y : X -> Y) : + measurable_fun setT x -> measurable_fun setT y -> + measurable_fun setT (fun tb => if tb.2 then x tb.1 else y tb.1). +Proof. +by move=> mx my; apply: measurable_fun_ifT => //=; exact: measurableT_comp. +Qed. + +Section pair_measurable_fun. +Context d d1 d2 (T : measurableType d) (T1 : measurableType d1) + (T2 : measurableType d2). +Variable f : T1 * T2 -> T. + +Lemma pair1_measurable (x : T1) : measurable_fun [set: T2] (pair x). +Proof. +have m1pairx : measurable_fun [set: T2] (fst \o pair x) by exact/measurable_cst. +have m2pairx : measurable_fun [set: T2] (snd \o pair x) by exact/measurable_id. +exact/measurable_fun_pairP. +Qed. + +Lemma pair2_measurable (y : T2) : measurable_fun [set: T1] (pair^~ y). +Proof. +have m1pairy : measurable_fun [set: T1] (fst \o pair^~y) by exact/measurable_id. +have m2pairy : measurable_fun [set: T1] (snd \o pair^~y) by exact/measurable_cst. +exact/measurable_fun_pairP. +Qed. + +End pair_measurable_fun. +#[global] Hint Extern 0 (measurable_fun _ (pair _)) => + solve [apply: pair1_measurable] : core. +#[global] Hint Extern 0 (measurable_fun _ (pair^~ _)) => + solve [apply: pair2_measurable] : core. +#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `pair1_measurable`")] +Notation measurable_pair1 := pair1_measurable (only parsing). +#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed `pair2_measurable`")] +Notation measurable_pair2 := pair2_measurable (only parsing). + +(* [Lemma 14.13, Klenke 2014] *) +Section measurable_section. +Context d1 d2 d3 (T1 : measurableType d1) (T2 : measurableType d2) + (T3 : measurableType d3). + +Lemma measurable_xsection (A : set (T1 * T2)) (x : T1) : + measurable A -> measurable (xsection A x). +Proof. +move=> mA; pose i (y : T2) := (x, y). +have mi : measurable_fun setT i by exact: pair1_measurable. +by rewrite xsectionE -[X in measurable X]setTI; exact: mi. +Qed. + +Lemma measurable_ysection (A : set (T1 * T2)) (y : T2) : + measurable A -> measurable (ysection A y). +Proof. +move=> mA; pose i (x : T1) := (x, y). +have mi : measurable_fun setT i by exact: pair2_measurable. +by rewrite ysectionE -[X in measurable X]setTI; exact: mi. +Qed. + +Lemma measurable_fun_pair1 (f : T1 * T2 -> T3) (y : T2) : + measurable_fun setT f -> measurable_fun setT (fun x => f (x, y)). +Proof. by move=> mf; exact: measurableT_comp. Qed. + +Lemma measurable_fun_pair2 (f : T1 * T2 -> T3) (x : T1) : + measurable_fun setT f -> measurable_fun setT (fun y => f (x, y)). +Proof. by move=> mf; exact: measurableT_comp. Qed. + +End measurable_section. diff --git a/theories/measure_theory/measurable_structure.v b/theories/measure_theory/measurable_structure.v new file mode 100644 index 0000000000..afa2bbed4c --- /dev/null +++ b/theories/measure_theory/measurable_structure.v @@ -0,0 +1,1694 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. + +(**md**************************************************************************) +(* # Measure Theory *) +(* *) +(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) +(* *) +(* References: *) +(* - R. Affeldt, C. Cohen. Measure construction by extension in dependent *) +(* type theory with application to integration. JAR 2023 *) +(* - Daniel Li. Intégration et applications. 2016 *) +(* - Achim Klenke. Probability Theory. 2014 *) +(* *) +(* ## Mathematical structures *) +(* ``` *) +(* semiRingOfSetsType d == the type of semirings of sets *) +(* The carrier is a set of sets A_i such that *) +(* "measurable A_i" holds. *) +(* "measurable A" is printed as "d.-measurable A" *) +(* where d is a "display parameter" whose purpose *) +(* is to distinguish different "measurable" *) +(* predicates in the same context. *) +(* The HB class is SemiRingOfSets. *) +(* ringOfSetsType d == the type of rings of sets *) +(* The HB class is RingOfSets. *) +(* sigmaRingType d == the type of sigma-rings (of sets) *) +(* The HB class is SigmaRing. *) +(* algebraOfSetsType d == the type of algebras of sets *) +(* The HB class is AlgebraOfsets. *) +(* measurableType == the type of sigma-algebras *) +(* The HB class is Measurable. *) +(* ``` *) +(* *) +(* ## Instances of mathematical structures *) +(* ``` *) +(* discrete_measurable T == alias for the sigma-algebra [set: set T] *) +(* setring G == the set of sets G contains the empty set, is *) +(* closed by union, and difference (it is a ring *) +(* of sets in the sense of ringOfSetsType) *) +(* <> := smallest setring G *) +(* <> is equipped with a structure of ring *) +(* of sets. *) +(* sigma_ring G == the set of sets G forms a sigma-ring *) +(* <> == sigma-ring generated by G *) +(* := smallest sigma_ring G *) +(* sigma_algebra D G == the set of sets G forms a sigma-algebra on D *) +(* <> == sigma-algebra generated by G on D *) +(* := smallest (sigma_algebra D) G *) +(* <> := <> *) +(* <> is equipped with a structure of *) +(* sigma-algebra *) +(* G.-sigma.-measurable A == A is measurable for the sigma-algebra <> *) +(* g_sigma_algebraType G == the measurableType corresponding to <> *) +(* This is an HB alias. *) +(* ``` *) +(* *) +(* ## About sets of sets *) +(* ``` *) +(* setI_closed G == the set of sets G is closed under finite *) +(* intersection *) +(* setU_closed G == the set of sets G is closed under finite union *) +(* setC_closed G == the set of sets G is closed under complement *) +(* setSD_closed G == the set of sets G is closed under proper *) +(* difference *) +(* setD_closed G == the set of sets G is closed under difference *) +(* setY_closed G == the set of sets G is closed under symmetric *) +(* difference *) +(* ndseq_closed G == the set of sets G is closed under non-decreasing *) +(* countable union *) +(* niseq_closed G == the set of sets G is closed under non-increasing *) +(* countable intersection *) +(* trivIset_closed G == the set of sets G is closed under pairwise-disjoint *) +(* countable union *) +(* lambda_system D G == G is a lambda_system of subsets of D *) +(* <> == lambda-system generated by G on D *) +(* <> := <> *) +(* monotone G == G is a monotone set system *) +(* <> == monotone set system generated by G *) +(* := smallest monotone G *) +(* dynkin G == G is a set of sets that form a Dynkin *) +(* system (or a d-system) *) +(* <> == Dynkin system generated by G, i.e., *) +(* smallest dynkin G *) +(* strace G D := [set x `&` D | x in G] *) +(* ``` *) +(* ## Other measure-theoretic definitions *) +(* *) +(* ``` *) +(* preimage_set_system D f G == set system of the preimages by f of sets in G *) +(* image_set_system D f G == set system of the sets with a preimage by f *) +(* in G *) +(* subset_sigma_subadditive mu == alternative predicate defining *) +(* sigma-subadditivity *) +(* ``` *) +(* *) +(* ## Product of measurable spaces *) +(* ``` *) +(* g_sigma_preimageU f1 f2 == sigma-algebra generated by the union of *) +(* the preimages by f1 and the preimages by *) +(* f2 with f1 : T -> T1 and f : T -> T2, T1 *) +(* and T2 being semiRingOfSetsType's *) +(* (d1, d2).-prod.-measurable A == A is measurable for the sigma-algebra *) +(* generated from T1 x T2, with T1 and T2 *) +(* semiRingOfSetsType's with resp. display *) +(* d1 and d2 *) +(* g_sigma_preimage n (f : 'I_n -> aT -> rT) == the sigma-algebra over aT *) +(* generated by the projections f *) +(* n.-tuple T is equipped with a *) +(* measurableType using g_sigma_preimage *) +(* and the tnth projections. *) +(* ``` *) +(* *) +(* ## More measure-theoretic definitions *) +(* *) +(* ``` *) +(* m1 `<< m2 == m1 is absolutely continuous w.r.t. m2 or m2 dominates m1 *) +(* ``` *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Reserved Notation "'s<|' D , G '|>'" (at level 40, G, D at next level). +Reserved Notation "'s<<' A '>>'". +Reserved Notation "'d<<' D '>>'". +Reserved Notation "mu .-measurable" (format "mu .-measurable"). +Reserved Notation "G .-sigma" (format "G .-sigma"). +Reserved Notation "G .-sigma.-measurable" (format "G .-sigma.-measurable"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "'<>'" (format "'<>'"). +Reserved Notation "p .-prod" (format "p .-prod"). +Reserved Notation "p .-prod.-measurable" (format "p .-prod.-measurable"). +Reserved Notation "m1 `<< m2" (at level 51). + +Inductive measure_display := default_measure_display. +Declare Scope measure_display_scope. +Delimit Scope measure_display_scope with mdisp. +Bind Scope measure_display_scope with measure_display. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Section set_systems. +Context {T} (C : set (set T) -> Prop) (D : set T) (G : set (set T)). + +Definition setC_closed := forall A, G A -> G (~` A). +Definition setI_closed := forall A B, G A -> G B -> G (A `&` B). +Definition setU_closed := forall A B, G A -> G B -> G (A `|` B). +Definition setSD_closed := forall A B, B `<=` A -> G A -> G B -> G (A `\` B). +Definition setD_closed := forall A B, G A -> G B -> G (A `\` B). +Definition setY_closed := forall A B, G A -> G B -> G (A `+` B). + +Definition fin_bigcap_closed := + forall I (D : set I) A_, finite_set D -> (forall i, D i -> G (A_ i)) -> + G (\bigcap_(i in D) (A_ i)). + +Definition finN0_bigcap_closed := + forall I (D : set I) A_, finite_set D -> D !=set0 -> + (forall i, D i -> G (A_ i)) -> + G (\bigcap_(i in D) (A_ i)). + +Definition fin_bigcup_closed := + forall I (D : set I) A_, finite_set D -> (forall i, D i -> G (A_ i)) -> + G (\bigcup_(i in D) (A_ i)). + +Definition semi_setD_closed := forall A B, G A -> G B -> exists D, + [/\ finite_set D, D `<=` G, A `\` B = \bigcup_(X in D) X & trivIset D id]. + +Lemma setD_semi_setD_closed : setD_closed -> semi_setD_closed. +Proof. +move=> mD A B Am Bm; exists [set A `\` B]; split; rewrite ?bigcup_set1//. + by move=> X ->; apply: mD. +by move=> X Y -> ->. +Qed. + +Definition ndseq_closed := + forall F, nondecreasing_seq F -> (forall i, G (F i)) -> G (\bigcup_i (F i)). + +Definition niseq_closed := + forall F, nonincreasing_seq F -> (forall i, G (F i)) -> G (\bigcap_i (F i)). + +Definition trivIset_closed := + forall F : (set T)^nat, trivIset setT F -> (forall n, G (F n)) -> + G (\bigcup_k F k). + +Definition fin_trivIset_closed := + forall I (D : set I) (F : I -> set T), finite_set D -> trivIset D F -> + (forall i, D i -> G (F i)) -> G (\bigcup_(k in D) F k). + +Definition setring := [/\ G set0, setU_closed & setD_closed]. + +Definition sigma_ring := [/\ G set0, setD_closed & + (forall A : (set T)^nat, (forall n, G (A n)) -> G (\bigcup_k A k))]. + +Definition sigma_algebra := + [/\ G set0, (forall A, G A -> G (D `\` A)) & + (forall A : (set T)^nat, (forall n, G (A n)) -> G (\bigcup_k A k))]. + +Definition dynkin := [/\ G setT, setC_closed & trivIset_closed]. + +(**md Until MathComp-Analysis 1.1.0, the identifier was `monotone_class` +because this definition corresponds to "classe monotone" in several +French references, e.g., the definition of "classe monotone" on the French wikipedia. *) +Definition lambda_system := + [/\ forall A, G A -> A `<=` D, G D, setSD_closed & ndseq_closed]. + +Definition monotone := ndseq_closed /\ niseq_closed. + +End set_systems. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `lambda_system`")] +Notation monotone_class := lambda_system (only parsing). +(*#[deprecated(since="mathcomp-analysis 1.3.0", note="renamed `setSD_closed`")] +Notation setD_closed := setSD_closed (only parsing).*) +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setD_closed`")] +Notation setDI_closed := setD_closed (only parsing). +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setD_semi_setD_closed`")] +Notation setDI_semi_setD_closed := setD_semi_setD_closed (only parsing). + +Lemma powerset_sigma_ring (T : Type) (D : set T) : + sigma_ring [set X | X `<=` D]. +Proof. +split => //; last first. + by move=> F FA/=; apply: bigcup_sub => i _; exact: FA. +by move=> U V + VA; apply: subset_trans; exact: subDsetl. +Qed. + +Lemma powerset_lambda_system (T : Type) (D : set T) : + lambda_system D [set X | X `<=` D]. +Proof. +split => //. +- by move=> A B BA + BD; apply: subset_trans; exact: subDsetl. +- by move=> /= F _ FD; exact: bigcup_sub. +Qed. + +Notation "'<>'" := (smallest (lambda_system D) G) : + classical_set_scope. +Notation "'<>'" := (<>) : classical_set_scope. +Notation "'<>'" := (smallest dynkin G) : classical_set_scope. +Notation "'<>'" := (smallest (sigma_algebra D) G) : + classical_set_scope. +Notation "'<>'" := (<>) : classical_set_scope. +Notation "'<>'" := (smallest setring G) : classical_set_scope. +Notation "'<>'" := (smallest sigma_ring G) : classical_set_scope. +Notation "'<>'" := (smallest monotone G) : classical_set_scope. + +Section lambda_system_smallest. +Variables (T : Type) (D : set T) (G : set (set T)). +Hypothesis GD : forall A, G A -> A `<=` D. + +Lemma lambda_system_smallest : lambda_system D <>. +Proof. +split => [A MA | E [monoE] | A B BA MA MB E [[EsubD ED setDE ndE] GE] |]. +- have monoH := powerset_lambda_system D. + by case: (monoH) => + _ _ _; apply; exact: MA. +- by case: monoE. +- by apply setDE => //; [exact: MA|exact: MB]. +- by move=> F ndF MF E [[EsubD ED setDE ndE] CE]; apply ndE=> // n; exact: MF. +Qed. + +End lambda_system_smallest. + +Lemma fin_bigcup_closedP T (G : set (set T)) : + (G set0 /\ setU_closed G) <-> fin_bigcup_closed G. +Proof. +split=> [[G0 GU] I D A DF GA|GU]; last first. + have G0 : G set0 by have := GU void set0 point; rewrite bigcup0//; apply. + by split=> // A B GA GB; rewrite -bigcup2inE; apply: GU => // -[|[|[]]]. +elim/Pchoice: I => I in D DF A GA *; rewrite -bigsetU_fset_set// big_seq. +by elim/big_ind: _ => // i; rewrite in_fset_set// inE => /GA. +Qed. + +Lemma finN0_bigcap_closedP T (G : set (set T)) : + setI_closed G <-> finN0_bigcap_closed G. +Proof. +split=> [GI I D A DF [i Di] GA|GI A B GA GB]; last first. + by rewrite -bigcap2inE; apply: GI => // [|[|[|[]]]]; first by exists 0%N. +elim/Pchoice: I => I in D DF i Di A GA *. +have finDDi : finite_set (D `\ i) by exact: finite_setD. +rewrite (bigcap_setD1 i)// -bigsetI_fset_set// big_seq. +elim/big_rec: _ => // [|j B]; first by rewrite setIT; apply: GA. +rewrite in_fset_set// inE => -[Dj /eqP nij] GAB. +by rewrite setICA; apply: GI => //; apply: GA. +Qed. + +Lemma setD_closedP T (G : set (set T)) : + setD_closed G <-> (setI_closed G /\ setSD_closed G). +Proof. +split=> [GDI|[GI GD]]. + by split=> A B => [|AB] => GA GB; rewrite -?setDD//; do ?apply: (GDI). +move=> A B GA GB; suff <- : A `\` (A `&` B) = A `\` B. + by apply: GD => //; apply: GI. +by rewrite setDE setCI setIUr -setDE setDv set0U. +Qed. +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setD_closed`")] +Notation sedDI_closedP := setD_closed (only parsing). + +Lemma sigma_algebra_bigcap T (I : choiceType) (D : set T) + (F : I -> set (set T)) (J : set I) : + (forall n, J n -> sigma_algebra D (F n)) -> + sigma_algebra D (\bigcap_(i in J) F i). +Proof. +move=> mG; split=> [i Ji|A AJ i Ji|H GH i Ji]; first by have [] := mG i. +- by have [_ mGiC _] := mG i Ji; exact/mGiC/AJ. +- by have [_ _ mGiU] := mG i Ji; apply: mGiU => j; exact: GH. +Qed. + +Lemma sigma_algebraP T U (C : set (set T)) : + (forall X, C X -> X `<=` U) -> + sigma_algebra U C <-> + [/\ C U, setSD_closed C, ndseq_closed C & setI_closed C]. +Proof. +move=> C_subU; split => [[C0 CD CU]|[DT DC DU DI]]; split. +- by rewrite -(setD0 U); apply: CD. +- move=> A B BA CA CB; rewrite (_ : A `\` B = U `\` ((U `\` A) `|` B)). + by apply CD; rewrite -bigcup2E; apply: CU => -[|[|[|]]] //=; exact: CD. + rewrite setDUr setDD [in RHS]setDE setIACA setIid -setDE setIidr//. + by rewrite setDE; apply: subIset; left; apply: C_subU. +- by move=> F ndF DF; exact: CU. +- move=> A B DA DB; rewrite (_ : A `&` B = U `\` ((U `\` A) `|` (U `\` B))). + by apply CD; rewrite -bigcup2E; apply: CU => -[|[|[|]]] //; exact: CD. + rewrite setDUr !setDD setIACA setIid (@setIidr _ U)//. + by apply: subIset; left; exact: C_subU. +- by rewrite -(setDv U); exact: DC. +- by move=> A CA; apply: DC => //; exact: C_subU. +- move=> F DF. + rewrite [X in C X](_ : _ = \bigcup_i \big[setU/set0]_(j < i.+1) F j). + apply: DU; first by move=> *; exact/subsetPset/subset_bigsetU. + elim=> [|n ih]; first by rewrite big_ord_recr /= big_ord0 set0U; exact: DF. + have CU : setU_closed C. + move=> A B DA DB; rewrite (_ : A `|` B = U `\` ((U `\` A) `&` (U `\` B))). + apply DC => //; last by apply: DI; apply: DC => //; exact: C_subU. + by apply: subIset; left; apply: subIset; left. + by rewrite setDIr// !setDD (setIidr (C_subU _ DA)) (setIidr (C_subU _ _)). + by rewrite big_ord_recr; exact: CU. + rewrite predeqE => x; split => [[n _ Fnx]|[n _]]. + by exists n => //; rewrite big_ord_recr /=; right. + by rewrite -bigcup_mkord => -[m /=]; rewrite ltnS => _ Fmx; exists m. +Qed. + +Section generated_sigma_algebra. +Context {T : Type} (D : set T) (G : set (set T)). +Implicit Types (M : set (set T)). + +Lemma smallest_sigma_algebra : sigma_algebra D <>. +Proof. +split=> [|A GA|A GA] P [[P0 PD PU]] GP //. + by apply: (PD); apply: GA. +by apply: (PU) => n; apply: GA. +Qed. +Hint Resolve smallest_sigma_algebra : core. + +Lemma sub_sigma_algebra2 M : M `<=` G -> <> `<=` <>. +Proof. exact: sub_smallest2r. Qed. + +Lemma sigma_algebra_id : sigma_algebra D G -> <> = G. +Proof. by move=> /smallest_id->. Qed. + +Lemma sub_sigma_algebra : G `<=` <>. Proof. exact: sub_smallest. Qed. + +Lemma sigma_algebra0 : <> set0. +Proof. by case: smallest_sigma_algebra. Qed. + +Lemma sigma_algebraCD : forall A, <> A -> <> (D `\` A). +Proof. by case: smallest_sigma_algebra. Qed. + +Lemma sigma_algebra_bigcup (A : (set T)^nat) : + (forall i, <> (A i)) -> <> (\bigcup_i (A i)). +Proof. by case: smallest_sigma_algebra A. Qed. + +End generated_sigma_algebra. +#[global] Hint Resolve smallest_sigma_algebra : core. + +Section generated_setring. +Context {T : Type} (G : set (set T)). +Implicit Types (M : set (set T)). + +Lemma smallest_setring : setring <>. +Proof. +split=> [|A B GA GB|A B GA GB] P [[P0 PU PDI]] GP //. + by apply: (PU); [apply: GA|apply: GB]. +by apply: (PDI); [apply: GA|apply: GB]. +Qed. +Hint Resolve smallest_setring : core. + +Lemma sub_setring2 M : M `<=` G -> <> `<=` <>. +Proof. exact: sub_smallest2r. Qed. + +Lemma setring_id : setring G -> <> = G. +Proof. by move=> /smallest_id->. Qed. + +Lemma sub_setring : G `<=` <>. Proof. exact: sub_smallest. Qed. + +Lemma setring0 : <> set0. +Proof. by case: smallest_setring. Qed. + +Lemma setringD : setD_closed <>. +Proof. by case: smallest_setring. Qed. + +Lemma setringU : setU_closed <>. +Proof. by case: smallest_setring. Qed. + +Lemma setring_fin_bigcup : fin_bigcup_closed <>. +Proof. +by apply/fin_bigcup_closedP; split; [apply: setring0|apply: setringU]. +Qed. + +End generated_setring. +#[global] Hint Resolve smallest_setring setring0 : core. +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed `setringD`")] +Notation setringDI := setringD (only parsing). + +Lemma g_sigma_algebra_lambda_system T (G : set (set T)) (D : set T) : + (forall X, <> X -> X `<=` D) -> + lambda_system D <>. +Proof. +move=> sDGD; have := smallest_sigma_algebra D G. +by move=> /(sigma_algebraP sDGD) [sT sD snd sI]; split. +Qed. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_lambda_system`")] +Notation monotone_class_g_salgebra := g_sigma_algebra_lambda_system (only parsing). + +Lemma smallest_sigma_ring T (G : set (set T)) : sigma_ring <>. +Proof. +split=> [B [[]]//|A B GA GB C [[? CDI ?]] GC|A GA C [[? ? CU]] GC] /=. +- by apply: (CDI); [exact: GA|exact: GB]. +- by apply: (CU) => n; exact: GA. +Qed. + +(**md see Paul Halmos' Measure Theory, Ch.1, sec.6, thm.A(1), p.27 *) +Lemma sigma_ring_monotone T (G : set (set T)) : sigma_ring G -> monotone G. +Proof. +move=> [G0 GDI GU]; split => [F ndF GF|F icF GF]; first exact: GU. +rewrite -(@setD_bigcup _ _ F _ O)//; apply: (GDI); first exact: GF. +by rewrite bigcup_mkcond; apply: GU => n; case: ifPn => // _; exact: GDI. +Qed. + +Lemma g_sigma_ring_monotone T (G : set (set T)) : monotone <>. +Proof. by apply: sigma_ring_monotone => //; exact: smallest_sigma_ring. Qed. + +Lemma sub_g_sigma_ring T (G : set (set T)) : G `<=` <>. +Proof. exact: sub_smallest. Qed. + +(**md see Paul Halmos' Measure Theory, Ch.1, sec.6, thm.A(2), p.27 *) +Lemma setring_monotone_sigma_ring T (G : set (set T)) : + setring G -> monotone G -> sigma_ring G. +Proof. +move=> [G0 GU GD] [ndG niG]; split => // F GF. +rewrite -bigcup_bigsetU_bigcup; apply: ndG. + by move=> *; exact/subsetPset/subset_bigsetU. +by elim=> [|n ih]; rewrite big_ord_recr/= ?big_ord0 ?set0U//; exact: GU. +Qed. + +Lemma g_monotone_monotone T (G : set (set T)) : monotone <>. +Proof. +split=> /= F ndF GF C [[ndC niC] GC]; + have {}GC : <> `<=` C by exact: smallest_sub. +- by apply: (ndC) => // i; apply: (GC); exact: GF. +- by apply: (niC) => // i; apply: (GC); exact: GF. +Qed. + +Section g_monotone_g_sigma_ring. +Variables (T : Type) (G : set (set T)). +Hypothesis ringG : setring G. + +(**md see Paul Halmos' Measure Theory, Ch.1, sec.6, thm.B, p.27 *) +Lemma g_monotone_setring : setring <>. +Proof. +pose M := <>. +pose K F := [set E | [/\ M (E `\` F), M (F `\` E) & M (E `|` F)] ]. +have KP E F : K(F) E -> K(E) F by move=> [] *; split; rewrite 1?setUC. +have K_monotone F : monotone (K(F)). + split. + move=> /= H ndH KFH; split. + - rewrite setD_bigcupl; apply: (g_monotone_monotone G).1. + by move=> m n mn; apply/subsetPset; apply: setSD; exact/subsetPset/ndH. + by move=> i; have [] := KFH i. + - rewrite setDE setC_bigcup -bigcapIr//; apply: (g_monotone_monotone G).2. + move=> m n mn; apply/subsetPset. + by apply: setDS; exact/subsetPset/ndH. + by move=> i; have [] := KFH i. + - rewrite -bigcupUl//; apply: (g_monotone_monotone G).1. + move=> m n mn; apply/subsetPset. + by apply: setSU; exact/subsetPset/ndH. + by move=> i; have [] := KFH i. + move=> /= H niH KFH; split. + - rewrite setDE -bigcapIl//; apply: (g_monotone_monotone G).2. + move=> m n mn; apply/subsetPset; apply: setSI; exact/subsetPset/niH. + by move=> i; have [] := KFH i. + - rewrite setDE setC_bigcap setI_bigcupr; apply: (g_monotone_monotone G).1. + move=> m n mn; apply/subsetPset. + by apply: setIS; apply: subsetC; exact/subsetPset/niH. + by move=> i; have [] := KFH i. + - rewrite setU_bigcapl//; apply: (g_monotone_monotone G).2. + move=> m n mn; apply/subsetPset. + by apply: setSU; exact/subsetPset/niH. + by move=> i; have [] := KFH i. +have G_KF F : G F -> G `<=` K(F). + case: ringG => _ GU GDI GF A GA; split. + - by apply: sub_gen_smallest; exact: GDI. + - by apply: sub_gen_smallest; exact: GDI. + - by apply: sub_gen_smallest; exact: GU. +have GM_KF F : G F -> M `<=` K(F). + by move=> GF; apply: smallest_sub => //; exact: G_KF. +have MG_KF F : M F -> G `<=` K(F). + by move=> MF A GA; rewrite /K/=; split; have /KP[] := GM_KF _ GA _ MF. +have MM_KF F : M F -> M `<=` K(F). + by move=> MF; apply: smallest_sub => //; exact: MG_KF. +split. +- by apply: sub_gen_smallest; case: ringG. +- by move=> A B GA GB; have [] := MM_KF _ GB _ GA. +- by move=> A B GA GB; have [] := MM_KF _ GB _ GA. +Qed. + +Lemma g_monotone_g_sigma_ring : <> = <>. +Proof. +rewrite eqEsubset; split. + by apply: smallest_sub; [exact: g_sigma_ring_monotone| + exact: sub_g_sigma_ring]. +apply: smallest_sub; last exact: sub_smallest. +apply: setring_monotone_sigma_ring; last exact: g_monotone_monotone. +exact: g_monotone_setring. +Qed. + +End g_monotone_g_sigma_ring. + +Corollary monotone_setring_sub_g_sigma_ring T (G R : set (set T)) : monotone G -> + setring R -> R `<=` G -> <> `<=` G. +Proof. +by move=> mG rR RG; rewrite -g_monotone_g_sigma_ring//; exact: smallest_sub. +Qed. + +Section smallest_lambda_system. +Variables (T : Type) (G : set (set T)) (setIG : setI_closed G) (D : set T). +Hypothesis lambdaDG : lambda_system D <>. + +Lemma smallest_lambda_system : (forall X, <> X -> X `<=` D) -> + <> = <>. +Proof. +move=> sDGD; rewrite eqEsubset; split. + apply: smallest_sub; first exact: g_sigma_algebra_lambda_system. + exact: sub_sigma_algebra. +suff: setI_closed <>. + move=> IH; apply: smallest_sub => //. + by apply/sigma_algebraP; case: lambdaDG. +pose H := <>. +pose H_ A := [set X | H X /\ H (X `&` A)]. +have setDH_ A : setSD_closed (H_ A). + move=> X Y XY [HX HXA] [HY HYA]; case: lambdaDG => h _ setDH _; split. + exact: setDH. + rewrite (_ : _ `&` _ = (X `&` A) `\` (Y `&` A)); last first. + rewrite predeqE => x; split=> [[[? ?] ?]|]; first by split => // -[]. + by move=> [[? ?] YAx]; split => //; split => //; apply: contra_not YAx. + by apply: setDH => //; exact: setSI. +have ndH_ A : ndseq_closed (H_ A). + move=> F ndF H_AF; split. + by case: lambdaDG => h _ _; apply => // => n; have [] := H_AF n. + rewrite setI_bigcupl; case: lambdaDG => h _ _; apply => //. + by move=> m n mn; apply/subsetPset; apply: setSI; apply/subsetPset/ndF. + by move=> n; have [] := H_AF n. +have GGH_ X : G X -> G `<=` H_ X. + move=> GX; rewrite /H_ => A GA; split; first exact: sub_smallest GA. + by apply: (@sub_smallest _ _ _ G) => //; exact: setIG. +have HD X : H X -> X `<=` D by move=> ?; case: lambdaDG => + _ _ _; apply. +have GHH_ X : G X -> H `<=` H_ X. + move=> GX; apply: smallest_sub; last exact: GGH_. + split => //; first by move=> A [HA _]; case: lambdaDG => + _ _ _; exact. + have XD : X `<=` D by apply: HD; exact: (@sub_smallest _ _ _ G). + rewrite /H_ /= setIidr//; split; [by case: lambdaDG|]. + exact: (@sub_smallest _ _ _ G). +have HGH_ X : H X -> G `<=` H_ X. + move=> *; split; [|by rewrite setIC; apply GHH_]. + exact: (@sub_smallest _ _ _ G). +have HHH_ X : H X -> H `<=` H_ X. + move=> HX; apply: smallest_sub; last exact: HGH_. + split=> //. + - by move=> ? [? ?]; case: lambdaDG => + _ _ _; exact. + - have XD : X `<=` D := HD _ HX. + by rewrite /H_/= setIidr//; split => //; case: lambdaDG. +by move=> *; apply HHH_. +Qed. + +End smallest_lambda_system. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `smallest_lambda_system`")] +Notation smallest_monotone_classE := smallest_lambda_system (only parsing). + +Section lambda_system_subset. +Variables (T : Type) (G : set (set T)) (setIG : setI_closed G) (D : set T). +Variables (H : set (set T)) (DH : lambda_system D H) (GH : G `<=` H). + +(**md a.k.a. Sierpiński–Dynkin's pi-lambda theorem *) +Lemma lambda_system_subset : (forall X, (<>) X -> X `<=` D) -> + <> `<=` H. +Proof. +move=> sDGD; set M := <>. +rewrite -(@smallest_lambda_system _ _ setIG D) //. +- exact: smallest_sub. +- apply: lambda_system_smallest => A GA. + by apply: sDGD; exact: sub_sigma_algebra. +Qed. + +End lambda_system_subset. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `lambda_system_subset`")] +Notation monotone_class_subset := lambda_system_subset (only parsing). + +Section dynkin. +Variable T : Type. +Implicit Types G D : set (set T). + +Lemma dynkinT G : dynkin G -> G setT. Proof. by case. Qed. + +Lemma dynkinC G : dynkin G -> setC_closed G. Proof. by case. Qed. + +Lemma dynkinU G : dynkin G -> (forall F : (set T)^nat, trivIset setT F -> + (forall n, G (F n)) -> G (\bigcup_k F k)). Proof. by case. Qed. + +End dynkin. + +Section dynkin_lemmas. +Variable T : Type. +Implicit Types D G : set (set T). + +Lemma dynkin_lambda_system G : dynkin G <-> lambda_system setT G. +Proof. +split => [[GT setCG trG]|[_ GT setDG ndG]]; split => //. +- move=> A B BA GA GB; rewrite setDE -(setCK (_ `&` _)) setCI; apply: (setCG). + rewrite setCK -bigcup2E; apply trG. + + by rewrite -trivIset_bigcup2 setIC; apply subsets_disjoint. + + by move=> [|[//|n]]; [exact: setCG|rewrite /bigcup2 -setCT; apply: setCG]. +- move=> F ndF GF; rewrite -eq_bigcup_seqD; apply: (trG). + exact: trivIset_seqD. + move=> [/=|n]; first exact: GF. + rewrite /seqD setDE -(setCK (_ `&` _)) setCI; apply: (setCG). + rewrite setCK -bigcup2E; apply: trG. + + rewrite -trivIset_bigcup2 setIC; apply subsets_disjoint. + exact/subsetPset/ndF/ltnW. + + move=> [|[|]]; rewrite /bigcup2 /=; [exact/setCG/GF|exact/GF|]. + by move=> _; rewrite -setCT; apply: setCG. +- by move=> A B; rewrite -setTD; apply: setDG. +- move=> F tF GF; pose A i := \big[setU/set0]_(k < i.+1) F k. + rewrite -bigcup_bigsetU_bigcup. + apply: ndG; first by move=> a b ab; exact/subsetPset/subset_bigsetU. + elim=> /= => [|n ih]. + by rewrite /A big_ord_recr /= big_ord0 set0U; exact: GF. + rewrite /A /= big_ord_recr /= -/(A n). + rewrite (_ : _ `|` _ = ~` (~` A n `\` F n.+1)); last first. + by rewrite setDE setCI !setCK. + rewrite -setTD; apply: (setDG) => //; apply: (setDG) => //; last first. + by rewrite -setTD; apply: setDG. + apply/disjoints_subset; rewrite setIC. + by apply: (@trivIset_bigsetUI _ predT) => //; rewrite /predT /= trueE. +Qed. + +Lemma g_dynkin_dynkin G : dynkin <>. +Proof. +split=> [D /= [] []//| | ]. +- by move=> Y sGY D /= [dD GD]; exact/(dynkinC dD)/(sGY D). +- by move=> F tF gGF D /= [dD GD]; apply dD => // k; exact: gGF. +Qed. + +Lemma sigma_algebra_dynkin G : sigma_algebra setT G -> dynkin G. +Proof. +case=> ? DC DU; split => [| |? ? ?]; last exact: DU. +- by rewrite -setC0 -setTD; exact: DC. +- by move=> A GA; rewrite -setTD; apply: DC. +Qed. + +Lemma dynkin_setI_sigma_algebra G : dynkin G -> setI_closed G -> + sigma_algebra setT G. +Proof. +move=> dG GI; split => [|//|F DF]. +- by rewrite -setCT; exact/(dynkinC dG)/(dynkinT dG). +- by move=> A GA; rewrite setTD; exact: (dynkinC dG). +- rewrite seqDU_bigcup_eq; apply/(dynkinU dG) => //. + move=> n; rewrite /seqDU setDE; apply GI => //. + rewrite -bigcup_mkord setC_bigcup bigcap_mkord. + apply: big_ind => //; first by case: dG. + by move=> i _; exact/(dynkinC dG). +Qed. + +Lemma setI_closed_g_dynkin_g_sigma_algebra G : + setI_closed G -> <> = <>. +Proof. +move=> GI; rewrite eqEsubset; split. + by apply: sub_smallest2l; exact: sigma_algebra_dynkin. +pose delta (D : set T) := [set E | <> (E `&` D)]. +have ddelta (D : set T) : <> D -> dynkin (delta D). + move=> dGD; split; first by rewrite /delta /= setTI. + - move=> E DE; rewrite /delta /=. + have -> : (~` E) `&` D = ~` ((E `&` D) `|` (~` D)). + by rewrite -[LHS]setU0 -(setICl D) -setIUl -setCI -{2}(setCK D) -setCU. + have : <> ((E `&` D) `|` ~` D). + rewrite -bigcup2E => S [dS GS]; apply: (dynkinU dS). + move=> [|[|i]] [|[|j]] => // _ _; rewrite /bigcup2 /=. + + by rewrite -setIA setICr setI0 => /set0P; rewrite eqxx. + + by rewrite setI0 => /set0P; rewrite eqxx. + + by rewrite setICA setICl setI0 => /set0P; rewrite eqxx. + + by rewrite setI0 => /set0P; rewrite eqxx. + + by rewrite set0I => /set0P; rewrite eqxx. + + by rewrite set0I => /set0P; rewrite eqxx. + + by rewrite set0I => /set0P; rewrite eqxx. + move=> [|[|n]] //; rewrite /bigcup2 /=; [exact: DE| |]. + + suff: <> (~` D) by exact. + by move=> F [dF GF]; apply: (dynkinC dF) => //; exact: dGD. + + by rewrite -setCT; apply/(dynkinC dS)/(dynkinT dS). + by move=> dGEDD S /= [+ GS] => dS; apply/(dynkinC dS); exact: dGEDD. + - move=> F tF deltaDF; rewrite /delta /= => S /= [dS GS]. + rewrite setI_bigcupl; apply: (dynkinU dS) => //. + by under eq_fun do rewrite setIC; exact: trivIset_setIl. + by move=> n; exact: deltaDF. +have GdG : G `<=` <> by move=> ? ? ? [_]; apply. +have Gdelta A : G A -> G `<=` delta A. + by move=> ? ? ?; rewrite /delta /= => ? [?]; apply; exact/GI. +have GdGdelta A : G A -> <> `<=` delta A. + move=> ?; apply: smallest_sub => //; last exact: Gdelta. + by apply/ddelta; exact: GdG. +have dGGI A B : <> A -> G B -> <> (A `&` B). + by move=> ? ?; apply: GdGdelta. +have dGGdelta A : <> A -> G `<=` delta A. + by move=> ? ? ?; rewrite /delta /= setIC; exact: dGGI. +have dGdGdelta A : <> A -> <> `<=` delta A. + by move=> ?; exact: smallest_sub (ddelta _ _) (dGGdelta _ _). +have dGdGdG A B : <> A -> <> B -> <> (A `&` B). + by move=> ? ?; exact: dGdGdelta. +apply: smallest_sub => //; apply: dynkin_setI_sigma_algebra => //. +exact: g_dynkin_dynkin. +Qed. + +End dynkin_lemmas. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `setI_closed_g_dynkin_g_sigma_algebra`")] +Notation setI_closed_gdynkin_salgebra := setI_closed_g_dynkin_g_sigma_algebra (only parsing). +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `g_dynkin_dynkin`")] +Notation dynkin_g_dynkin := g_dynkin_dynkin (only parsing). +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `dynkin_lambda_system`")] +Notation dynkin_monotone := dynkin_lambda_system (only parsing). + +Section trace. +Variable (T : Type). +Implicit Types (G : set (set T)) (A D : set T). + +Definition strace G D := [set x `&` D | x in G]. + +Lemma subset_strace G C : G `<=` C -> forall D, strace G D `<=` strace C D. +Proof. by move=> GC D _ [A GA <-]; exists A => //; exact: GC. Qed. + +Lemma g_sigma_ring_strace G A B : <> B -> B `<=` A. +Proof. +move=> H; apply H => /=; split; first exact: powerset_sigma_ring. +by move=> X [A0 GA0 <-]; exact: subIsetr. +Qed. + +Lemma strace_sigma_ring G A : sigma_ring (strace <> A). +Proof. +split. +- by exists set0; rewrite ?set0I//; have [] := smallest_sigma_ring G. +- move=> _ _ [A0 GA0] <- [A1 GA1] <-. + exists (A0 `\` A1); first by have [_ + _] := smallest_sigma_ring G; exact. + by rewrite -setIDA setDIr setDv setU0 setIDAC setIDA. +- move=> F GAF. + pose f n := sval (cid2 (GAF n)). + pose Hf n := (svalP (cid2 (GAF n))).1. + pose H n := (svalP (cid2 (GAF n))).2. + exists (\bigcup_k f k). + by have [_ _] := smallest_sigma_ring G; apply => n; exact: Hf. + by rewrite setI_bigcupl; apply: eq_bigcupr => i _; exact: H. +Qed. + +(**md see Paul Halmos' Measure Theory, Ch.1, sec.5, thm.E, p.25 *) +Lemma setI_g_sigma_ring G A : strace <> A = <>. +Proof. +pose D := [set B `|` (C `\` A) | B in <> & C in <>]. +have D_sigma_ring : sigma_ring D. + split. + - exists set0; first by have [] := smallest_sigma_ring (strace G A). + exists set0; first by have [] := smallest_sigma_ring G. + by rewrite set0D setU0. + - move=> _ _ [B0 GAB0] [C0 GC0] <- [B1 GAB1] [C1 GC1] <-. + exists (B0 `\` B1). + by have [_ + _] := smallest_sigma_ring (strace G A); exact. + exists (C0 `\` C1); first by have [_ + _] := smallest_sigma_ring G; exact. + apply/esym; rewrite setDUD. + transitivity (((B0 `\` B1) `&` (B0 `\` (C1 `\` A))) `|` + ((C0 `\` (A `|` B1)) `&` (C0 `\` C1))). + congr setU; first by rewrite setDUr. + apply/seteqP; split => [x [[C0x Ax]]|x]. + move=> /not_orP[B1x /not_andP[C1x|//]]. + by split=> //; split => // -[]. + move=> [[C0x /not_orP[Ax B1x] [_ C1x]]]. + by split=> // -[//|[]]. + transitivity (((B0 `\` B1) `&` B0) `|` + ((C0 `\` A ) `&` (C0 `\` C1))). + apply/seteqP; split => [x [[[B0x B1x] [_ /not_andP[C1x|]]]| + [[C0x /not_orP[Ax B1x]] [_ C1x]]]| + x [[[B0x B1x] _]|[[C0x Ax] [_ C1x]]]]. + + by left; split. + + by move=> /contrapT Ax; left. + + by right; split. + + left; split => //; split => // -[] _; apply. + exact: (g_sigma_ring_strace GAB0). + + right; split => //; split => // -[//|B1x]; apply: Ax. + exact: (g_sigma_ring_strace GAB1). + + congr setU; first by rewrite setDE setIAC setIid. + by rewrite setDDl setDUr setIC. + - move=> F DF. + pose f n := sval (cid2 (DF n)). + pose Hf n := (svalP (cid2 (DF n))).1. + pose g n := sval (cid2 (svalP (cid2 (DF n))).2). + pose Hg n := (svalP (cid2 (svalP (cid2 (DF n))).2)).1. + exists (\bigcup_n f n). + have [_ _] := smallest_sigma_ring (strace G A). + by apply => n; exact: Hf. + exists (\bigcup_n g n). + have [_ _] := smallest_sigma_ring G. + by apply => n; exact: Hg. + pose H n := (svalP (cid2 (svalP (cid2 (DF n))).2)).2. + by rewrite setD_bigcupl -bigcupU; apply: eq_bigcupr => k _; exact: H. +apply/seteqP; split => [|]. + have GD : G `<=` D. + move=> E GE; exists (E `&` A). + by apply: sub_g_sigma_ring; exists E. + by exists E; [exact: sub_g_sigma_ring|exact: setUIDK]. + have {}GD : <> `<=` D by exact: smallest_sub GD. + have GDA : strace <> A `<=` strace D A by exact: subset_strace. + suff: strace D A = <> by move=> <-. + apply/seteqP; split. + move=> _ [_ [gA HgA [g Hg] <-] <-]. + by rewrite setIUl setDKI setU0 setIidl//; exact: (g_sigma_ring_strace HgA). + move=> X HX; exists X. + exists X => //; exists set0; rewrite ?set0D ?setU0//. + by have [] := smallest_sigma_ring G. + by rewrite setIidl//; exact: (g_sigma_ring_strace HX). +have : strace G A `<=` strace <> A. + by move=> X [Y GY <-]; exists Y => //; exact: sub_smallest GY. +by apply: smallest_sub; exact: strace_sigma_ring. +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. + +HB.mixin Record isSemiRingOfSets (d : measure_display) T := { + measurable : set (set T) ; + measurable0 : measurable set0 ; + measurableI : setI_closed measurable; + semi_measurableD : semi_setD_closed measurable; +}. + +#[short(type="semiRingOfSetsType")] +HB.structure Definition SemiRingOfSets d := + {T of Pointed T & isSemiRingOfSets d T}. + +Arguments measurable {d}%_measure_display_scope {s} _%_classical_set_scope. + +Lemma measurable_curry (T1 T2 : Type) d (T : semiRingOfSetsType d) + (G : T1 * T2 -> set T) (x : T1 * T2) : + measurable (G x) <-> measurable (curry G x.1 x.2). +Proof. by case: x. Qed. + +Notation "d .-measurable" := (@measurable d%mdisp) : classical_set_scope. +Notation "'measurable" := + (@measurable default_measure_display) : classical_set_scope. + +HB.mixin Record SemiRingOfSets_isRingOfSets d T of SemiRingOfSets d T := { + measurableU : @setU_closed T measurable +}. + +#[short(type="ringOfSetsType")] +HB.structure Definition RingOfSets d := + {T of SemiRingOfSets d T & SemiRingOfSets_isRingOfSets d T }. + +HB.mixin Record RingOfSets_isAlgebraOfSets d T of RingOfSets d T := { + measurableT : measurable [set: T] +}. + +#[short(type="algebraOfSetsType")] +HB.structure Definition AlgebraOfSets d := + {T of RingOfSets d T & RingOfSets_isAlgebraOfSets d T }. + +HB.mixin Record hasMeasurableCountableUnion d T of SemiRingOfSets d T := { + bigcupT_measurable : forall F : (set T)^nat, (forall i, measurable (F i)) -> + measurable (\bigcup_i (F i)) +}. + +HB.builders Context d T of hasMeasurableCountableUnion d T. + +Let mU : @setU_closed T measurable. +Proof. +move=> A B mA mB; rewrite -bigcup2E. +by apply: bigcupT_measurable => -[//|[//|/= _]]; exact: measurable0. +Qed. + +HB.instance Definition _ := SemiRingOfSets_isRingOfSets.Build d T mU. + +HB.end. + +#[short(type="sigmaRingType")] +HB.structure Definition SigmaRing d := + {T of SemiRingOfSets d T & hasMeasurableCountableUnion d T}. + +HB.factory Record isSigmaRing (d : measure_display) T of Pointed T := { + measurable : set (set T) ; + measurable0 : measurable set0 ; + measurableD : setD_closed measurable ; + bigcupT_measurable : forall F : (set T)^nat, (forall i, measurable (F i)) -> + measurable (\bigcup_i (F i)) +}. + +HB.builders Context d T of isSigmaRing d T. + +Let m0 : measurable set0. Proof. exact: measurable0. Qed. + +Let mI : setI_closed measurable. +Proof. by have [] := (setD_closedP measurable).1 measurableD. Qed. + +Let mD : semi_setD_closed measurable. +Proof. by apply: setD_semi_setD_closed; exact: measurableD. Qed. + +HB.instance Definition _ := isSemiRingOfSets.Build d T m0 mI mD. + +HB.instance Definition _ := hasMeasurableCountableUnion.Build d T bigcupT_measurable. + +HB.end. + +#[short(type="measurableType")] +HB.structure Definition Measurable d := + {T of AlgebraOfSets d T & hasMeasurableCountableUnion d T }. + +HB.factory Record isRingOfSets (d : measure_display) T of Pointed T := { + measurable : set (set T) ; + measurable0 : measurable set0 ; + measurableU : setU_closed measurable; + measurableD : setD_closed measurable; +}. + +HB.builders Context d T of isRingOfSets d T. +Implicit Types (A B C D : set T). + +Lemma mI : setI_closed measurable. +Proof. by have [] := (setD_closedP measurable).1 measurableD. Qed. + +Lemma mD : semi_setD_closed measurable. +Proof. by apply: setD_semi_setD_closed; exact: measurableD. Qed. + +HB.instance Definition _ := + @isSemiRingOfSets.Build d T measurable measurable0 mI mD. + +HB.instance Definition _ := SemiRingOfSets_isRingOfSets.Build d T measurableU. + +HB.end. + +HB.factory Record isRingOfSets_setY (d : measure_display) T + of Pointed T := { + measurable : set (set T) ; + measurable_nonempty : measurable !=set0 ; + measurable_setY : setY_closed measurable ; + measurable_setI : setI_closed measurable }. + +HB.builders Context d T of isRingOfSets_setY d T. + +Let m0 : measurable set0. +Proof. +have [A mA] := measurable_nonempty. +have := measurable_setY mA mA. +by rewrite setYK. +Qed. + +Let mU : setU_closed measurable. +Proof. +move=> A B mA mB; rewrite -setYU. +by apply: measurable_setY; [exact: measurable_setY|exact: measurable_setI]. +Qed. + +Let mD : setD_closed measurable. +Proof. +move=> A B mA mB; rewrite -setYD. +by apply: measurable_setY => //; exact: measurable_setI. +Qed. + +HB.instance Definition _ := isRingOfSets.Build d T m0 mU mD. + +HB.end. + +HB.factory Record isAlgebraOfSets (d : measure_display) T of Pointed T := { + measurable : set (set T) ; + measurable0 : measurable set0 ; + measurableU : setU_closed measurable; + measurableC : setC_closed measurable +}. + +HB.builders Context d T of isAlgebraOfSets d T. + +Lemma mD : setD_closed measurable. +Proof. +move=> A B mA mB; rewrite setDE -[A]setCK -setCU. +by do ?[apply: measurableU | apply: measurableC]. +Qed. + +HB.instance Definition T_isRingOfSets := @isRingOfSets.Build d T + measurable measurable0 measurableU mD. + +Lemma measurableT : measurable [set: T]. +Proof. by rewrite -setC0; apply: measurableC; exact: measurable0. Qed. + +HB.instance Definition _ := RingOfSets_isAlgebraOfSets.Build d T measurableT. + +HB.end. + +HB.factory Record isAlgebraOfSets_setD (d : measure_display) T of Pointed T := { + measurable : set (set T) ; + measurableT : measurable [set: T] ; + measurableD : setD_closed measurable +}. + +HB.builders Context d T of isAlgebraOfSets_setD d T. + +Let m0 : measurable set0. +Proof. by rewrite -(setDT setT); apply: measurableD; exact: measurableT. Qed. + +Let mU : setU_closed measurable. +Proof. +move=> A B mA mB. +rewrite -(setCK A) -setCD -!setTD; apply: measurableD; first exact: measurableT. +by do 2 apply: measurableD => //; exact: measurableT. +Qed. + +HB.instance Definition _ := isRingOfSets.Build d T m0 mU measurableD. + +HB.instance Definition _ := RingOfSets_isAlgebraOfSets.Build d T measurableT. + +HB.end. + +HB.factory Record isMeasurable (d : measure_display) T of Pointed T := { + measurable : set (set T) ; + measurable0 : measurable set0 ; + measurableC : forall A, measurable A -> measurable (~` A) ; + measurable_bigcup : forall F : (set T)^nat, (forall i, measurable (F i)) -> + measurable (\bigcup_i (F i)) +}. + +HB.builders Context d T of isMeasurable d T. + +Obligation Tactic := idtac. + +Lemma mU : setU_closed measurable. +Proof. +move=> A B mA mB; rewrite -bigcup2E. +by apply: measurable_bigcup => -[//|[//|i]]; exact: measurable0. +Qed. + +Lemma mC : setC_closed measurable. Proof. by move=> *; apply: measurableC. Qed. + +HB.instance Definition _ := @isAlgebraOfSets.Build d T + measurable measurable0 mU mC. + +HB.instance Definition _ := + @hasMeasurableCountableUnion.Build d T measurable_bigcup. + +HB.end. + +#[global] Hint Extern 0 (measurable set0) => solve [apply: measurable0] : core. +#[global] Hint Extern 0 (measurable setT) => solve [apply: measurableT] : core. + +Section ringofsets_lemmas. +Context d (T : ringOfSetsType d). +Implicit Types A B : set T. + +Lemma bigsetU_measurable I r (P : pred I) (F : I -> set T) : + (forall i, P i -> measurable (F i)) -> + measurable (\big[setU/set0]_(i <- r | P i) F i). +Proof. by move=> mF; elim/big_ind : _ => //; exact: measurableU. Qed. + +Lemma fin_bigcup_measurable I (D : set I) (F : I -> set T) : + finite_set D -> + (forall i, D i -> measurable (F i)) -> + measurable (\bigcup_(i in D) F i). +Proof. +elim/Pchoice: I => I in D F * => Dfin Fm. +rewrite -bigsetU_fset_set// big_seq; apply: bigsetU_measurable => i. +by rewrite in_fset_set ?inE// => *; apply: Fm. +Qed. + +Lemma measurableD : setD_closed (@measurable d T). +Proof. +move=> A B mA mB; case: (semi_measurableD A B) => // [D [Dfin Dl -> _]]. +by apply: fin_bigcup_measurable. +Qed. + +Lemma seqDU_measurable (F : sequence (set T)) : + (forall n, measurable (F n)) -> forall n, measurable (seqDU F n). +Proof. by move=> Fmeas n; apply/measurableD/bigsetU_measurable. Qed. + +End ringofsets_lemmas. + +Section algebraofsets_lemmas. +Context d (T : algebraOfSetsType d). +Implicit Types A B : set T. + +Lemma measurableC A : measurable A -> measurable (~` A). +Proof. by move=> mA; rewrite -setTD; exact: measurableD. Qed. + +Lemma bigsetI_measurable I r (P : pred I) (F : I -> set T) : + (forall i, P i -> measurable (F i)) -> + measurable (\big[setI/setT]_(i <- r | P i) F i). +Proof. +move=> mF; rewrite -[X in measurable X]setCK setC_bigsetI; apply: measurableC. +by apply: bigsetU_measurable => i Pi; apply/measurableC/mF. +Qed. + +Lemma fin_bigcap_measurable I (D : set I) (F : I -> set T) : + finite_set D -> + (forall i, D i -> measurable (F i)) -> + measurable (\bigcap_(i in D) F i). +Proof. +elim/Pchoice: I => I in D F * => Dfin Fm. +rewrite -bigsetI_fset_set// big_seq; apply: bigsetI_measurable => i. +by rewrite in_fset_set ?inE// => *; apply: Fm. +Qed. + +Lemma measurableID A B : measurable A -> measurable (A `&` B) -> + measurable (A `\` B). +Proof. +move=> mA /measurableC; rewrite setCI => /(measurableI A) => /(_ mA). +by rewrite setIUr setICr set0U. +Qed. + +End algebraofsets_lemmas. + +Section sigmaring_lemmas. +Context d (T : sigmaRingType d). +Implicit Types (A B : set T) (F : (set T)^nat) (P : set nat). + +Lemma bigcup_measurable F P : + (forall k, P k -> measurable (F k)) -> measurable (\bigcup_(i in P) F i). +Proof. +move=> PF; rewrite bigcup_mkcond; apply: bigcupT_measurable => k. +by case: ifP => //; rewrite inE; exact: PF. +Qed. + +Lemma bigcap_measurable F P : P !=set0 -> + (forall k, P k -> measurable (F k)) -> measurable (\bigcap_(i in P) F i). +Proof. +move=> [j Pj] PF; rewrite -(setD_bigcup F Pj). +apply: measurableD; first exact: PF. +by apply: bigcup_measurable => k/= [Pk kj]; apply: measurableD; exact: PF. +Qed. + +Lemma bigcapT_measurable F : + (forall k, measurable (F k)) -> measurable (\bigcap_i F i). +Proof. by move=> PF; apply: bigcap_measurable => //; exists 1. Qed. + +End sigmaring_lemmas. + +Lemma countable_measurable d (T : sigmaRingType d) (A : set T) : + (forall t : T, measurable [set t]) -> countable A -> measurable A. +Proof. +move=> m1; have [->//|/set0P[r Ar]/countable_injP[f injf]] := eqVneq A set0. +rewrite -(injpinv_image (cst r) injf). +rewrite [X in _ X](_ : _ = \bigcup_(x in f @` A) [set 'pinv_(cst r) A f x]). + by apply: bigcup_measurable => _ /= [s As <-]. +by rewrite eqEsubset; split=> [_ [_ [s As <-]] <-|_ [_ [s As <-]] ->]; + exists (f s). +Qed. + +Section sigma_ring_lambda_system. +Context d (T : sigmaRingType d). + +Lemma sigmaRingType_lambda_system (D : set T) : measurable D -> + lambda_system D [set X | measurable X /\ X `<=` D]. +Proof. +move=> mD; split. +- by move=> A /=[]. +- by split. +- move=> B A AB/= [mB BD] [mA AD]; split; first exact: measurableD. + by apply: subset_trans BD; exact: subDsetl. +- move=> /= F _ mFD; split. + by apply: bigcup_measurable => i _; exact: (mFD _).1. + by apply: bigcup_sub => i _; exact: (mFD _).2. +Qed. + +End sigma_ring_lambda_system. + +Lemma countable_bigcupT_measurable d (T : sigmaRingType d) U + (F : U -> set T) : countable [set: U] -> + (forall i, measurable (F i)) -> measurable (\bigcup_i F i). +Proof. +elim/Ppointed: U => U in F *; first by move=> *; rewrite empty_eq0 bigcup0. +move=> /countable_bijP[B] /ppcard_eqP[f] Fm. +rewrite (reindex_bigcup f^-1%FUN setT)//=; first exact: bigcupT_measurable. +exact: (@subl_surj _ _ B). +Qed. + +Lemma bigcupT_measurable_rat d (T : sigmaRingType d) (F : rat -> set T) : + (forall i, measurable (F i)) -> measurable (\bigcup_i F i). +Proof. exact/countable_bigcupT_measurable. Qed. + +Section measurable_lemmas. +Context d (T : measurableType d). +Implicit Types (A B : set T) (F : (set T)^nat) (P : set nat). + +Lemma sigma_algebra_measurable : sigma_algebra setT (@measurable d T). +Proof. by split=> // [A|]; [exact: measurableD|exact: bigcupT_measurable]. Qed. + +Lemma bigcap_measurableType F P : + (forall k, P k -> measurable (F k)) -> measurable (\bigcap_(i in P) F i). +Proof. +move=> PF; rewrite -[X in measurable X]setCK setC_bigcap; apply: measurableC. +by apply: bigcup_measurable => k Pk; exact/measurableC/PF. +Qed. + +End measurable_lemmas. + +Section discrete_measurable. +Context {T : Type}. + +Definition discrete_measurable : set (set T) := [set: set T]. + +Lemma discrete_measurable0 : discrete_measurable set0. Proof. by []. Qed. + +Lemma discrete_measurableC X : + discrete_measurable X -> discrete_measurable (~` X). +Proof. by []. Qed. + +Lemma discrete_measurableU (F : (set T)^nat) : + (forall i, discrete_measurable (F i)) -> + discrete_measurable (\bigcup_i F i). +Proof. by []. Qed. + +End discrete_measurable. + +HB.instance Definition _ := @isMeasurable.Build default_measure_display + unit discrete_measurable discrete_measurable0 + discrete_measurableC discrete_measurableU. + +HB.instance Definition _ := @isMeasurable.Build default_measure_display + bool discrete_measurable discrete_measurable0 + discrete_measurableC discrete_measurableU. + +HB.instance Definition _ := @isMeasurable.Build default_measure_display + nat discrete_measurable discrete_measurable0 + discrete_measurableC discrete_measurableU. + +Definition sigma_display {T} : set (set T) -> measure_display. +Proof. exact. Qed. + +Definition g_sigma_algebraType {T} (G : set (set T)) := T. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed into `g_sigma_algebraType`")] +Notation salgebraType := g_sigma_algebraType (only parsing). + +Section g_salgebra_instance. +Variables (T : pointedType) (G : set (set T)). + +Lemma sigma_algebraC (A : set T) : <> A -> <> (~` A). +Proof. by move=> sGA; rewrite -setTD; exact: sigma_algebraCD. Qed. + +HB.instance Definition _ := Pointed.on (g_sigma_algebraType G). +HB.instance Definition _ := @isMeasurable.Build (sigma_display G) + (g_sigma_algebraType G) + <> (@sigma_algebra0 _ setT G) (@sigma_algebraC) + (@sigma_algebra_bigcup _ setT G). + +End g_salgebra_instance. + +Notation "G .-sigma" := (sigma_display G) : measure_display_scope. +Notation "G .-sigma.-measurable" := + (measurable : set (set (g_sigma_algebraType G))) : classical_set_scope. + +Lemma measurable_g_measurableTypeE (T : pointedType) (G : set (set T)) : + sigma_algebra setT G -> G.-sigma.-measurable = G. +Proof. exact: sigma_algebra_id. Qed. + +Section measurability. + +Definition preimage_set_system {aT rT : Type} (D : set aT) (f : aT -> rT) + (G : set_system rT) : set (set aT) := + [set D `&` f @^-1` B | B in G]. + +Lemma preimage_set_system0 {aT rT : Type} (D : set aT) (f : aT -> rT) : + preimage_set_system D f set0 = set0. +Proof. exact: image_set0. Qed. + +Lemma preimage_set_systemU {aT rT : Type} (D : set aT) (f : aT -> rT) : + {morph preimage_set_system D f : x y / x `|` y >-> x `|` y}. +Proof. exact: image_setU. Qed. + +Lemma preimage_set_system_comp {aT bT rT : Type} (D : set aT) + (f : aT -> bT) (g : bT -> rT) (F : set_system rT) : + preimage_set_system D (g \o f) F + = preimage_set_system D f (preimage_set_system setT g F). +Proof. +apply/seteqP; split=> [_ [B FB] <-|_ [_ [C FC <-] <-]]. + by exists (g @^-1` B) => //; exists B => //; rewrite setTI. +by exists C => //; rewrite setTI comp_preimage. +Qed. + +Lemma preimage_set_system_id {aT : Type} (D : set aT) (F : set (set aT)) : + preimage_set_system D idfun F = setI D @` F. +Proof. by []. Qed. + +Lemma sigma_algebra_preimage (aT rT : Type) (G : set (set rT)) + (D : set aT) (f : aT -> rT) : + sigma_algebra setT G -> sigma_algebra D (preimage_set_system D f G). +Proof. +case=> h0 hC hU; split; first by exists set0 => //; rewrite preimage_set0 setI0. +- move=> A; rewrite /preimage_set_system /= => -[B mB <-{A}]. + exists (~` B); first by rewrite -setTD; exact: hC. + rewrite predeqE => x; split=> [[Dx Bfx]|[Dx]]; first by split => // -[] _ /Bfx. + by move=> /not_andP[]. +- move=> F; rewrite /preimage_set_system /= => mF. + have {}mF n : exists x, G x /\ D `&` f @^-1` x = F n. + by have := mF n => -[B mB <-]; exists B. + have [F' mF'] := @choice _ _ (fun x y => G y /\ D `&` f @^-1` y = F x) mF. + exists (\bigcup_k (F' k)); first by apply: hU => n; exact: (mF' n).1. + rewrite preimage_bigcup setI_bigcupr; apply: eq_bigcupr => i _. + exact: (mF' i).2. +Qed. + +Definition image_set_system (aT rT : Type) (D : set aT) (f : aT -> rT) + (G : set (set aT)) : set (set rT) := + [set B : set rT | G (D `&` f @^-1` B)]. + +Lemma sigma_algebra_image (aT rT : Type) (D : set aT) (f : aT -> rT) + (G : set (set aT)) : + sigma_algebra D G -> sigma_algebra setT (image_set_system D f G). +Proof. +move=> [G0 GC GU]; split; rewrite /image_set_system. +- by rewrite /= preimage_set0 setI0. +- move=> A /= GfAD; rewrite setTD -preimage_setC -setDE. + rewrite (_ : _ `\` _ = D `\` (D `&` f @^-1` A)); first exact: GC. + rewrite predeqE => x; split=> [[Dx fAx]|[Dx fADx]]. + by split => // -[] _ /fAx. + by split => //; exact: contra_not fADx. +- by move=> F /= mF; rewrite preimage_bigcup setI_bigcupr; exact: GU. +Qed. + +Lemma g_sigma_preimageE aT (rT : pointedType) (D : set aT) + (f : aT -> rT) (G' : set (set rT)) : + <> = + preimage_set_system D f (G'.-sigma.-measurable). +Proof. +rewrite eqEsubset; split. + have mG : sigma_algebra D + (preimage_set_system D f (G'.-sigma.-measurable)). + exact/sigma_algebra_preimage/sigma_algebra_measurable. + have subset_preimage : preimage_set_system D f G' `<=` + preimage_set_system D f (G'.-sigma.-measurable). + by move=> A [B CCB <-{A}]; exists B => //; exact: sub_sigma_algebra. + exact: smallest_sub. +have G'pre A' : G' A' -> (preimage_set_system D f G') (D `&` f @^-1` A'). + by move=> ?; exists A'. +pose I : set (set aT) := <>. +have G'sfun : G' `<=` image_set_system D f I. + by move=> A' /G'pre[B G'B h]; apply: sub_sigma_algebra; exists B. +have sG'sfun : <> `<=` image_set_system D f I. + apply: smallest_sub => //; apply: sigma_algebra_image. + exact: smallest_sigma_algebra. +by move=> _ [B mB <-]; exact: sG'sfun. +Qed. + +End measurability. +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `preimage_set_system`")] +Notation preimage_class := preimage_set_system (only parsing). +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `image_set_system`")] +Notation image_class := image_set_system (only parsing). +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `sigma_algebra_preimage`")] +Notation sigma_algebra_preimage_class := sigma_algebra_preimage (only parsing). +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `sigma_algebra_image`")] +Notation sigma_algebra_image_class := sigma_algebra_image (only parsing). + +#[deprecated(since="mathcomp-analysis 1.9.0", note="renamed to `g_sigma_preimageE`")] +Notation sigma_algebra_preimage_classE := g_sigma_preimageE (only parsing). + +(** This predicate is used also by `measure_function.v` *) +Definition subset_sigma_subadditive {T} {R : numFieldType} + (mu : set T -> \bar R) (A : set T) (F : nat -> set T) := + A `<=` \bigcup_n F n -> (mu A <= \sum_(n set T) (F : set T -> R) : + finite_set D -> trivIset D A -> F set0 = idx -> + \big[op/idx]_(i <- fset_set D) F (A i) = + \big[op/idx]_(X <- (A @` fset_set D)%fset) F X. +Proof. +elim/Pchoice: R => R in idx op F *. +move=> Dfin Atriv F0; symmetry. +pose D' := [fset i in fset_set D | A i != set0]%fset. +transitivity (\big[op/idx]_(X <- (A @` D')%fset) F X). + apply: perm_big_supp; rewrite uniq_perm ?filter_uniq//=. + move=> X; rewrite !mem_filter; case: (eqVneq (F X) idx) => //= FXNidx. + apply/imfsetP/imfsetP=> -[i/=]; rewrite ?(inE, in_fset_set)//=. + move=> Di XAi; exists i; rewrite // !(inE, in_fset_set)//=. + by rewrite (mem_set Di)/= -XAi; apply: contra_neq FXNidx => ->. + by move=> /andP[Di AiN0] XAi; exists i; rewrite ?in_fset_set. +rewrite big_imfset//=; last first. + move=> i j; rewrite !(inE, in_fset_set)//= => /andP[+ +] /andP[+ +]. + rewrite !inE => Di /set0P[x Aix] Dj _ Aij. + by apply: (Atriv _ _ Di Dj); exists x; split=> //; rewrite -Aij. +apply: perm_big_supp; rewrite uniq_perm ?filter_uniq//= => i. +rewrite !mem_filter; case: (eqVneq (F (A i)) idx) => //= FAiidx. +rewrite !(in_fset_set, inE)//=; case: (boolP (i \in D)) => //= Di. +by apply: contra_neq FAiidx => ->. +Qed. + +Section covering. +Context {T : Type}. +Implicit Type (C : forall I, set (set I)). +Implicit Type (P : forall I, set I -> set (I -> set T)). + +(* TODO: undocumented *) +Definition covered_by C P := + [set X : set T | exists I D A, [/\ C I D, P I D A & X = \bigcup_(i in D) A i]]. + +Lemma covered_bySr C P P' : (forall I D A, P I D A -> P' I D A) -> + covered_by C P `<=` covered_by C P'. +Proof. +by move=> PP' X [I [D [A [CX PX ->]]]]; exists I, D, A; split=> //; apply: PP'. +Qed. + +Lemma covered_byP C P I D A : C I D -> P I D A -> + covered_by C P (\bigcup_(i in D) A i). +Proof. by move=> CID PIDA; exists I, D, A. Qed. + +Lemma covered_by_finite P : + (forall I (D : set I) A, (forall i, D i -> A i = set0) -> P I D A) -> + (forall (I : pointedType) D A, finite_set D -> P I D A -> + P nat `I_#|` fset_set D| (A \o nth point (fset_set D))) -> + covered_by (@finite_set) P = + [set X : set T | exists n A, [/\ P nat `I_n A & X = \bigcup_(i < n) A i]]. +Proof. +move=> P0 Pc; apply/predeqP=> X; rewrite /covered_by /cover/=; split; last first. + by move=> [n [A [Am ->]]]; exists nat, `I_n, A; split. +case; elim/Ppointed=> I [D [A [Dfin Am ->]]]. + exists 0%N, (fun=> set0); split; first by rewrite II0; apply: P0. + by rewrite //= emptyE II0 !bigcup0. +exists #|`fset_set D|, (A \o nth point (fset_set D)). +split; first exact: Pc. +by rewrite -bigsetU_fset_set// (big_nth point) big_mkord bigcup_mkord. +Qed. + +Lemma covered_by_countable P : + (forall I (D : set I) A, (forall i, D i -> A i = set0) -> P I D A) -> + (forall (I : choiceType) (D : set I) (A : I -> set T) (f : nat -> I), + set_surj [set: nat] D f -> + P I D A -> P nat [set: nat] (A \o f)) -> + covered_by (@countable) P = + [set X : set T | exists A, [/\ P nat [set: nat] A & X = \bigcup_i A i]]. +Proof. +move=> P0 Pc; apply/predeqP=> X; rewrite /covered_by /cover/=; split; last first. + by move=> [A [Am ->]]; exists nat, [set: nat], A; split. +case; elim/Ppointed=> I [D [A [Dcnt Am ->]]]. + exists (fun=> set0); split; first exact: P0. + by rewrite emptyE bigcup_set0 bigcup0. +have /pfcard_geP[->|[f]] := Dcnt. + exists (fun=> set0); split; first exact: P0. + by rewrite !bigcup_set0 bigcup0. +pose g := [splitsurjfun of split f]. +exists (A \o g); split=> /=; first exact: Pc Am. +apply/predeqP=> x; split=> [[i Di Aix]|[n _ Afnx]]. + by exists (g^-1%FUN i) => //=; rewrite invK// inE. +by exists (g n) => //; apply: funS. +Qed. + +End covering. + +Lemma measurable_uncurry (T1 T2 : Type) d (T : semiRingOfSetsType d) + (G : T1 -> T2 -> set T) (x : T1 * T2) : + measurable (G x.1 x.2) <-> measurable (uncurry G x). +Proof. by case: x. Qed. + +Definition g_sigma_preimageU d1 d2 + (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2) (T : Type) + (f1 : T -> T1) (f2 : T -> T2) := + <>. +#[deprecated(since="mathcomp-analysis 1.9.0", + note="renamed to `g_sigma_preimageU`")] +Notation preimage_classes := g_sigma_preimageU (only parsing). + +Section product_lemma. +Context d1 d2 (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2). +Variables (T : pointedType) (f1 : T -> T1) (f2 : T -> T2). +Variables (T3 : Type) (g : T3 -> T). + +Lemma g_sigma_preimageU_comp : g_sigma_preimageU (f1 \o g) (f2 \o g) = + preimage_set_system setT g (g_sigma_preimageU f1 f2). +Proof. +rewrite {1}/g_sigma_preimageU -g_sigma_preimageE; congr (<>). +rewrite predeqE => C; split. +- move=> [[A mA <-{C}]|[A mA <-{C}]]. + + by exists (f1 @^-1` A) => //; left; exists A => //; rewrite setTI. + + by exists (f2 @^-1` A) => //; right; exists A => //; rewrite setTI. +- move=> [A [[B mB <-{A} <-{C}]|[B mB <-{A} <-{C}]]]. + + by left; rewrite !setTI; exists B => //; rewrite setTI. + + by right; rewrite !setTI; exists B => //; rewrite setTI. +Qed. + +End product_lemma. +#[deprecated(since="mathcomp-analysis 1.9.0", + note="renamed to `g_sigma_preimageU_comp`")] +Notation preimage_classes_comp := g_sigma_preimageU_comp (only parsing). + +Definition measure_prod_display : + (measure_display * measure_display) -> measure_display. +Proof. exact. Qed. + +Section product_salgebra_instance. +Context d1 d2 (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2). +Let f1 := @fst T1 T2. +Let f2 := @snd T1 T2. + +Let prod_salgebra_set0 : g_sigma_preimageU f1 f2 (set0 : set (T1 * T2)). +Proof. exact: sigma_algebra0. Qed. + +Let prod_salgebra_setC A : g_sigma_preimageU f1 f2 A -> + g_sigma_preimageU f1 f2 (~` A). +Proof. exact: sigma_algebraC. Qed. + +Let prod_salgebra_bigcup (F : _^nat) : + (forall i, g_sigma_preimageU f1 f2 (F i)) -> + g_sigma_preimageU f1 f2 (\bigcup_i (F i)). +Proof. exact: sigma_algebra_bigcup. Qed. + +HB.instance Definition _ := Pointed.on (T1 * T2)%type. +HB.instance Definition prod_salgebra_mixin := + @isMeasurable.Build (measure_prod_display (d1, d2)) + (T1 * T2)%type (g_sigma_preimageU f1 f2) + (prod_salgebra_set0) (prod_salgebra_setC) (prod_salgebra_bigcup). + +End product_salgebra_instance. +Notation "p .-prod" := (measure_prod_display p) : measure_display_scope. +Notation "p .-prod.-measurable" := + ((p.-prod).-measurable : set (set (_ * _))) : + classical_set_scope. + +Lemma measurableX d1 d2 (T1 : semiRingOfSetsType d1) (T2 : semiRingOfSetsType d2) + (A : set T1) (B : set T2) : + measurable A -> measurable B -> measurable (A `*` B). +Proof. +move=> mA mB. +have -> : A `*` B = (A `*` setT) `&` (setT `*` B) :> set (T1 * T2). + by rewrite -{1}(setIT A) -{1}(setTI B) setXI. +rewrite setXT setTX; apply: measurableI. +- by apply: sub_sigma_algebra; left; exists A => //; rewrite setTI. +- by apply: sub_sigma_algebra; right; exists B => //; rewrite setTI. +Qed. +#[deprecated(since="mathcomp-analysis 1.3.0", note="renamed `measurableX`")] +Notation measurableM := measurableX (only parsing). + +Section product_salgebra_algebraOfSetsType. +Context d1 d2 (T1 : algebraOfSetsType d1) (T2 : algebraOfSetsType d2). +Let M1 := @measurable _ T1. +Let M2 := @measurable _ T2. +Let M1xM2 := [set A `*` B | A in M1 & B in M2]. + +Lemma measurable_prod_measurableType : + (d1, d2).-prod.-measurable = <>. +Proof. +rewrite eqEsubset; split. + apply: smallest_sub; first exact: smallest_sigma_algebra. + rewrite subUset; split. + - have /subset_trans : preimage_set_system setT fst M1 `<=` M1xM2. + by move=> _ [X MX <-]; exists X=> //; exists setT; rewrite /M2 // setIC//. + by apply; exact: sub_sigma_algebra. + - have /subset_trans : preimage_set_system setT snd M2 `<=` M1xM2. + by move=> _ [Y MY <-]; exists setT; rewrite /M1 //; exists Y. + by apply; exact: sub_sigma_algebra. +apply: smallest_sub; first exact: smallest_sigma_algebra. +by move=> _ [A ?] [B ?] <-; apply: measurableX => //; exact: sub_sigma_algebra. +Qed. + +End product_salgebra_algebraOfSetsType. + +Section product_salgebra_g_measurableTypeR. +Context d1 (T1 : algebraOfSetsType d1) (T2 : pointedType) (C2 : set (set T2)). +Hypothesis setTC2 : setT `<=` C2. + +(* NB: useful? *) +Lemma measurable_prod_g_measurableTypeR : + @measurable _ (T1 * g_sigma_algebraType C2)%type + = <>. +Proof. +rewrite measurable_prod_measurableType //; congr (<>). +rewrite predeqE => X; split=> [[A mA] [B mB] <-{X}|[A C1A] [B C2B] <-{X}]. + by exists A => //; exists B => //; exact: setTC2. +by exists A => //; exists B => //; exact: sub_sigma_algebra. +Qed. + +End product_salgebra_g_measurableTypeR. + +Section product_salgebra_g_measurableType. +Variables (T1 T2 : pointedType) (C1 : set (set T1)) (C2 : set (set T2)). +Hypotheses (setTC1 : setT `<=` C1) (setTC2 : setT `<=` C2). + +Lemma measurable_prod_g_measurableType : + @measurable _ (g_sigma_algebraType C1 * g_sigma_algebraType C2)%type = + <>. +Proof. +rewrite measurable_prod_measurableType //; congr (<>). +rewrite predeqE => X; split=> [[A mA] [B mB] <-{X}|[A C1A] [B C2B] <-{X}]. + by exists A; [exact: setTC1|exists B => //; exact: setTC2]. +by exists A; [exact: sub_sigma_algebra|exists B => //; exact: sub_sigma_algebra]. +Qed. + +End product_salgebra_g_measurableType. + +Definition g_sigma_preimage d (rT : semiRingOfSetsType d) (aT : Type) + (n : nat) (f : 'I_n -> aT -> rT) : set (set aT) := + <>. + +Lemma g_sigma_preimage_comp d1 {T1 : semiRingOfSetsType d1} n + {T : pointedType} (f : 'I_n -> T -> T1) {T2 : Type} (g : T2 -> T) : + g_sigma_preimage (fun i => f i \o g) = + preimage_set_system [set: T2] g (g_sigma_preimage f). +Proof. +rewrite -[RHS]g_sigma_preimageE; congr (<>). +case: n => [|n] in f *; first by rewrite !big_ord0 preimage_set_system0. +rewrite predeqE => B; split. +- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{B}]]. + have iE : Ordinal Ii = inord i by apply/val_inj => /=; rewrite inordK. + exists (f (inord i) @^-1` A) => //. + rewrite -bigcup_mkord_ord; exists i => //. + by exists A => //; rewrite -iE setTI. +- move=> [C]. + rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]] <-{B}. + rewrite -bigcup_mkord_ord; exists i => //. + by exists A => //; rewrite !setTI -comp_preimage. +Qed. + +Definition measure_tuple_display : measure_display -> measure_display. +Proof. exact. Qed. + +Section measurable_tuple. +Context {d} {T : sigmaRingType d}. +Variable n : nat. + +Let coors : 'I_n -> n.-tuple T -> T := fun i x => @tnth n T x i. + +Let tuple_set0 : g_sigma_preimage coors set0. +Proof. exact: sigma_algebra0. Qed. + +Let tuple_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). +Proof. exact: sigma_algebraC. Qed. + +Let tuple_bigcup (F : _^nat) : (forall i, g_sigma_preimage coors (F i)) -> + g_sigma_preimage coors (\bigcup_i (F i)). +Proof. exact: sigma_algebra_bigcup. Qed. + +HB.instance Definition _ := @isMeasurable.Build (measure_tuple_display d) + (n.-tuple T) (g_sigma_preimage coors) tuple_set0 tuple_setC tuple_bigcup. + +End measurable_tuple. + +Section absolute_continuity. +Context d (T : semiRingOfSetsType d) (R : realType). +Implicit Types m : set T -> \bar R. + +Definition measure_dominates m1 m2 := + forall A, measurable A -> m2 A = 0 -> m1 A = 0. + +Local Notation "m1 `<< m2" := (measure_dominates m1 m2). + +Lemma measure_dominates_trans m1 m2 m3 : m1 `<< m2 -> m2 `<< m3 -> m1 `<< m3. +Proof. by move=> m12 m23 A mA /m23-/(_ mA) /m12; exact. Qed. + +End absolute_continuity. +Notation "m1 `<< m2" := (measure_dominates m1 m2). diff --git a/theories/measure_theory/measure.v b/theories/measure_theory/measure.v new file mode 100644 index 0000000000..39bfa496f4 --- /dev/null +++ b/theories/measure_theory/measure.v @@ -0,0 +1,9 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Export measurable_structure. +From mathcomp Require Export measure_function. +From mathcomp Require Export counting_measure. +From mathcomp Require Export dirac_measure. +From mathcomp Require Export probability_measure. +From mathcomp Require Export measure_negligible. +From mathcomp Require Export measure_extension. +From mathcomp Require Export measurable_function. diff --git a/theories/measure_theory/measure_extension.v b/theories/measure_theory/measure_extension.v new file mode 100644 index 0000000000..6cfcb8077f --- /dev/null +++ b/theories/measure_theory/measure_extension.v @@ -0,0 +1,808 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure measure_function. +From mathcomp Require Import measure_negligible. + +(**md**************************************************************************) +(* # Measure Extension *) +(* *) +(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) +(* *) +(* ## Measure Extension Theorem: *) +(* *) +(* This file provides the Measure Extension theorem that builds a measure *) +(* given a function defined over a semiring of sets, the intermediate outer *) +(* measure being *) +(* $\inf_F\{ \sum_{k=0}^\infty \mu(F_k) | X \subseteq \bigcup_k F_k\}.$ *) +(* *) +(* ``` *) +(* sigma_subadditive mu == predicate defining sigma-subadditivity *) +(* {outer_measure set T -> \bar R} == type of an outer measure over sets *) +(* of elements of type T : Type where R is *) +(* expected to be a numFieldType *) +(* The HB class is OuterMeasure. *) +(* interfaces: isOuterMeasure, *) +(* isSubsetOuterMeasure *) +(* ``` *) +(* *) +(* ``` *) +(* mu.-caratheodory == the set of Caratheodory measurable sets for the *) +(* outer measure mu, i.e., sets A such that *) +(* forall B, mu A = mu (A `&` B) + mu (A `&` ~` B) *) +(* caratheodory_type mu := T, where mu : {outer_measure set T -> \bar R} *) +(* It is a canonical measurableType copy of T. *) +(* The restriction of the outer measure mu to the *) +(* sigma algebra of Caratheodory measurable sets is *) +(* a measure. *) +(* Remark: sets that are negligible for *) +(* this measure are Caratheodory measurable. *) +(* mu .-cara.-measurable == sigma-algebra of Caratheodory measurable sets *) +(* ``` *) +(* *) +(* From a premeasure to an outer measure (Measure Extension Theorem part 1): *) +(* ``` *) +(* measurable_cover X == the set of sequences F such that *) +(* - forall k, F k is measurable *) +(* - X `<=` \bigcup_k (F k) *) +(* mu^* == extension of the measure mu over a semiring of *) +(* sets (it is an outer measure) *) +(* ``` *) +(* *) +(* From an outer measure to a measure (Measure Extension Theorem part 2): *) +(* ``` *) +(* measure_extension mu == extension of the content mu over a *) +(* semiring of sets to a measure over the *) +(* generated sigma algebra (requires a proof of *) +(* sigma-sub-additivity) *) +(* ``` *) +(* *) +(* ``` *) +(* completed_measure_extension mu == similar to measure_extension but returns *) +(* a complete measure *) +(* ``` *) +(* *) +(******************************************************************************) + +(*Reserved Notation "{ 'outer_measure' fUV }" (format "{ 'outer_measure' fUV }"). +Reserved Notation "[ 'outer_measure' 'of' f 'as' g ]" + (format "[ 'outer_measure' 'of' f 'as' g ]"). +Reserved Notation "[ 'outer_measure' 'of' f ]" + (format "[ 'outer_measure' 'of' f ]").*) +Reserved Notation "{ 'outer_measure' 'set' T '->' '\bar' R }" + (T at level 37, format "{ 'outer_measure' 'set' T '->' '\bar' R }"). +Reserved Notation "mu .-caratheodory" (format "mu .-caratheodory"). +Reserved Notation "mu .-cara" (format "mu .-cara"). +Reserved Notation "mu .-cara.-measurable" (format "mu .-cara.-measurable"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Local Open Scope ereal_scope. + +Definition sigma_subadditive {T} {R : numFieldType} + (mu : set T -> \bar R) := forall (F : (set T) ^nat), + mu (\bigcup_n (F n)) <= \sum_(i \bar R) := { + outer_measure0 : mu set0 = 0 ; + outer_measure_ge0 : forall x, 0 <= mu x ; + le_outer_measure : {homo mu : A B / A `<=` B >-> A <= B} ; + outer_measure_sigma_subadditive : sigma_subadditive mu }. + +#[short(type=outer_measure)] +HB.structure Definition OuterMeasure (R : numFieldType) (T : Type) := + {mu & isOuterMeasure R T mu}. + +Notation "{ 'outer_measure' 'set' T '->' '\bar' R }" := (outer_measure R T) + : ring_scope. + +#[global] Hint Extern 0 (_ set0 = 0%R) => solve [apply: outer_measure0] : core. +#[global] Hint Extern 0 (sigma_subadditive _) => + solve [apply: outer_measure_sigma_subadditive] : core. + +Arguments outer_measure0 {R T} _. +Arguments outer_measure_ge0 {R T} _. +Arguments le_outer_measure {R T} _. +Arguments outer_measure_sigma_subadditive {R T} _. + +HB.factory Record isSubsetOuterMeasure + (R : realType) (T : Type) (mu : set T -> \bar R) := { + outer_measure0 : mu set0 = 0 ; + outer_measure_ge0 : forall x, 0 <= mu x ; + subset_outer_measure_sigma_subadditive : + forall A F, subset_sigma_subadditive mu A F}. + +HB.builders Context {R : realType} T mu of isSubsetOuterMeasure R T mu. + +Lemma le_outer_measure : {homo mu : A B / A `<=` B >-> A <= B}. +Proof. +move=> A B AB; pose B_ k := if k is 0%N then B else set0. +have -> : mu B = \sum_(n *; rewrite outer_measure_ge0. + rewrite eseries_cond/= eseries0 ?adde0// => -[|]//= k _ _. + by rewrite outer_measure0. +apply: subset_outer_measure_sigma_subadditive => //. +by rewrite bigcup_recl/= bigcup0 ?setU0// => -[/negP|]. +Qed. + +Lemma outer_measure_sigma_subadditive : sigma_subadditive mu. +Proof. by move=> F; exact: subset_outer_measure_sigma_subadditive. Qed. + +HB.instance Definition _ := isOuterMeasure.Build R T mu outer_measure0 + outer_measure_ge0 le_outer_measure outer_measure_sigma_subadditive. + +HB.end. + +Lemma outer_measure_sigma_subadditive_tail (T : Type) (R : realType) + (mu : {outer_measure set T -> \bar R}) N (F : (set T) ^nat) : + (mu (\bigcup_(n in ~` `I_N) (F n)) <= \sum_(N <= i if n \in ~` `I_N then F n else set0). +move/le_trans; apply. +rewrite [in leRHS]eseries_cond [in leRHS]eseries_mkcondr; apply: lee_nneseries. +- by move=> k _ _; exact: outer_measure_ge0. +- move=> k _; rewrite fun_if; case: ifPn => Nk; first by rewrite mem_not_I Nk. + by rewrite mem_not_I (negbTE Nk) outer_measure0. +Qed. + +Section outer_measureU. +Context (T : Type) (R : realType). +Variable mu : {outer_measure set T -> \bar R}. +Local Open Scope ereal_scope. + +Lemma outer_measure_subadditive (F : (set T)^nat) n : + mu (\big[setU/set0]_(i < n) F i) <= \sum_(i < n) mu (F i). +Proof. +pose F' := fun k => if (k < n)%N then F k else set0. +rewrite -(big_mkord xpredT F) big_nat (eq_bigr F')//; last first. + by move=> k /= kn; rewrite /F' kn. +rewrite -big_nat big_mkord. +have := outer_measure_sigma_subadditive mu F'. +rewrite (bigcup_splitn n) (_ : bigcup _ _ = set0) ?setU0; last first. + by rewrite bigcup0 // => k _; rewrite /F' /= ltnNge leq_addr. +move/le_trans; apply. +rewrite (nneseries_split _ n); last by move=> ? ?; exact: outer_measure_ge0. +rewrite [X in _ + X]eseries0 ?adde0; last first. + by move=> k nk _; rewrite /F' ltnNge nk/= outer_measure0. +by rewrite big_mkord; apply: lee_sum => i _; rewrite /F' ltn_ord. +Qed. + +Lemma outer_measureU2 A B : mu (A `|` B) <= mu A + mu B. +Proof. +have := outer_measure_subadditive (bigcup2 A B) 2. +by rewrite !big_ord_recl/= !big_ord0 setU0 adde0. +Qed. + +End outer_measureU. + +Local Open Scope ereal_scope. +Lemma le_outer_measureIC (R : realFieldType) T + (mu : {outer_measure set T -> \bar R}) (A X : set T) : + mu X <= mu (X `&` A) + mu (X `&` ~` A). +Proof. +pose B : (set T) ^nat := bigcup2 (X `&` A) (X `&` ~` A). +have cvg_mu : (fun n => \sum_(i < n) mu (B i)) @ \oo --> mu (B 0%N) + mu (B 1%N). + rewrite -2!cvg_shiftS /=. + rewrite [X in X @ \oo --> _](_ : _ = (fun=> mu (B 0%N) + mu (B 1%N))); last first. + rewrite funeqE => i; rewrite 2!big_ord_recl /= big1 ?adde0 // => j _. + by rewrite /B /bigcup2 /=. + exact: cvg_cst. +have := outer_measure_sigma_subadditive mu B. +suff : \bigcup_n B n = X. + move=> -> /le_trans; apply; under eq_fun do rewrite big_mkord. + by rewrite (cvg_lim _ cvg_mu). +transitivity (\big[setU/set0]_(i < 2) B i). + by rewrite (bigcup_splitn 2) // -bigcup_mkord setUidl// => t -[]. +by rewrite 2!big_ord_recl big_ord0 setU0 /= -setIUr setUCr setIT. +Unshelve. all: by end_near. Qed. +Local Close Scope ereal_scope. + +Definition caratheodory_measurable (R : realType) (T : Type) + (mu : set T -> \bar R) (A : set T) := forall X, + mu X = mu (X `&` A) + mu (X `&` ~` A). + +Notation "mu .-caratheodory" := + (caratheodory_measurable mu) : classical_set_scope. + +Lemma le_caratheodory_measurable (R : realType) T + (mu : {outer_measure set T -> \bar R}) (A : set T) : + (forall X, mu (X `&` A) + mu (X `&` ~` A) <= mu X)%E -> + mu.-caratheodory A. +Proof. +move=> suf X; apply/eqP; rewrite eq_le; apply/andP; split; + [exact: le_outer_measureIC | exact: suf]. +Qed. + +Section caratheodory_theorem_sigma_algebra. +Local Open Scope ereal_scope. +Variables (R : realType) (T : Type) (mu : {outer_measure set T -> \bar R}). + +Lemma outer_measure_bigcup_lim (A : (set T) ^nat) X : + mu (X `&` \bigcup_k A k) <= \sum_(k X `&` A n))). +by apply/le_outer_measure; rewrite setI_bigcupr. +Qed. + +Let M := mu.-caratheodory. + +Lemma caratheodory_measurable_set0 : M set0. +Proof. by move=> X /=; rewrite setI0 outer_measure0 add0e setC0 setIT. Qed. + +Lemma caratheodory_measurable_setC A : M A -> M (~` A). +Proof. by move=> MA X; rewrite setCK addeC -MA. Qed. + +Lemma caratheodory_measurable_setU_le (X A B : set T) : + mu.-caratheodory A -> mu.-caratheodory B -> + mu (X `&` (A `|` B)) + mu (X `&` ~` (A `|` B)) <= mu X. +Proof. +move=> mA mB; pose Y := X `&` A `|` X `&` B `&` ~` A. +have /(leeD2r (mu (X `&` ~` (A `|` B)))) : + mu Y <= mu (X `&` A) + mu (X `&` B `&` ~` A). + pose Z := bigcup2 (X `&` A) (X `&` B `&` ~` A). + have -> : Y = \bigcup_k Z k. + rewrite predeqE => t; split=> [[?|?]|[]]; [by exists O|by exists 1%N|]. + by move=> [_ ?|[_ ?|//]]; [left|right]. + rewrite (le_trans (outer_measure_sigma_subadditive mu Z))//. + rewrite le_eqVlt; apply/orP; left; apply/eqP. + apply/cvg_lim => //; rewrite -(cvg_shiftn 2)/=; apply: cvg_near_cst. + apply: nearW => k; rewrite big_mkord addn2 2!big_ord_recl big1 ?adde0//. + by move=> ? _; exact: outer_measure0. +have /le_trans : mu (X `&` (A `|` B)) + mu (X `&` ~` (A `|` B)) <= + mu Y + mu (X `&` ~` (A `|` B)). + rewrite setIUr (_ : X `&` A `|` X `&` B = Y) //. + rewrite /Y -[in LHS](setIT B) -(setUCr A) 2!setIUr setUC -[in RHS]setIA. + rewrite setUC setUA; congr (_ `|` _). + by rewrite setUidPl setICA; apply: subIset; right. +suff -> : mu (X `&` A) + mu (X `&` B `&` ~` A) + + mu (X `&` (~` (A `|` B))) = mu X by exact. +by rewrite setCU setIA -(setIA X) setICA (setIC B) -addeA -mB -mA. +Qed. + +Lemma caratheodory_measurable_setU A B : M A -> M B -> M (A `|` B). +Proof. +move=> mA mB X; apply/eqP; rewrite eq_le. +by rewrite le_outer_measureIC andTb caratheodory_measurable_setU_le. +Qed. + +Lemma caratheodory_measurable_bigsetU (A : (set T) ^nat) : + (forall n, M (A n)) -> forall n, M (\big[setU/set0]_(i < n) A i). +Proof. +move=> MA n; elim/big_ind : _ => //; first exact: caratheodory_measurable_set0. +exact: caratheodory_measurable_setU. +Qed. + +Lemma caratheodory_measurable_setI A B : M A -> M B -> M (A `&` B). +Proof. +move=> mA mB; rewrite -(setCK A) -(setCK B) -setCU. +by apply/caratheodory_measurable_setC/caratheodory_measurable_setU; + exact/caratheodory_measurable_setC. +Qed. + +Lemma caratheodory_measurable_setD A B : M A -> M B -> M (A `\` B). +Proof. +move=> mA mB; rewrite setDE; apply: caratheodory_measurable_setI => //. +exact: caratheodory_measurable_setC. +Qed. + +Section additive_ext_lemmas. +Variable A B : set T. +Hypothesis (mA : M A) (mB : M B). + +Let caratheodory_decomp X : + mu X = mu (X `&` A `&` B) + mu (X `&` A `&` ~` B) + + mu (X `&` ~` A `&` B) + mu (X `&` ~` A `&` ~` B). +Proof. by rewrite mA mB [X in _ + _ + X = _]mB addeA. Qed. + +(* TODO: not used? *) +Let caratheodory_decompIU X : mu (X `&` (A `|` B)) = + mu (X `&` A `&` B) + mu (X `&` ~` A `&` B) + mu (X `&` A `&` ~` B). +Proof. +rewrite caratheodory_decomp -!addeA; congr (mu _ + _). + rewrite -!setIA; congr (_ `&` _). + by rewrite setIC; apply/setIidPl; apply: subIset; left; exact: subsetUl. +rewrite addeA addeC [X in mu X + _](_ : _ = set0); last first. + by rewrite -setIA -setCU -setIA setICr setI0. +rewrite outer_measure0 add0e addeC -!setIA; congr (mu (X `&` _) + mu (X `&` _)). + by rewrite setIC; apply/setIidPl; apply: subIset; right; exact: subsetUr. +by rewrite setIC; apply/setIidPl; apply: subIset; left; exact: subsetUl. +Qed. + +Lemma disjoint_caratheodoryIU X : [disjoint A & B] -> + mu (X `&` (A `|` B)) = mu (X `&` A) + mu (X `&` B). +Proof. +move=> /eqP AB; rewrite caratheodory_decomp -setIA AB setI0 outer_measure0. +rewrite add0e addeC -setIA -setCU -setIA setICr setI0 outer_measure0 add0e. +rewrite -!setIA; congr (mu (X `&` _ ) + mu (X `&` _)). +rewrite (setIC A) setIA setIC; apply/setIidPl. +- by rewrite setIUl setICr setU0 subsetI; move/disjoints_subset in AB; split. +- rewrite setIA setIC; apply/setIidPl; rewrite setIUl setICr set0U. + by move: AB; rewrite setIC => /disjoints_subset => AB; rewrite subsetI; split. +Qed. + +End additive_ext_lemmas. + +Lemma caratheodory_additive (A : (set T) ^nat) : (forall n, M (A n)) -> + trivIset setT A -> forall n X, + mu (X `&` \big[setU/set0]_(i < n) A i) = \sum_(i < n) mu (X `&` A i). +Proof. +move=> MA ta; elim=> [|n ih] X; first by rewrite !big_ord0 setI0 outer_measure0. +rewrite big_ord_recr /= disjoint_caratheodoryIU // ?ih ?big_ord_recr //. +- exact: caratheodory_measurable_bigsetU. +- by apply/eqP/(@trivIset_bigsetUI _ predT) => //; rewrite /predT /= trueE. +Qed. + +Lemma caratheodory_lime_le (A : (set T) ^nat) : (forall n, M (A n)) -> + trivIset setT A -> forall X, + \sum_(k MA tA X. +set A' := \bigcup_k A k; set B := fun n => \big[setU/set0]_(k < n) (A k). +suff : forall n, \sum_(k < n) mu (X `&` A k) + mu (X `&` ~` A') <= mu X. + move=> XA; rewrite (_ : limn _ = ereal_sup + ((fun n => \sum_(k < n) mu (X `&` A k)) @` setT)); last first. + under eq_fun do rewrite big_mkord. + apply/cvg_lim => //; apply: ereal_nondecreasing_cvgn. + apply: (lee_sum_nneg_ord (fun n => mu (X `&` A n)) xpredT) => n _. + exact: outer_measure_ge0. + move XAx : (mu (X `&` ~` A')) => [x| |]. + - rewrite -leeBrDr //; apply: ub_ereal_sup => /= _ [n _] <-. + by rewrite EFinN leeBrDr // -XAx XA. + - suff : mu X = +oo by move=> ->; rewrite leey. + by apply/eqP; rewrite -leye_eq -XAx le_outer_measure. + - by rewrite addeNy leNye. +move=> n. +apply: (@le_trans _ _ (\sum_(k < n) mu (X `&` A k) + mu (X `&` ~` B n))). + apply/leeD2l/le_outer_measure; apply: setIS; exact/subsetC/bigsetU_bigcup. +rewrite [in leRHS](caratheodory_measurable_bigsetU MA n) leeD2r//. +by rewrite caratheodory_additive. +Qed. + +Lemma caratheodory_measurable_trivIset_bigcup (A : (set T) ^nat) : + (forall n, M (A n)) -> trivIset setT A -> M (\bigcup_k (A k)). +Proof. +move=> MA tA; apply: le_caratheodory_measurable => X /=. +have /(leeD2r (mu (X `&` ~` (\bigcup_k A k)))) := outer_measure_bigcup_lim A X. +by move/le_trans; apply; exact: caratheodory_lime_le. +Qed. + +Lemma caratheodory_measurable_bigcup (A : (set T) ^nat) : (forall n, M (A n)) -> + M (\bigcup_k (A k)). +Proof. +move=> MA; rewrite -eq_bigcup_seqD_bigsetU. +apply/caratheodory_measurable_trivIset_bigcup; last first. + by apply: trivIset_seqD => m n mn; exact/subsetPset/subset_bigsetU. +by case=> [|n /=]; [| apply/caratheodory_measurable_setD => //]; + exact/caratheodory_measurable_bigsetU. +Qed. + +End caratheodory_theorem_sigma_algebra. + +Definition caratheodory_type (R : realType) (T : Type) + (mu : set T -> \bar R) := T. + +Notation "mu .-cara.-measurable" := + (measurable : set (set (caratheodory_type mu))) : classical_set_scope. + +Definition caratheodory_display R T : (set T -> \bar R) -> measure_display. +Proof. exact. Qed. + +Notation "mu .-cara" := (caratheodory_display mu) : measure_display_scope. + +Section caratheodory_sigma_algebra. +Variables (R : realType) (T : pointedType) (mu : {outer_measure set T -> \bar R}). + +HB.instance Definition _ := Pointed.on (caratheodory_type mu). +HB.instance Definition _ := @isMeasurable.Build (caratheodory_display mu) + (caratheodory_type mu) mu.-caratheodory + (caratheodory_measurable_set0 mu) + (@caratheodory_measurable_setC _ _ mu) + (@caratheodory_measurable_bigcup _ _ mu). + +End caratheodory_sigma_algebra. + +Section caratheodory_measure. +Local Open Scope ereal_scope. +Variables (R : realType) (T : pointedType). +Variable mu : {outer_measure set T -> \bar R}. +Let U := caratheodory_type mu. + +Lemma caratheodory_measure0 : mu (set0 : set U) = 0. +Proof. exact: outer_measure0. Qed. + +Lemma caratheodory_measure_ge0 (A : set U) : 0 <= mu A. +Proof. exact: outer_measure_ge0. Qed. + +Lemma caratheodory_measure_sigma_additive : + semi_sigma_additive (mu : set U -> _). +Proof. +move=> A mA tA mbigcupA; set B := \bigcup_k A k. +suff : forall X, mu X = \sum_(k _) = fun n => \sum_(k < n) mu (A k)); last first. + rewrite funeqE => n; rewrite big_mkord; apply: eq_bigr => i _; congr (mu _). + by rewrite setIC; apply/setIidPl; exact: bigcup_sup. + move=> ->. + have := fun n (_ : xpredT n) (_ : xpredT n) => outer_measure_ge0 mu (A n). + move/(@is_cvg_nneseries _ _ _ 0) => /cvg_ex[l] hl. + under [in X in _ --> X]eq_fun do rewrite -(big_mkord xpredT (mu \o A)). + by move/cvg_lim : (hl) => ->. +move=> X. +have mB : mu.-cara.-measurable B := caratheodory_measurable_bigcup mA. +apply/eqP; rewrite eq_le (caratheodory_lime_le mA tA X) andbT. +have /(leeD2r (mu (X `&` ~` B))) := outer_measure_bigcup_lim mu A X. +by rewrite -le_caratheodory_measurable // => ?; rewrite -mB. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ + (mu : set (caratheodory_type mu) -> _) + caratheodory_measure0 caratheodory_measure_ge0 + caratheodory_measure_sigma_additive. + +Lemma measure_is_complete_caratheodory : + measure_is_complete (mu : set (caratheodory_type mu) -> _). +Proof. +move=> B [A [mA muA0 BA]]; apply: le_caratheodory_measurable => X. +suff -> : mu (X `&` B) = 0. + by rewrite add0e le_outer_measure //; apply: subIset; left. +have muB0 : mu B = 0. + apply/eqP; rewrite eq_le outer_measure_ge0 andbT. + by apply: (le_trans (le_outer_measure mu _ _ BA)); rewrite -muA0. +apply/eqP; rewrite eq_le outer_measure_ge0 andbT. +have : X `&` B `<=` B by apply: subIset; right. +by move/(le_outer_measure mu); rewrite muB0 => ->. +Qed. + +End caratheodory_measure. + +Section measurable_cover. +Context d (T : semiRingOfSetsType d). +Implicit Types (X : set T) (F : (set T)^nat). + +Definition measurable_cover X := [set F : (set T)^nat | + (forall i, measurable (F i)) /\ X `<=` \bigcup_k (F k)]. + +Lemma cover_measurable X F : measurable_cover X F -> forall k, measurable (F k). +Proof. by move=> + k; rewrite /measurable_cover => -[] /(_ k). Qed. + +Lemma cover_subset X F : measurable_cover X F -> X `<=` \bigcup_k (F k). +Proof. by case. Qed. + +End measurable_cover. + +Section outer_measure_construction. +Local Open Scope ereal_scope. +Context d (T : semiRingOfSetsType d) (R : realType). +Variable mu : set T -> \bar R. +Hypothesis (measure0 : mu set0 = 0) (measure_ge0 : forall X, mu X >= 0). +Hint Resolve measure_ge0 measure0 : core. + +Definition mu_ext (X : set T) : \bar R := + ereal_inf [set \sum_(k -> A <= B}. +Proof. +move=> A B AB; apply/le_ereal_inf => x [B' [mB' BB']]. +by move=> <-{x}; exists B' => //; split => //; apply: subset_trans AB BB'. +Qed. + +Lemma mu_ext_ge0 A : 0 <= mu^* A. +Proof. +apply: lb_ereal_inf => x [B [mB AB] <-{x}]; rewrite lime_ge //=. + exact: is_cvg_nneseries. +by near=> n; rewrite sume_ge0. +Unshelve. all: by end_near. Qed. + +Lemma mu_ext0 : mu^* set0 = 0. +Proof. +apply/eqP; rewrite eq_le; apply/andP; split; last exact/mu_ext_ge0. +rewrite /mu_ext; apply: ereal_inf_lbound; exists (fun=> set0); first by split. +by apply: lim_near_cst => //; near=> n => /=; rewrite big1. +Unshelve. all: by end_near. Qed. + +Lemma mu_ext_sigma_subadditive : sigma_subadditive mu^*. +Proof. +move=> A; have [[i ioo]|] := pselect (exists i, mu^* (A i) = +oo). + rewrite (eseries_pinfty _ _ ioo) ?leey// => n _. + by rewrite -ltNye (lt_le_trans _ (mu_ext_ge0 _)). +rewrite -forallNE => Aoo. +suff add2e (e : {posnum R}) : + mu^* (\bigcup_n A n) <= \sum_(i _/posnumP[]. +rewrite (le_trans _ (epsilon_trick _ _ _))//; last first. + by move=> n; exact: mu_ext_ge0. +pose P n (B : (set T)^nat) := measurable_cover (A n) B /\ + \sum_(k n; rewrite /P /mu_ext. + set S := (X in ereal_inf X); move infS : (ereal_inf S) => iS. + case: iS infS => [r Sr|Soo|Soo]. + - have en1 : (0 < e%:num / (2 ^ n.+1)%:R)%R by []. + have /(lb_ereal_inf_adherent en1) : ereal_inf S \is a fin_num by rewrite Sr. + move=> [x [B [mB AnB muBx] xS]]. + by exists B; split => //; rewrite muBx -Sr; exact/ltW. + - by have := Aoo n; rewrite /mu^* Soo. + - suff : lbound S 0 by move/lb_ereal_inf; rewrite Soo. + by move=> /= _ [B [mB AnB] <-]; exact: nneseries_ge0. +have muG_ge0 x : 0 <= (mu \o uncurry G) x by exact: measure_ge0. +apply: (@le_trans _ _ (\esum_(i in setT) (mu \o uncurry G) i)). + rewrite /mu_ext; apply: ereal_inf_lbound => /=. + have /card_esym/ppcard_eqP[f] := card_nat2. + exists (uncurry G \o f). + split => [i|]; first exact/measurable_uncurry/(PG (f i).1).1.1. + apply: (@subset_trans _ (\bigcup_n \bigcup_k G n k)) => [t [i _]|]. + by move=> /(cover_subset (PG i).1) -[j _ ?]; exists i => //; exists j. + move=> t [i _ [j _ Bijt]]; exists (f^-1%FUN (i, j)) => //=. + by rewrite invK ?inE. + rewrite -(esum_pred_image (mu \o uncurry G) _ xpredT) ?[fun=> _]set_true//. + by rewrite image_eq. +rewrite (_ : esum _ _ = \sum_(i set (nat * nat) := fun i => [set (i, j) | j in setT]. + rewrite (_ : setT = \bigcup_k J k); last first. + by rewrite predeqE => -[a b]; split => // _; exists a => //; exists b. + rewrite esum_bigcupT /=; last 2 first. + - apply/trivIsetP => i j _ _ ij. + rewrite predeqE => -[n m] /=; split => //= -[] [_] _ [<-{n} _]. + by move=> [m' _] [] /esym/eqP; rewrite (negbTE ij). + - by move=> /= [n m]; apply: measure_ge0; exact: (cover_measurable (PG n).1). + rewrite -(image_id [set: nat]) -fun_true esum_pred_image//; last first. + by move=> n _; exact: esum_ge0. + apply: eq_eseriesr => /= j _. + rewrite -(esum_pred_image (mu \o uncurry G) (pair j) predT)//=; last first. + by move=> ? ? _ _; exact: (@can_inj _ _ _ snd). + by congr esum; rewrite predeqE => -[a b]; split; move=> [i _ <-]; exists i. +apply: lee_lim. +- apply: is_cvg_nneseries => n *. + by apply: nneseries_ge0 => m *; exact: (muG_ge0 (n, m)). +- by apply: is_cvg_nneseries => n *; apply: adde_ge0 => //; exact: mu_ext_ge0. +- by near=> n; apply: lee_sum => i _; exact: (PG i).2. +Unshelve. all: by end_near. Qed. + +End outer_measure_construction. + +Declare Scope measure_scope. +Delimit Scope measure_scope with mu. +Notation "mu ^*" := (mu_ext mu) : measure_scope. +Local Open Scope measure_scope. + +Section outer_measure_of_content. +Context d (R : realType) (T : semiRingOfSetsType d). +Variable mu : {content set T -> \bar R}. + +HB.instance Definition _ := isOuterMeasure.Build + R T _ (@mu_ext0 _ _ _ _ (measure0 mu) (measure_ge0 mu)) + (mu_ext_ge0 (measure_ge0 mu)) + (le_mu_ext mu) + (mu_ext_sigma_subadditive (measure_ge0 mu)). + +End outer_measure_of_content. + +Section Rmu_ext. +Import SetRing. +Local Open Scope measure_scope. + +Lemma Rmu_ext d (R : realType) (T : semiRingOfSetsType d) + (mu : {content set T -> \bar R}) : + (measure mu)^* = mu^*. +Proof. +apply/funeqP => /= X; rewrite /mu_ext/=; apply/eqP; rewrite eq_le. +rewrite ?lb_ereal_inf// => _ [F [Fm XS] <-]; rewrite ereal_inf_lbound//; last first. + exists F; first by split=> // i; exact: sub_gen_smallest. + by rewrite (eq_eseriesr (fun _ _ => RmuE _ (Fm _))). +pose K := [set: nat] `*`` fun i => decomp (F i). +have /ppcard_eqP[f] : (K #= [set: nat])%card. + apply: cardXR_eq_nat => // i; split; last by apply/set0P; rewrite decompN0. + by apply: finite_set_countable => //; exact: decomp_finite_set. +pose g i := (f^-1%FUN i).2; exists g; first split. +- move=> k; have [/= _ /mem_set] : K (f^-1%FUN k) by apply: funS. + exact: decomp_measurable. +- move=> i /XS [k _]; rewrite -[F k]cover_decomp => -[D /= DFk Di]. + by exists (f (k, D)) => //; rewrite /g invK// inE. +rewrite !nneseries_esumT//= /measure. +transitivity (\esum_(i in setT) \sum_(X0 \in decomp (F i)) mu X0); last first. + by apply: eq_esum => /= k _; rewrite fsbig_finite//; exact: decomp_finite_set. +rewrite -(eq_esum (fun _ _ => esum_fset _ _))//; last first. + by move=> ? _; exact: decomp_finite_set. +rewrite esum_esum//= (reindex_esum K setT f) => //=. +by apply: eq_esum => i Ki; rewrite /g funK ?inE. +Qed. + +End Rmu_ext. + +Local Open Scope measure_scope. +Lemma measurable_mu_extE d (R : realType) (T : semiRingOfSetsType d) + (mu : {measure set T -> \bar R}) X : + measurable X -> mu^* X = mu X. +Proof. +move=> mX; apply/eqP; rewrite eq_le; apply/andP; split. + apply: ereal_inf_lbound; exists (fun n => if n is 0%N then X else set0). + by split=> [[]// _|t Xt]; exists 0%N. + apply/cvg_lim => //; rewrite -cvg_shiftS. + rewrite (_ : [sequence _]_n = cst (mu X)); first exact: cvg_cst. + by rewrite funeqE => n /=; rewrite big_nat_recl//= big1 ?adde0. +apply/lb_ereal_inf => x [A [mA XA] <-{x}]. +have XUA : X = \bigcup_n (X `&` A n). + rewrite predeqE => t; split => [Xt|[i _ []//]]. + by have [i _ Ait] := XA _ Xt; exists i. +apply: (@le_trans _ _ (\sum_(i // i; apply: measurableI. +apply: lee_lim; [exact: is_cvg_nneseries|exact: is_cvg_nneseries|]. +by apply: nearW => n; apply: lee_sum => i _; exact: measureIr. +Qed. + +Lemma measurable_Rmu_extE d (R : realType) (T : semiRingOfSetsType d) + (mu : {measure set T -> \bar R}) X : + d.-ring.-measurable X -> mu^* X = SetRing.measure mu X. +Proof. by move=> Xm/=; rewrite -Rmu_ext/= measurable_mu_extE. Qed. +Local Close Scope measure_scope. + +Section measure_extension. +Local Open Scope ereal_scope. +Local Open Scope measure_scope. +Context d (T : semiRingOfSetsType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Let Rmu := SetRing.measure mu. +Notation rT := (SetRing.type T). + +Lemma sub_caratheodory : + (d.-measurable).-sigma.-measurable `<=` mu^*.-cara.-measurable. +Proof. +suff: <> `<=` mu^*.-cara.-measurable. + by apply: subset_trans; apply: sub_smallest2r => //; exact: sub_smallest. +apply: smallest_sub. + split => //; [by move=> X mX; rewrite setTD; exact: measurableC | + by move=> u_ mu_; exact: bigcupT_measurable]. +move=> A mA; apply le_caratheodory_measurable => // X. +apply lb_ereal_inf => _ [B [mB XB] <-]. +rewrite -(eq_eseriesr (fun _ _ => SetRing.RmuE _ (mB _))) => //. +have RmB i : measurable (B i : set rT) by exact: sub_gen_smallest. +set BA := eseries (fun n => Rmu (B n `&` A)). +set BNA := eseries (fun n => Rmu (B n `&` ~` A)). +apply: (@le_trans _ _ (limn BA + limn BNA)); [apply: leeD|]. + - rewrite (_ : BA = eseries (fun n => mu_ext mu (B n `&` A))); last first. + rewrite funeqE => n; apply: eq_bigr => k _. + by rewrite /= measurable_Rmu_extE //; exact: measurableI. + apply: (@le_trans _ _ (mu_ext mu (\bigcup_k (B k `&` A)))). + by apply: le_mu_ext; rewrite -setI_bigcupl; exact: setISS. + exact: outer_measure_sigma_subadditive. + - rewrite (_ : BNA = eseries (fun n => mu_ext mu (B n `\` A))); last first. + rewrite funeqE => n; apply: eq_bigr => k _. + by rewrite /= measurable_Rmu_extE //; exact: measurableD. + apply: (@le_trans _ _ (mu_ext mu (\bigcup_k (B k `\` A)))). + by apply: le_mu_ext; rewrite -setI_bigcupl; exact: setISS. + exact: outer_measure_sigma_subadditive. +have cBNA : cvg (BNA @ \oo) by exact: is_cvg_nneseries. +have cBA : cvg (BA @ \oo) by exact: is_cvg_nneseries. +have cB : cvg (eseries (Rmu \o B) @ \oo) by exact: is_cvg_nneseries. +have [def|] := boolP (lim (BA @ \oo) +? lim (BNA @ \oo)); last first. + rewrite /adde_def negb_and !negbK=> /orP[/andP[BAoo BNAoo]|/andP[BAoo BNAoo]]. + - suff -> : limn (eseries (Rmu \o B)) = +oo by rewrite leey. + apply/eqP; rewrite -leye_eq -(eqP BAoo); apply/(lee_lim cBA cB). + near=> n; apply: lee_sum => m _; apply: le_measure; rewrite /mkset; by + [rewrite inE; exact: measurableI | rewrite inE | apply: subIset; left]. + - suff -> : limn (eseries (Rmu \o B)) = +oo by rewrite leey. + apply/eqP; rewrite -leye_eq -(eqP BNAoo); apply/(lee_lim cBNA cB). + by near=> n; apply: lee_sum => m _; rewrite -setDE; apply: le_measure; + rewrite /mkset ?inE//; apply: measurableD. +rewrite -(limeD cBA cBNA) // (_ : (fun _ => _) = + eseries (fun k => Rmu (B k `&` A) + Rmu (B k `&` ~` A))); last first. + by rewrite funeqE => n; rewrite -big_split /=; exact: eq_bigr. +apply/lee_lim => //. + by apply/is_cvg_nneseries => // n *; exact: adde_ge0. +near=> n; apply: lee_sum => i _; rewrite -measure_semi_additive2. +- apply: le_measure; rewrite /mkset ?inE//; [|by rewrite -setIUr setUCr setIT]. + by apply: measurableU; [exact:measurableI|rewrite -setDE; exact:measurableD]. +- exact: measurableI. +- by rewrite -setDE; exact: measurableD. +- by apply: measurableU; [exact:measurableI|rewrite -setDE; exact:measurableD]. +- by rewrite setIACA setICr setI0. +Unshelve. all: by end_near. Qed. + +Let I : measurableType _ := g_sigma_algebraType (@measurable _ T). + +Definition measure_extension : set I -> \bar R := mu^*. + +Local Lemma measure_extension0 : measure_extension set0 = 0. +Proof. exact: mu_ext0. Qed. + +Local Lemma measure_extension_ge0 (A : set I) : 0 <= measure_extension A. +Proof. exact: mu_ext_ge0. Qed. + +Local Lemma measure_extension_semi_sigma_additive : + semi_sigma_additive measure_extension. +Proof. +move=> F mF tF mUF; rewrite /measure_extension. +apply: caratheodory_measure_sigma_additive => //; last exact: sub_caratheodory. +by move=> i; exact: (sub_caratheodory (mF i)). +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ measure_extension + measure_extension0 measure_extension_ge0 + measure_extension_semi_sigma_additive. + +Lemma measure_extension_sigma_finite : @sigma_finite _ T _ setT mu -> + @sigma_finite _ _ _ setT measure_extension. +Proof. +move=> -[S setTS mS]; exists S => //; move=> i; split. + by have := (mS i).1; exact: sub_sigma_algebra. +by rewrite /measure_extension /= measurable_mu_extE //; + [exact: (mS i).2 | exact: (mS i).1]. +Qed. + +Lemma measure_extension_unique : sigma_finite [set: T] mu -> + (forall mu' : {measure set I -> \bar R}, + (forall X, d.-measurable X -> mu X = mu' X) -> + (forall X, (d.-measurable).-sigma.-measurable X -> + measure_extension X = mu' X)). +Proof. +move=> [F TF /all_and2[Fm muF]] mu' mu'mu X mX. +apply: (@measure_unique _ _ I d.-measurable F) => //. +- by move=> A B Am Bm; apply: measurableI. +- by move=> A Am; rewrite /= /measure_extension measurable_mu_extE// mu'mu. +- by move=> k; rewrite /= /measure_extension measurable_mu_extE. +Qed. + +End measure_extension. + +Local Open Scope measure_scope. +Lemma caratheodory_measurable_mu_ext d (R : realType) (T : semiRingOfSetsType d) + (mu : {measure set T -> \bar R}) A : + d.-measurable A -> mu^*.-cara.-measurable A. +Proof. +by move=> Am; apply: sub_caratheodory => //; apply: sub_sigma_algebra. +Qed. +Local Close Scope measure_scope. + +Section completed_measure_extension. +Local Open Scope ereal_scope. +Context d (T : semiRingOfSetsType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Notation rT := (SetRing.type T). +Let Rmu : set rT -> \bar R := SetRing.measure mu. + +Let I : measurableType _ := caratheodory_type (mu^*)%mu. + +Definition completed_measure_extension : set I -> \bar R := (mu^*)%mu. + +Let measure0 : completed_measure_extension set0 = 0. +Proof. exact: mu_ext0. Qed. + +Let measure_ge0 (A : set I) : 0 <= completed_measure_extension A. +Proof. exact: mu_ext_ge0. Qed. + +Let measure_semi_sigma_additive : + semi_sigma_additive completed_measure_extension. +Proof. +move=> F mF tF mUF; rewrite /completed_measure_extension. +exact: caratheodory_measure_sigma_additive. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ completed_measure_extension + measure0 measure_ge0 measure_semi_sigma_additive. + +Lemma completed_measure_extension_sigma_finite : @sigma_finite _ T _ setT mu -> + @sigma_finite _ _ _ setT completed_measure_extension. +Proof. +move=> -[S setTS mS]; exists S => //; move=> i; split. +- apply: sub_caratheodory; apply: sub_sigma_algebra. + exact: (mS i).1. +- by rewrite /completed_measure_extension /= measurable_mu_extE //; + [exact: (mS i).2 | exact: (mS i).1]. +Qed. + +End completed_measure_extension. diff --git a/theories/measure_theory/measure_function.v b/theories/measure_theory/measure_function.v new file mode 100644 index 0000000000..aa6a3bc93c --- /dev/null +++ b/theories/measure_theory/measure_function.v @@ -0,0 +1,1958 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure measurable_function. + +(**md**************************************************************************) +(* # Measure Functions *) +(* *) +(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) +(* *) +(* ## Structures for functions on set systems *) +(* *) +(* Hierarchy of contents, measures, s-finite/sigma-finite/finite measures, *) +(* etc. Also contains a number of details about its implementation. *) +(* *) +(* ``` *) +(* {content set T -> \bar R} == type of contents *) +(* T is expected to be a semiring of sets and R *) +(* a numFieldType. *) +(* The HB class is Content. *) +(* Content_isMeasure == interface that extends a content to a measure *) +(* with the proof that it is semi_sigma_additive *) +(* {measure set T -> \bar R} == type of (non-negative) measures *) +(* T is expected to be a semiring of sets and *) +(* R is expected to be a numFieldType. *) +(* The HB class is Measure. *) +(* isMeasure == interface corresponding to the "textbook *) +(* definition" of measures *) +(* ``` *) +(* ## Instances of measures *) +(* *) +(* ``` *) +(* msum mu n == the measure corresponding to the sum of the measures *) +(* mu_0, ..., mu_{n-1} *) +(* @mzero T R == the zero measure *) +(* measure_add m1 m2 == the measure corresponding to the sum of the *) +(* measures m1 and m2 *) +(* mscale r m == the measure of corresponding to fun A => r * m A *) +(* where r has type {nonneg R} *) +(* mseries mu n == the measure corresponding to the sum of the *) +(* measures mu_n, mu_{n+1}, ... *) +(* pushforward m f == pushforward of a set function m : set T1 -> \bar R *) +(* by f : T1 -> T2; pushforward/image measure if m is *) +(* a measure and f measurable *) +(* ``` *) +(* *) +(* ``` *) +(* G.-ring.-measurable A == A belongs to the ring of sets <> *) +(* ``` *) +(* *) +(* ``` *) +(* fin_num_fun == predicate for finite function over measurable *) +(* sets *) +(* sfinite_measure == predicate for s-finite measure functions *) +(* sigma_finite A f == the measure function f is sigma-finite on the *) +(* A : set T with T a semiring of sets *) +(* mrestr mu mD == restriction of the measure mu to a set D *) +(* mD is a proof that D is measurable. *) +(* isSFinite == interface for functions that satisfy the *) +(* sfinite_measure predicate *) +(* {sfinite_measure set T -> \bar R} == type of s-finite measures *) +(* The HB class is SFiniteMeasure. *) +(* isSigmaFinite == interface for functions that satisfy *) +(* sigma finiteness *) +(* {sigma_finite_content set T -> \bar R} == contents that are also sigma *) +(* finite *) +(* The HB class is SigmaFiniteContent. *) +(* {sigma_finite_measure set T -> \bar R} == measures that are also sigma *) +(* finite *) +(* The HB class is SigmaFiniteMeasure. *) +(* Measure_isSFinite == interface that extends a measure to an *) +(* s-finite measure using a sequence of finite *) +(* measures *) +(* isFinite == interface for functions that satisfy the *) +(* fin_num_fun predicate *) +(* FinNumFun.type == type of functions over semiring of sets *) +(* returning a fin_num *) +(* The HB class is FinNumFun. *) +(* {finite_measure set T -> \bar R} == finite measures *) +(* The HB class is FiniteMeasure. *) +(* Measure_isFinite == interface that extends a measure to a finite *) +(* measure using a proof of fin_num_fun *) +(* sfinite_measure_seq mu == the sequence of finite measures of the *) +(* s-finite measure mu *) +(* ``` *) +(* *) +(* ``` *) +(* mfrestr mD muDoo == finite measure corresponding to the restriction of *) +(* the measure mu over D with mu D < +oo, *) +(* mD : measurable D, muDoo : mu D < +oo *) +(* ``` *) +(* *) +(* ``` *) +(* lim_sup_set F == limit superior (or upper limit) of a *) +(* sequence of sets F *) +(* ``` *) +(* *) +(******************************************************************************) + +(*Reserved Notation "{ 'content' fUV }" (format "{ 'content' fUV }").*) +Reserved Notation "{ 'content' 'set' T '->' '\bar' R }" + (T at level 37, format "{ 'content' 'set' T '->' '\bar' R }"). +(*Reserved Notation "[ 'content' 'of' f 'as' g ]" + (format "[ 'content' 'of' f 'as' g ]"). +Reserved Notation "[ 'content' 'of' f ]" (format "[ 'content' 'of' f ]").*) +(*Reserved Notation "{ 'measure' fUV }" (format "{ 'measure' fUV }").*) +Reserved Notation "{ 'measure' 'set' T '->' '\bar' R }" + (T at level 37, format "{ 'measure' 'set' T '->' '\bar' R }"). +(*Reserved Notation "[ 'measure' 'of' f 'as' g ]" + (format "[ 'measure' 'of' f 'as' g ]"). +Reserved Notation "[ 'measure' 'of' f ]" (format "[ 'measure' 'of' f ]").*) +Reserved Notation "d .-ring" (format "d .-ring"). +Reserved Notation "d .-ring.-measurable" (format "d .-ring.-measurable"). +Reserved Notation "{ 'sfinite_measure' 'set' T '->' '\bar' R }" + (T at level 37, format "{ 'sfinite_measure' 'set' T '->' '\bar' R }"). +Reserved Notation "{ 'sigma_finite_content' 'set' T '->' '\bar' R }" + (T at level 37, + format "{ 'sigma_finite_content' 'set' T '->' '\bar' R }"). +Reserved Notation "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }" + (T at level 37, + format "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }"). +Reserved Notation "{ 'finite_measure' 'set' T '->' '\bar' R }" + (T at level 37, format "{ 'finite_measure' 'set' T '->' '\bar' R }"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Section additivity. +Context d (R : numFieldType) (T : semiRingOfSetsType d) + (mu : set T -> \bar R). + +(* TODO: undocumented *) +Definition semi_additive2 := forall A B, measurable A -> measurable B -> + measurable (A `|` B) -> + A `&` B = set0 -> mu (A `|` B) = mu A + mu B. + +Definition semi_additive := forall F n, + (forall k : nat, measurable (F k)) -> trivIset setT F -> + measurable (\big[setU/set0]_(k < n) F k) -> + mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). + +Definition semi_sigma_additive := + forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> + measurable (\bigcup_n F n) -> + (fun n => \sum_(0 <= i < n) mu (F i)) @ \oo --> mu (\bigcup_n F n). + +Definition additive2 := forall A B, measurable A -> measurable B -> + A `&` B = set0 -> mu (A `|` B) = mu A + mu B. + +Definition additive := + forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> + forall n, mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). + +Definition sigma_additive := + forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> + (fun n => \sum_(0 <= i < n) mu (F i)) @ \oo --> mu (\bigcup_n F n). + +Definition subadditive := forall (A : set T) (F : nat -> set T) n, + (forall k, `I_n k -> measurable (F k)) -> measurable A -> + A `<=` \big[setU/set0]_(k < n) F k -> + (mu A <= \sum_(k < n) mu (F k))%E. + +Definition measurable_subset_sigma_subadditive := + forall (A : set T) (F : nat -> set T), + (forall n, measurable (F n)) -> measurable A -> + subset_sigma_subadditive mu A F. + +Lemma semi_additiveW : mu set0 = 0 -> semi_additive -> semi_additive2. +Proof. +move=> mu0 amx A B mA mB + AB; rewrite -bigcup2inE bigcup_mkord. +move=> /(amx (bigcup2 A B))->. +- by rewrite !(big_ord_recl, big_ord0)/= adde0. +- by move=> [|[|[]]]//=. +- by move=> [|[|i]] [|[|j]]/= _ _; rewrite ?(AB, setI0, set0I, setIC) => -[]. +Qed. + +End additivity. + +Section ring_additivity. +Context d (R : numFieldType) (T : ringOfSetsType d) (mu : set T -> \bar R). + +Lemma semi_additiveE : semi_additive mu = additive mu. +Proof. +rewrite propeqE; split=> [sa A mA tA n|+ A m mA tA UAm]; last by move->. +by rewrite sa //; exact: bigsetU_measurable. +Qed. + +Lemma semi_additive2E : semi_additive2 mu = additive2 mu. +Proof. +rewrite propeqE; split=> [amu A B ? ? ?|amu A B ? ? _ ?]; last by rewrite amu. +by rewrite amu //; exact: measurableU. +Qed. + +Lemma additive2P : mu set0 = 0 -> semi_additive mu <-> additive2 mu. +Proof. +move=> mu0; rewrite -semi_additive2E; split; first exact: semi_additiveW. +rewrite semi_additiveE semi_additive2E => muU A Am Atriv n. +elim: n => [|n IHn]; rewrite ?(big_ord_recr, big_ord0) ?mu0//=. +rewrite muU ?IHn//=; first by apply: bigsetU_measurable. +rewrite -bigcup_mkord -subset0 => x [[/= m + Amx] Anx]. +by rewrite (Atriv m n) ?ltnn//=; exists x. +Qed. + +End ring_additivity. + +(* NB: realFieldType cannot be weakened to numFieldType in the current + state because cvg_lim requires a topology for \bar R which is + defined for at least realFieldType *) +Lemma semi_sigma_additive_is_additive d (T : semiRingOfSetsType d) + (R : realFieldType) (mu : set T -> \bar R) : + mu set0 = 0 -> semi_sigma_additive mu -> semi_additive mu. +Proof. +move=> mu0 samu A n Am Atriv UAm. +have := samu (fun i => if (i < n)%N then A i else set0). +rewrite (bigcup_splitn n) bigcup0 ?setU0; last first. + by move=> i _; rewrite -ltn_subRL subnn. +under eq_bigr do rewrite ltn_ord. +move=> /(_ _ _ UAm)/(@cvg_lim _) <-//; last 2 first. +- by move=> i; case: ifP. +- move=> i j _ _; do 2![case: ifP] => ? ?; do ?by rewrite (setI0, set0I) => -[]. + by move=> /Atriv; apply. +apply: lim_near_cst => //=; near=> i. +have /subnKC<- : (n <= i)%N by near: i; exists n. +transitivity (\sum_(j < n + (i - n)) mu (if (j < n)%N then A j else set0)). + by rewrite big_mkord. +rewrite big_split_ord/=; under eq_bigr do rewrite ltn_ord. +by rewrite [X in _ + X]big1 ?adde0// => ?; rewrite -ltn_subRL subnn. +Unshelve. all: by end_near. Qed. + +Lemma semi_sigma_additiveE + (R : numFieldType) d (T : sigmaRingType d) (mu : set T -> \bar R) : + semi_sigma_additive mu = sigma_additive mu. +Proof. +rewrite propeqE; split=> [amu A mA tA|amu A mA tA mbigcupA]; last exact: amu. +by apply: amu => //; exact: bigcupT_measurable. +Qed. + +Lemma sigma_additive_is_additive + (R : realFieldType) d (T : sigmaRingType d) (mu : set T -> \bar R) : + mu set0 = 0 -> sigma_additive mu -> additive mu. +Proof. +move=> mu0; rewrite -semi_sigma_additiveE -semi_additiveE. +exact: semi_sigma_additive_is_additive. +Qed. + +HB.mixin Record isContent d + (T : semiRingOfSetsType d) (R : numFieldType) (mu : set T -> \bar R) := { + measure_ge0 : forall x, (0 <= mu x)%E ; + measure_semi_additive : semi_additive mu }. + +HB.structure Definition Content d + (T : semiRingOfSetsType d) (R : numFieldType) := { + mu & isContent d T R mu }. + +Notation content := Content.type. +Notation "{ 'content' 'set' T '->' '\bar' R }" := (content T R) : ring_scope. + +Arguments measure_ge0 {d T R} _. + +Section content_signed. +Context d (T : semiRingOfSetsType d) (R : numFieldType). +Variable mu : {content set T -> \bar R}. + +Lemma content_inum_subproof S : + Itv.spec (@ext_num_sem R) (Itv.Real `[0%Z, +oo[) (mu S). +Proof. +apply/and3P; split. +- by rewrite real_fine -real_leNye; apply: le_trans (measure_ge0 _ _). +- by rewrite /= bnd_simp measure_ge0. +- by rewrite bnd_simp. +Qed. + +Canonical content_inum S := Itv.mk (content_inum_subproof S). + +End content_signed. + +Section content_on_semiring_of_sets. +Context d (T : semiRingOfSetsType d) (R : numFieldType) + (mu : {content set T -> \bar R}). + +Lemma measure0 : mu set0 = 0. +Proof. +have /[!big_ord0] ->// := @measure_semi_additive _ _ _ mu (fun=> set0) 0%N. +exact: trivIset_set0. +Qed. + +Lemma measure_gt0 x : (0%R < mu x)%E = (mu x != 0). +Proof. by rewrite lt_def measure_ge0 andbT. Qed. + +Hint Resolve measure0 : core. + +Hint Resolve measure_ge0 : core. + +Hint Resolve measure_semi_additive : core. + +Lemma measure_semi_additive_ord n (F : 'I_n -> set T) : + (forall (k : 'I_n), measurable (F k)) -> + trivIset setT F -> + measurable (\big[setU/set0]_(k < n) F k) -> + mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). +Proof. +move=> mF tF mUF; pose F' (i : nat) := oapp F set0 (insub i). +have FE (i : 'I_n) : F i = (F' \o val) i by rewrite /F'/= valK/=. +rewrite (eq_bigr (F' \o val))// (eq_bigr (mu \o F' \o val))//; last first. + by move=> i _; rewrite FE. +rewrite -measure_semi_additive//. +- by move=> k; rewrite /F'; case: insubP => /=. +- apply/trivIsetP=> i j _ _; rewrite /F'. + do 2?[case: insubP; rewrite ?(set0I, setI0)//= => ? _ <-]. + by move/trivIsetP: tF; apply. +- by rewrite (eq_bigr (F' \o val)) in mUF. +Qed. + +Lemma measure_semi_additive_ord_I (F : nat -> set T) (n : nat) : + (forall k, (k < n)%N -> measurable (F k)) -> + trivIset `I_n F -> + measurable (\big[setU/set0]_(k < n) F k) -> + mu (\big[setU/set0]_(i < n) F i) = \sum_(i < n) mu (F i). +Proof. +move=> mF tF; apply: measure_semi_additive_ord. + by move=> k; apply: mF. +by rewrite trivIset_comp// ?(image_eq [surjfun of val])//; apply: 'inj_val. +Qed. + +Lemma content_fin_bigcup (I : choiceType) (D : set I) (F : I -> set T) : + finite_set D -> + trivIset D F -> + (forall i, D i -> measurable (F i)) -> + measurable (\bigcup_(i in D) F i) -> + mu (\bigcup_(i in D) F i) = \sum_(i \in D) mu (F i). +Proof. +elim/choicePpointed: I => I in D F *. + by rewrite !emptyE => *; rewrite fsbig_set0 bigcup0. +move=> [n /ppcard_eqP[f]] Ftriv Fm UFm. +rewrite -(image_eq [surjfun of f^-1%FUN])/= in UFm Ftriv *. +rewrite bigcup_image fsbig_image//= bigcup_mkord -fsbig_ord/= in UFm *. +rewrite (@measure_semi_additive_ord_I (F \o f^-1))//= 1?trivIset_comp//. +by move=> k kn; apply: Fm; exact: funS. +Qed. + +Lemma measure_semi_additive2 : semi_additive2 mu. +Proof. exact/semi_additiveW. Qed. +Hint Resolve measure_semi_additive2 : core. + +End content_on_semiring_of_sets. +Arguments measure0 {d T R} _. + +#[global] Hint Extern 0 + (is_true (0%R <= (_ : {content set _ -> \bar _}) _)%E) => + solve [apply: measure_ge0] : core. + +#[global] Hint Extern 0 + (is_true (0%:E <= (_ : {content set _ -> \bar _}) _)%E) => + solve [apply: measure_ge0] : core. + +#[global] Hint Extern 0 + ((_ : {content set _ -> \bar _}) set0 = 0%R)%E => + solve [apply: measure0] : core. + +#[global] +Hint Resolve measure_semi_additive2 measure_semi_additive : core. + +Section content_on_ring_of_sets. +Context d (R : realFieldType)(T : ringOfSetsType d) + (mu : {content set T -> \bar R}). + +Lemma measureU : additive2 mu. +Proof. by rewrite -semi_additive2E. Qed. + +Lemma measure_bigsetU : additive mu. +Proof. by rewrite -semi_additiveE. Qed. + +Lemma measure_fin_bigcup (I : choiceType) (D : set I) (F : I -> set T) : + finite_set D -> + trivIset D F -> + (forall i, D i -> measurable (F i)) -> + mu (\bigcup_(i in D) F i) = \sum_(i \in D) mu (F i). +Proof. +move=> Dfin Ftriv Fm; rewrite content_fin_bigcup//. +exact: fin_bigcup_measurable. +Qed. + +Lemma measure_bigsetU_ord_cond n (P : {pred 'I_n}) (F : 'I_n -> set T) : + (forall i : 'I_n, P i -> measurable (F i)) -> trivIset P F -> + mu (\big[setU/set0]_(i < n | P i) F i) = (\sum_(i < n | P i) mu (F i))%E. +Proof. +move=> mF tF; rewrite !(big_mkcond P)/= measure_semi_additive_ord//. +- by apply: eq_bigr => i _; rewrite (fun_if mu) measure0. +- by move=> k; case: ifP => //; apply: mF. +- by rewrite -patch_pred trivIset_restr setIT. +- by apply: bigsetU_measurable=> k _; case: ifP => //; apply: mF. +Qed. + +Lemma measure_bigsetU_ord n (P : {pred 'I_n}) (F : 'I_n -> set T) : + (forall i : 'I_n, measurable (F i)) -> trivIset setT F -> + mu (\big[setU/set0]_(i < n | P i) F i) = (\sum_(i < n | P i) mu (F i))%E. +Proof. +by move=> mF tF; rewrite measure_bigsetU_ord_cond//; apply: sub_trivIset tF. +Qed. + +Lemma measure_fbigsetU (I : choiceType) (A : {fset I}) (F : I -> set T) : + (forall i, i \in A -> measurable (F i)) -> trivIset [set` A] F -> + mu (\big[setU/set0]_(i <- A) F i) = (\sum_(i <- A) mu (F i))%E. +Proof. +by move=> mF tF; rewrite -bigcup_fset measure_fin_bigcup// -fsbig_seq. +Qed. + +End content_on_ring_of_sets. + +#[global] +Hint Resolve measureU measure_bigsetU : core. + +HB.mixin Record Content_isMeasure d (T : semiRingOfSetsType d) + (R : numFieldType) (mu : set T -> \bar R) of Content d mu := { + measure_semi_sigma_additive : semi_sigma_additive mu }. + +#[short(type=measure)] +HB.structure Definition Measure d (T : semiRingOfSetsType d) + (R : numFieldType) := + {mu of Content d mu & Content_isMeasure d T R mu }. + +Notation "{ 'measure' 'set' T '->' '\bar' R }" := (measure T%type R) + : ring_scope. + +Section measure_signed. +Context d (R : numFieldType) (T : semiRingOfSetsType d). + +Variable mu : {measure set T -> \bar R}. + +Lemma measure_inum_subproof S : + Itv.spec (@ext_num_sem R) (Itv.Real `[0%Z, +oo[) (mu S). +Proof. +apply/and3P; split. +- by rewrite real_fine -real_leNye; apply: le_trans (measure_ge0 _ _). +- by rewrite /= bnd_simp measure_ge0. +- by rewrite bnd_simp. +Qed. + +Canonical measure_inum S := Itv.mk (measure_inum_subproof S). + +End measure_signed. + +HB.factory Record isMeasure d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) := { + measure0 : mu set0 = 0 ; + measure_ge0 : forall x, (0 <= mu x)%E ; + measure_semi_sigma_additive : semi_sigma_additive mu }. + +HB.builders Context d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) of isMeasure _ T R mu. + +Let semi_additive_mu : semi_additive mu. +Proof. +apply: semi_sigma_additive_is_additive. +- exact: measure0. +- exact: measure_semi_sigma_additive. +Qed. + +HB.instance Definition _ := isContent.Build d T R mu + measure_ge0 semi_additive_mu. +HB.instance Definition _ := Content_isMeasure.Build d T R mu + measure_semi_sigma_additive. +HB.end. + +Lemma eq_measure d (T : measurableType d) (R : realFieldType) + (m1 m2 : {measure set T -> \bar R}) : + (m1 = m2 :> (set T -> \bar R)) -> m1 = m2. +Proof. +move: m1 m2 => [m1 [[m10 m1ge0 [m1sa]]]] [m2 [[+ + [+]]]] /= m1m2. +rewrite -{}m1m2 => m10' m1ge0' m1sa'; f_equal. +by rewrite (_ : m10' = m10)// (_ : m1ge0' = m1ge0)// (_ : m1sa' = m1sa). +Qed. + +Section measure_lemmas. +Context d (R : realFieldType) (T : semiRingOfSetsType d). +Variable mu : {measure set T -> \bar R}. + +Lemma measure_semi_bigcup A : (forall i : nat, measurable (A i)) -> + trivIset setT A -> measurable (\bigcup_n A n) -> + mu (\bigcup_n A n) = (\sum_(i Am Atriv /measure_semi_sigma_additive/cvg_lim<-//. Qed. + +End measure_lemmas. + +#[global] Hint Extern 0 (_ set0 = 0%R)%E => solve [apply: measure0] : core. +#[global] Hint Extern 0 (is_true (0%:E <= _)) => solve [apply: measure_ge0] : core. + +Section measure_lemmas. +Context d (R : realFieldType) (T : sigmaRingType d). +Variable mu : {measure set T -> \bar R}. + +Lemma measure_sigma_additive : sigma_additive mu. +Proof. +by rewrite -semi_sigma_additiveE //; apply: measure_semi_sigma_additive. +Qed. + +Lemma measure_bigcup (D : set nat) F : (forall i, D i -> measurable (F i)) -> + trivIset D F -> mu (\bigcup_(n in D) F n) = (\sum_(i mF tF; rewrite bigcup_mkcond measure_semi_bigcup. +- by rewrite [in RHS]eseries_mkcond; apply: eq_eseriesr => n _; case: ifPn. +- by move=> i; case: ifPn => // /set_mem; exact: mF. +- by move/trivIset_mkcond : tF. +- by rewrite -bigcup_mkcond; exact: bigcup_measurable. +Qed. + +End measure_lemmas. +Arguments measure_bigcup {d R T} _ _. + +#[global] Hint Extern 0 (sigma_additive _) => + solve [apply: measure_sigma_additive] : core. + +Section measure_sum. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realType). +Variables (m : {measure set T -> \bar R}^nat) (n : nat). + +Definition msum (A : set T) : \bar R := \sum_(k < n) m k A. + +Let msum0 : msum set0 = 0. Proof. by rewrite /msum big1. Qed. + +Let msum_ge0 B : 0 <= msum B. Proof. by rewrite /msum; apply: sume_ge0. Qed. + +Let msum_sigma_additive : semi_sigma_additive msum. +Proof. +move=> F mF tF mUF; rewrite [X in _ --> X](_ : _ = + lim ((fun n => \sum_(0 <= i < n) msum (F i)) @ \oo)). + by apply: is_cvg_ereal_nneg_natsum => k _; exact: sume_ge0. +rewrite nneseries_sum//; apply: eq_bigr => /= i _. +exact: measure_semi_bigcup. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ msum + msum0 msum_ge0 msum_sigma_additive. + +End measure_sum. +Arguments msum {d T R}. + +Section measure_zero. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realFieldType). + +Definition mzero (A : set T) : \bar R := 0. + +Let mzero0 : mzero set0 = 0. Proof. by []. Qed. + +Let mzero_ge0 B : 0 <= mzero B. Proof. by []. Qed. + +Let mzero_sigma_additive : semi_sigma_additive mzero. +Proof. +move=> F mF tF mUF; rewrite [X in X @ \oo--> _](_ : _ = cst 0); first exact: cvg_cst. +by apply/funext => n; rewrite big1. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ mzero + mzero0 mzero_ge0 mzero_sigma_additive. + +End measure_zero. +Arguments mzero {d T R}. + +Lemma msum_mzero d (T : sigmaRingType d) (R : realType) + (m_ : {measure set T -> \bar R}^nat) : + msum m_ 0 = mzero. +Proof. by apply/funext => A/=; rewrite /msum big_ord0. Qed. + +Section measure_add. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realType). +Variables (m1 m2 : {measure set T -> \bar R}). + +Definition measure_add := msum (fun n => if n is 0%N then m1 else m2) 2. + +Lemma measure_addE A : measure_add A = m1 A + m2 A. +Proof. by rewrite /measure_add/= /msum 2!big_ord_recl/= big_ord0 adde0. Qed. + +End measure_add. + +Section measure_scale. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realFieldType). +Variables (r : {nonneg R}) (m : {measure set T -> \bar R}). + +Definition mscale (A : set T) : \bar R := r%:num%:E * m A. + +Let mscale0 : mscale set0 = 0. Proof. by rewrite /mscale measure0 mule0. Qed. + +Let mscale_ge0 B : 0 <= mscale B. +Proof. by rewrite /mscale mule_ge0. Qed. + +Let mscale_sigma_additive : semi_sigma_additive mscale. +Proof. +move=> F mF tF mUF; rewrite [X in X @ \oo --> _](_ : _ = + (fun n => (r%:num)%:E * \sum_(0 <= i < n) m (F i))); last first. + by apply/funext => k; rewrite ge0_sume_distrr. +rewrite /mscale; have [->|r0] := eqVneq r%:num 0%R. + rewrite mul0e [X in X @ \oo --> _](_ : _ = cst 0); first exact: cvg_cst. + by under eq_fun do rewrite mul0e. +by apply: cvgeZl => //; exact: measure_semi_sigma_additive. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ mscale + mscale0 mscale_ge0 mscale_sigma_additive. + +End measure_scale. +Arguments mscale {d T R}. + +Section measure_series. +Local Open Scope ereal_scope. +Context d (T : sigmaRingType d) (R : realType). +Variables (m : {measure set T -> \bar R}^nat) (n : nat). + +Definition mseries (A : set T) : \bar R := \sum_(n <= k F mF tF mUF; rewrite [X in _ --> X](_ : _ = + lim ((fun n => \sum_(0 <= i < n) mseries (F i)) @ \oo)); last first. + rewrite [in LHS]/mseries. + transitivity (\sum_(n <= k m k (\bigcup_n0 F n0))) => i ni. + exact: measure_semi_bigcup. + rewrite ereal_series nneseries_interchange//. + apply: (@eq_eseriesr _ (fun j => \sum_(i \sum_(n <= k i _; rewrite ereal_series. +apply: is_cvg_ereal_nneg_natsum => k _. +by rewrite /mseries ereal_series; exact: nneseries_ge0. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ mseries + mseries0 mseries_ge0 mseries_sigma_additive. + +End measure_series. +Arguments mseries {d T R}. + +Definition pushforward d1 d2 (T1 : sigmaRingType d1) (T2 : sigmaRingType d2) + (R : realFieldType) (m : set T1 -> \bar R) (f : T1 -> T2) + := fun A => m (f @^-1` A). +Arguments pushforward {d1 d2 T1 T2 R}. + +Section pushforward_measure. +Local Open Scope ereal_scope. +Context d d' (T1 : measurableType d) (T2 : measurableType d') + (R : realFieldType). +Variables (m : {measure set T1 -> \bar R}) (f : T1 -> T2). +Hypothesis mf : measurable_fun [set: T1] f. + +Let pushforward0 : pushforward m f set0 = 0. +Proof. by rewrite /pushforward preimage_set0 measure0. Qed. + +Let pushforward_ge0 A : 0 <= pushforward m f A. +Proof. by apply: measure_ge0; rewrite -[X in measurable X]setIT; apply: mf. Qed. + +Let pushforward_sigma_additive : semi_sigma_additive (pushforward m f). +Proof. +move=> F mF tF mUF; rewrite /pushforward preimage_bigcup. +apply: measure_semi_sigma_additive. +- by move=> n; rewrite -[X in measurable X]setTI; exact: mf. +- apply/trivIsetP => /= i j _ _ ij; rewrite -preimage_setI. + by move/trivIsetP : tF => /(_ _ _ _ _ ij) ->//; rewrite preimage_set0. +- by rewrite -preimage_bigcup -[X in measurable X]setTI; exact: mf. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ + (pushforward m f) pushforward0 pushforward_ge0 pushforward_sigma_additive. + +End pushforward_measure. + +Module SetRing. +Definition type (T : Type) := T. +Definition display : measure_display -> measure_display. Proof. by []. Qed. + +Section SetRing. +Local Open Scope ereal_scope. +Context d {T : semiRingOfSetsType d}. + +Notation rT := (type T). +#[export] +HB.instance Definition _ := Pointed.on rT. +#[export] +HB.instance Definition _ := isRingOfSets.Build (display d) rT + (@setring0 T measurable) (@setringU T measurable) (@setringD T measurable). + +Local Notation "d .-ring" := (display d). +Local Notation "d .-ring.-measurable" := + ((d%mdisp.-ring).-measurable : set (set (type _))). + +Local Definition measurable_fin_trivIset : set (set T) := + [set A | exists B : set (set T), + [/\ A = \bigcup_(X in B) X, forall X : set T, B X -> measurable X, + finite_set B & trivIset B id]]. + +Lemma ring_measurableE : d.-ring.-measurable = measurable_fin_trivIset. +Proof. +apply/seteqP; split; last first. + move=> _ [B [-> Bm Bfin Btriv]]; apply: fin_bigcup_measurable => //. + by move=> i Di; apply: sub_gen_smallest; apply: Bm. +have mdW A : measurable A -> measurable_fin_trivIset A. + move=> Am; exists [set A]; split; do ?by [rewrite bigcup_set1|move=> ? ->|]. + by move=> ? ? -> ->. +have mdI : setI_closed measurable_fin_trivIset. + move=> _ _ [A [-> Am Afin Atriv]] [B [-> Bm Bfin Btriv]]. + rewrite setI_bigcupl; under eq_bigcupr do rewrite setI_bigcupr. + rewrite -bigcup_setX -(bigcup_image _ _ id). + eexists; split; [reflexivity | | exact/finite_image/finite_setX |]. + by move=> _ [X [? ?] <-]; apply: measurableI; [apply: Am|apply: Bm]. + apply: trivIset_sets => -[a b] [a' b']/= [Xa Xb] [Xa' Xb']; rewrite setIACA. + by move=> [x [Ax Bx]]; rewrite (Atriv a a') 1?(Btriv b b')//; exists x. +have mdisj_bigcap : finN0_bigcap_closed measurable_fin_trivIset. + exact/finN0_bigcap_closedP/mdI. +have mDbigcup I (D : set I) (A : set T) (B : I -> set T) : finite_set D -> + measurable A -> (forall i, D i -> measurable (B i)) -> + measurable_fin_trivIset (A `\` \bigcup_(i in D) B i). + have [->|/set0P D0] := eqVneq D set0. + by rewrite bigcup0// setD0 => *; apply: mdW. + move=> Dfin Am Bm; rewrite -bigcupDr//; apply: mdisj_bigcap=> // i Di. + by have [F [Ffin Fm -> ?]] := semi_measurableD A (B i) Am (Bm _ Di); exists F. +have mdU : fin_trivIset_closed measurable_fin_trivIset. + elim/Pchoice=> I D F Dfin Ftriv Fm. + have /(_ _ (set_mem _))/cid-/(all_sig_cond_dep (fun=> set0)) + [G /(_ _ (mem_set _))GP] := Fm _ _. + under eq_bigcupr => i Di do case: (GP i Di) => ->. + rewrite -bigcup_setX_dep -(bigcup_image _ _ id); eexists; split=> //. + - by move=> _ [i [Di Gi] <-]; have [_ + _ _] := GP i.1 Di; apply. + - by apply: finite_image; apply: finite_setXR=> // i Di; have [] := GP i Di. + apply: trivIset_sets => -[i X] [j Y] /= [Di Gi] [Dj Gj] XYN0. + suff eqij : i = j. + by rewrite {i}eqij in Di Gi *; have [_ _ _ /(_ _ _ _ _ XYN0)->] := GP j Dj. + apply: Ftriv => //; have [-> _ _ _] := GP j Dj; have [-> _ _ _] := GP i Di. + by case: XYN0 => [x [Xx Yx]]; exists x; split; [exists X|exists Y]. +have mdDI : setD_closed measurable_fin_trivIset. + move=> A B mA mB; have [F [-> Fm Ffin Ftriv]] := mA. + have [F' [-> F'm F'fin F'triv]] := mB. + have [->|/set0P F'N0] := eqVneq F' set0. + by rewrite bigcup_set0 setD0; exists F. + rewrite setD_bigcupl; apply: mdU => //; first by apply: trivIset_setIr. + move=> X DX; rewrite -bigcupDr//; apply: mdisj_bigcap => //. + move=> Y DY; case: (semi_measurableD X Y); [exact: Fm|exact: F'm|]. + by move=> G [Gfin Gm -> Gtriv]; exists G. +apply: smallest_sub => //; split=> //; first by apply: mdW. +move=> A B mA mB; rewrite -(setUIDK B A) setUA [X in X `|` _]setUidl//. +rewrite -bigcup2inE; apply: mdU => //; last by move=> [|[]]// _; apply: mdDI. +by move=> [|[]]// [|[]]//= _ _ []; rewrite setDE ?setIA => X [] []//. +Qed. + +Lemma measurable_subring : (d.-measurable : set (set T)) `<=` d.-ring.-measurable. +Proof. by rewrite /measurable => X Xmeas /= M /= [_]; apply. Qed. + +Lemma ring_finite_set (A : set rT) : measurable A -> exists B : set (set T), + [/\ finite_set B, + (forall X, B X -> X !=set0), + trivIset B id, + (forall X : set T, X \in B -> measurable X) & + A = \bigcup_(X in B) X]. +Proof. +rewrite ring_measurableE => -[B [-> Bm Bfin Btriv]]. +exists (B `&` [set X | X != set0]); split. +- by apply: sub_finite_set Bfin; exact: subIsetl. +- by move=> ?/= [_ /set0P]. +- by move=> X Y/= [XB _] [YB _]; exact: Btriv. +- by move=> X/= /[!inE] -[] /Bm. +rewrite bigcup_mkcondr; apply: eq_bigcupr => X Bx; case: ifPn => //. +by rewrite notin_setE/= => /negP/negPn/eqP. +Qed. + +Definition decomp (A : set rT) : set (set T) := + if A == set0 then [set set0] else + if pselect (measurable A) is left mA then projT1 (cid (ring_finite_set mA)) + else [set A]. + +Lemma decomp_finite_set (A : set rT) : finite_set (decomp A). +Proof. +rewrite /decomp; case: ifPn => // A0; case: pselect => // X. +by case: cid => /= ? []. +Qed. + +Lemma decomp_triv (A : set rT) : trivIset (decomp A) id. +Proof. +rewrite /decomp; case: ifP => _; first by move=> i j/= -> ->. +case: pselect => // Am; first by case: cid => //= ? []. +by move=> i j /= -> ->. +Qed. +Hint Resolve decomp_triv : core. + +Lemma all_decomp_neq0 (A : set rT) : + A !=set0 -> (forall X, decomp A X -> X !=set0). +Proof. +move=> /set0P AN0; rewrite /decomp/= (negPf AN0). +case: pselect => //= Am; first by case: cid => //= ? []. +by move=> X ->; exact/set0P. +Qed. + +Lemma decomp_neq0 (A : set rT) X : A !=set0 -> X \in decomp A -> X !=set0. +Proof. by move=> /all_decomp_neq0/(_ X) /[!inE]. Qed. + +Lemma decomp_measurable (A : set rT) (X : set T) : + measurable A -> X \in decomp A -> measurable X. +Proof. +rewrite /decomp; case: ifP => _; first by rewrite inE => _ ->. +by case: pselect => // Am _; case: cid => //= ? [_ _ _ + _]; apply. +Qed. + +Lemma cover_decomp (A : set rT) : \bigcup_(X in decomp A) X = A. +Proof. +rewrite /decomp; case: ifP => [/eqP->|_]; first by rewrite bigcup0. +case: pselect => // Am; first by case: cid => //= ? []. +by rewrite bigcup_set1. +Qed. + +Lemma decomp_sub (A : set rT) (X : set T) : X \in decomp A -> X `<=` A. +Proof. +rewrite /decomp; case: ifP => _; first by rewrite inE/= => ->//. +case: pselect => //= Am; last by rewrite inE => ->. +by case: cid => //= D [_ _ _ _ ->] /[!inE] XD; apply: bigcup_sup. +Qed. + +Lemma decomp_set0 : decomp set0 = [set set0]. +Proof. by rewrite /decomp eqxx. Qed. + +Lemma decompN0 (A : set rT) : decomp A != set0. +Proof. +rewrite /decomp; case: ifPn => [_|AN0]; first by apply/set0P; exists set0. +case: pselect=> //= Am; last by apply/set0P; exists A. +case: cid=> //= D [_ _ _ _ Aeq]; apply: contra_neq AN0; rewrite Aeq => ->. +by rewrite bigcup_set0. +Qed. + +Definition measure (R : numDomainType) (mu : set T -> \bar R) + (A : set rT) : \bar R := \sum_(X \in decomp A) mu X. + +Section content. +Context {R : realFieldType} (mu : {content set T -> \bar R}). +Local Notation Rmu := (measure mu). +Arguments big_trivIset {I D T R idx op} A F. + +Lemma Rmu_fin_bigcup (I : choiceType) (D : set I) (F : I -> set T) : + finite_set D -> trivIset D F -> (forall i, i \in D -> measurable (F i)) -> + Rmu (\bigcup_(i in D) F i) = \sum_(i \in D) mu (F i). +Proof. +move=> Dfin Ftriv Fm; rewrite /measure. +have mUD : measurable (\bigcup_(i in D) F i : set rT). + apply: fin_bigcup_measurable => // *; apply: sub_gen_smallest. + exact/Fm/mem_set. +have [->|/set0P[i0 Di0]] := eqVneq D set0. + by rewrite bigcup_set0 decomp_set0 fsbig_set0 fsbig_set1. +set E := decomp _; have Em X := decomp_measurable mUD X. +transitivity (\sum_(X \in E) \sum_(i \in D) mu (X `&` F i)). + apply: eq_fsbigr => /= X XE; have XDF : X = \bigcup_(i in D) (X `&` F i). + by rewrite -setI_bigcupr setIidl//; exact: decomp_sub. + rewrite [in LHS]XDF content_fin_bigcup//; first exact: trivIset_setIl. + - by move=> i /mem_set Di; apply: measurableI; [exact: Em|exact: Fm]. + - by rewrite -XDF; exact: Em. +rewrite exchange_fsbig //; last exact: decomp_finite_set. +apply: eq_fsbigr => i Di; have Feq : F i = \bigcup_(X in E) (X `&` F i). + rewrite -setI_bigcupl setIidr// cover_decomp. + by apply/bigcup_sup; exact: set_mem. +rewrite -content_fin_bigcup -?Feq//; [exact/decomp_finite_set| | |exact/Fm]. +- exact/trivIset_setIr/decomp_triv. +- by move=> X /= XE; apply: measurableI; [apply: Em; rewrite inE | exact: Fm]. +Qed. + +Lemma RmuE (A : set T) : measurable A -> Rmu A = mu A. +Proof. +move=> Am; rewrite -[A in LHS](@bigcup_set1 _ unit _ tt). +by rewrite Rmu_fin_bigcup// ?fsbig_set1// => -[]. +Qed. + +Let Rmu0 : Rmu set0 = 0. +Proof. +rewrite -(bigcup_set0 (fun _ : void => set0)). +by rewrite Rmu_fin_bigcup// fsbig_set0. +Qed. + +Lemma Rmu_ge0 A : (Rmu A >= 0)%E. +Proof. by rewrite sume_ge0. Qed. + +Lemma Rmu_additive : semi_additive Rmu. +Proof. +apply/(additive2P Rmu0) => // A B /ring_finite_set[/= {}A [? _ Atriv Am ->]]. +move=> /ring_finite_set[/= {}B [? _ Btriv Bm ->]]. +rewrite -subset0 => coverAB0. +have AUBfin : finite_set (A `|` B) by rewrite finite_setU. +have AUBtriv : trivIset (A `|` B) id. + move=> X Y [] ABX [] ABY; do ?by [exact: Atriv|exact: Btriv]. + by move=> [u [Xu Yu]]; case: (coverAB0 u); split; [exists X|exists Y]. + by move=> [u [Xu Yu]]; case: (coverAB0 u); split; [exists Y|exists X]. +rewrite -bigcup_setU !Rmu_fin_bigcup//=. +- rewrite fsbigU//= => [X /= [XA XB]]; have [->//|/set0P[x Xx]] := eqVneq X set0. + by case: (coverAB0 x); split; exists X. +- by move=> X /set_mem [|] /mem_set ?; [exact: Am|exact: Bm]. +Qed. + +#[export] +HB.instance Definition _ := isContent.Build _ _ _ Rmu Rmu_ge0 Rmu_additive. + +End content. + +End SetRing. +Module Exports. +HB.reexport. +HB.reexport SetRing. +End Exports. +End SetRing. +Export SetRing.Exports. +Notation "d .-ring" := (SetRing.display d) : measure_display_scope. +Notation "d .-ring.-measurable" := + ((d%mdisp.-ring).-measurable : set (set (SetRing.type _))) : classical_set_scope. + +Lemma le_measure d (R : realFieldType) (T : semiRingOfSetsType d) + (mu : {content set T -> \bar R}) : + {in measurable &, {homo mu : A B / A `<=` B >-> (A <= B)%E}}. +Proof. +move=> A B; rewrite ?inE => mA mB AB; have [|muBfin] := leP +oo%E (mu B). + by rewrite leye_eq => /eqP ->; rewrite leey. +rewrite -[leRHS]SetRing.RmuE// -[B](setDUK AB) measureU/= ?setDIK//. +- by rewrite SetRing.RmuE ?leeDl. +- exact: sub_gen_smallest. +- by apply: measurableD; exact: sub_gen_smallest. +Qed. + +Lemma measure_le0 d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : {content set T -> \bar R}) (A : set T) : + (mu A <= 0)%E = (mu A == 0)%E. +Proof. by case: ltgtP (measure_ge0 mu A). Qed. + +Section more_content_semiring_lemmas. +Context d (R : realFieldType) (T : semiRingOfSetsType d). +Variable mu : {content set T -> \bar R}. + +Lemma content_subadditive : subadditive mu. +Proof. +move=> X A n Am Xm XA; pose B i := A\_`I_n i `&` X. +have XE : X = \big[setU/set0]_(i < n) B i. + rewrite -big_distrl/= setIidr// => x /XA/=. + by rewrite -!bigcup_mkord => -[k nk Ax]; exists k; rewrite // patchT ?inE. +have Bm i : measurable (B i). + case: (ltnP i n) => ltin; last by rewrite /B patchC ?inE ?set0I//= leq_gtF. + by rewrite /B ?patchT ?inE//; apply: measurableI => //; apply: Am. +have subBA i : B i `<=` A i. + by rewrite /B/patch; case: ifP; rewrite // set0I//= => _ ?. +have subDUB i : seqDU B i `<=` A i by move=> x [/subBA]. +have DUBm i : measurable (seqDU B i : set (SetRing.type T)). + apply: measurableD; first exact: sub_gen_smallest. + by apply: bigsetU_measurable => ? _; apply: sub_gen_smallest. +have DU0 i : (i >= n)%N -> seqDU B i = set0. + move=> leni; rewrite -subset0 => x []; rewrite /B patchC ?inE/= ?leq_gtF//. + by case. +rewrite -SetRing.RmuE// XE bigsetU_seqDU measure_bigsetU//. +rewrite [leRHS](big_ord_widen n (mu \o A))//= [leRHS]big_mkcond/=. +rewrite lee_sum => // i _; case: ltnP => ltin; last by rewrite DU0 ?measure0. +rewrite -[leRHS]SetRing.RmuE; last exact: Am. +by rewrite le_measure ?inE//=; last by apply: sub_gen_smallest; apply: Am. +Qed. + +Lemma content_sub_fsum (I : choiceType) D (A : set T) (A_ : I -> set T) : + finite_set D -> + (forall i, D i -> measurable (A_ i)) -> + measurable A -> + A `<=` \bigcup_(i in D) A_ i -> (mu A <= \sum_(i \in D) mu (A_ i))%E. +Proof. +elim/choicePpointed: I => I in A_ D *. + rewrite !emptyE bigcup_set0// subset0 => _ _ _ ->. + by rewrite measure0 fsbig_set0. +move=> Dfin A_m Am Asub; have [n /ppcard_eqP[f]] := Dfin. +rewrite (reindex_fsbig f^-1%FUN `I_n)//= -fsbig_ord. +rewrite (@content_subadditive A (A_ \o f^-1%FUN))//=. + by move=> i ltin; apply: A_m; apply: funS. +rewrite (fsbig_ord _ _ (A_ \o f^-1%FUN))/= -(reindex_fsbig _ _ D)//=. +by rewrite fsbig_setU. +Qed. + +(* (* alternative proof *) *) +(* Theorem semi_Boole_inequality : sub_additive mu. *) +(* Proof. *) +(* move=> X A n Am Xm Xsub; rewrite -SetRing.RmuE//. *) +(* under eq_bigr => i do [rewrite -SetRing.RmuE; do ?by apply: Am=> /=]. *) +(* pose rT := SetRing.type T. *) +(* have {}Am i : `I_n i -> measurable (A i : set rT). *) +(* by move=> *; apply/SetRing.measurableW/Am => /=. *) +(* have {}Xm : measurable (X : set rT) by exact: SetRing.measurableW. *) +(* pose ammu := [additive_measure of SetRing.measure mu]. *) +(* rewrite (le_trans (le_measure ammu _ _ Xsub)) ?inE// {Xsub}. *) +(* by rewrite -bigcup_mkord; apply: fin_bigcup_measurable. *) +(* elim: n Am Xm => [|n IHn] Am Xm; first by rewrite !big_ord0 measure0. *) +(* have Anm : measurable (A n : set rT) by apply: Am => /=. *) +(* set B := \big[setU/set0]_(i < n) A i. *) +(* set C := \big[setU/set0]_(i < n.+1) A i. *) +(* have -> : C = B `|` (A n `\` B). *) +(* suff -> : A n `\` B = C `\` B by rewrite setDUK// /C big_ord_recr/=; left. *) +(* by rewrite /C big_ord_recr/= !setDE setIUl -!setDE setDv set0U. *) +(* have Bm : measurable (B : set rT). *) +(* by rewrite -[B]bigcup_mkord; apply: fin_bigcup_measurable => //= i /ltnW/Am. *) +(* rewrite measureU // ?setDIK//; last exact: measurableD. *) +(* rewrite (@le_trans _ _ (ammu B + ammu (A n))) // ?leeD2l //; last first. *) +(* by rewrite big_ord_recr /= leeD2r// IHn// => i /ltnW/Am. *) +(* by rewrite le_measure // ?inE// ?setDE//; exact: measurableD. *) +(* Qed. *) + +End more_content_semiring_lemmas. + +Section content_ring_lemmas. +Local Open Scope ereal_scope. +Context d (R : realType) (T : ringOfSetsType d). +Variable mu : {content set T -> \bar R}. + +Lemma content_ring_sup_sigma_additive (A : nat -> set T) : + (forall i, measurable (A i)) -> measurable (\bigcup_i A i) -> + trivIset [set: nat] A -> \sum_(i Am UAm At; rewrite lime_le//; first exact: is_cvg_nneseries. +near=> n; rewrite big_mkord -measure_bigsetU//= le_measure ?inE//=. +- exact: bigsetU_measurable. +- by rewrite -bigcup_mkord; apply: bigcup_sub => i lein; apply: bigcup_sup. +Unshelve. all: by end_near. Qed. + +Lemma content_ring_sigma_additive : + measurable_subset_sigma_subadditive mu -> semi_sigma_additive mu. +Proof. +move=> mu_sub A Am Atriv UAm. +suff <- : \sum_(i \bar R}). +Local Notation Rmu := (SetRing.measure mu). +Import SetRing. + +Lemma ring_sigma_subadditive : + measurable_subset_sigma_subadditive mu -> + measurable_subset_sigma_subadditive Rmu. +Proof. +move=> muS; move=> /= D A Am Dm Dsub. +rewrite /Rmu -(eq_eseriesr (fun _ _ => esum_fset _ _))//; last first. + by move=> *; exact: decomp_finite_set. +rewrite nneseries_esum ?esum_esum//=; last by move=> *; rewrite esum_ge0. +set K := _ `*`` _. +have /ppcard_eqP[f] : (K #= [set: nat])%card. + apply: cardXR_eq_nat => [|i]. + by rewrite (_ : [set _ | true] = setT)//; exact/predeqP. + split; first by apply/finite_set_countable; exact: decomp_finite_set. + exact/set0P/decompN0. +have {Dsub} : D `<=` \bigcup_(k in K) k.2. + apply: (subset_trans Dsub); apply: bigcup_sub => i _. + rewrite -[A i]cover_decomp; apply: bigcup_sub => X/= XAi. + by move=> x Xx; exists (i, X). +rewrite -(image_eq [bij of f^-1%FUN])/=. +rewrite (esum_set_image _ f^-1)//= bigcup_image => Dsub. +have DXsub X : X \in decomp D -> X `<=` \bigcup_i ((f^-1%FUN i).2 `&` X). + move=> XD; rewrite -setI_bigcupl -[Y in Y `<=` _](setIidr (decomp_sub XD)). + by apply: setSI. +have mf i : measurable ((f^-1)%function i).2. + have [_ /mem_set/decomp_measurable] := 'invS_f (I : setT i). + by apply; exact: Am. +have mfD i X : X \in decomp D -> measurable (((f^-1)%FUN i).2 `&` X : set T). + by move=> XD; apply: measurableI; [exact: mf|exact: (decomp_measurable _ XD)]. +apply: (@le_trans _ _ + (\sum_(i X /[!in_fset_set]; last exact: decomp_finite_set. + move=> XD; have Xm := decomp_measurable Dm XD. + by apply: muS => // [i|]; [exact: mfD|exact: DXsub]. +apply: lee_lim => /=; do ?apply: is_cvg_nneseries=> //. + by move=> n _ _; exact: sume_ge0. +near=> n; rewrite [n in _ <= n]big_mkcond; apply: lee_sum => i _. +rewrite ifT ?inE//. +under eq_big_seq. + move=> x; rewrite in_fset_set=> [xD|]; last exact: decomp_finite_set. + rewrite -RmuE//; last exact: mfD. + over. +rewrite -fsbig_finite/=; last exact: decomp_finite_set. +rewrite -measure_fin_bigcup//=. +- rewrite -setI_bigcupr (cover_decomp D) -[leRHS]RmuE// ?le_measure ?inE//. + by apply: measurableI => //; apply: sub_gen_smallest; apply: mf. + by apply: sub_gen_smallest; apply: mf. +- exact: decomp_finite_set. +- by apply: trivIset_setIl; apply: decomp_triv. +- by move=> X /= XD; apply: sub_gen_smallest; apply: mfD; rewrite inE. +Unshelve. all: by end_near. Qed. + +Lemma ring_semi_sigma_additive : + measurable_subset_sigma_subadditive mu -> semi_sigma_additive Rmu. +Proof. +by move=> mu_sub; exact/content_ring_sigma_additive/ring_sigma_subadditive. +Qed. + +Lemma semiring_sigma_additive : + measurable_subset_sigma_subadditive mu -> semi_sigma_additive mu. +Proof. +move=> /ring_semi_sigma_additive Rmu_sigmadd F Fmeas Ftriv cupFmeas. +have Fringmeas i : d.-ring.-measurable (F i) by apply: measurable_subring. +have := Rmu_sigmadd F Fringmeas Ftriv (measurable_subring cupFmeas). +rewrite SetRing.RmuE//. +by under eq_fun do under eq_bigr do rewrite SetRing.RmuE//=. +Qed. + +End ring_sigma_subadditive_content. + +#[key="mu"] +HB.factory Record Content_SigmaSubAdditive_isMeasure d (R : realType) + (T : semiRingOfSetsType d) (mu : set T -> \bar R) of Content d mu := { + measure_sigma_subadditive : measurable_subset_sigma_subadditive mu }. + +HB.builders Context d (R : realType) (T : semiRingOfSetsType d) + (mu : set T -> \bar R) of Content_SigmaSubAdditive_isMeasure d R T mu. + +HB.instance Definition _ := Content_isMeasure.Build d T R mu + (semiring_sigma_additive (measure_sigma_subadditive)). + +HB.end. + +Section more_premeasure_ring_lemmas. +Local Open Scope ereal_scope. +Context d (R : realType) (T : semiRingOfSetsType d). +Variable mu : {measure set T -> \bar R}. +Import SetRing. + +Lemma measure_sigma_subadditive : measurable_subset_sigma_subadditive mu. +Proof. +move=> X A Am Xm XA; pose B i := A i `&` X. +have XE : X = \bigcup_i B i by rewrite -setI_bigcupl setIidr. +have Bm i : measurable (B i) by rewrite /B; apply: measurableI. +have subBA i : B i `<=` A i by rewrite /B. +have subDUB i : seqDU B i `<=` A i by move=> x [/subBA]. +have DUBm i : measurable (seqDU B i : set (SetRing.type T)). + by apply: measurableD => //; + do 1?apply: bigsetU_measurable => *; apply: sub_gen_smallest. +rewrite XE; move: (XE); rewrite seqDU_bigcup_eq. +under eq_bigcupr do rewrite -[seqDU B _]cover_decomp//. +rewrite -bigcup_setX_dep; set K := _ `*`` _. +have /ppcard_eqP[f] : (K #= [set: nat])%card. + apply: cardXR_eq_nat=> // i; split; last by apply/set0P; rewrite decompN0. + exact/finite_set_countable/decomp_finite_set. +pose f' := f^-1%FUN; rewrite -(image_eq [bij of f'])/= bigcup_image/=. +pose g n := (f' n).2; have fVtriv : trivIset [set: nat] g. + move=> i j _ _; rewrite /g. + have [/= _ f'iB] : K (f' i) by apply: funS. + have [/= _ f'jB] : K (f' j) by apply: funS. + have [f'ij|f'ij] := eqVneq (f' i).1 (f' j).1. + move=> /(decomp_triv f'iB)/=; rewrite f'ij => /(_ f'jB) f'ij2. + apply: 'inj_f'; rewrite ?inE//= -!/(f' _); move: f'ij f'ij2. + by case: (f' i) (f' j) => [? ?] [? ?]//= -> ->. + move=> [x [f'ix f'jx]]; have Bij := @trivIset_seqDU _ B (f' i).1 (f' j).1 I I. + rewrite Bij ?eqxx// in f'ij; exists x; split. + - by move/mem_set : f'iB => /decomp_sub; apply. + - by move/mem_set : f'jB => /decomp_sub; apply. +have g_inj : set_inj [set i | g i != set0] g. + by apply: trivIset_inj=> [i /set0P//|]; apply: sub_trivIset fVtriv. +move=> XEbig; rewrite measure_semi_bigcup//= -?XEbig//; last first. + move=> i; have [/= _ /mem_set] : K (f' i) by apply: funS. + exact: decomp_measurable. +rewrite [leLHS](_ : _ = \sum_(i i _; rewrite ifT ?inE//=; case: ifPn => //. + by rewrite notin_setE /= -/(g _) => /negP/negPn/eqP ->. +rewrite -(esum_pred_image mu g)//. +rewrite [leLHS](_ : _ = \esum_(X in range g) mu X); last first. + rewrite esum_mkcond [RHS]esum_mkcond; apply: eq_esum. + move=> Y _; case: ifPn; rewrite ?(inE, notin_setE)/=. + by move=> [i giN0 giY]; rewrite ifT// ?inE//=; exists i. + move=> Ngx; case: ifPn; rewrite ?(inE, notin_setE)//=. + move=> [i _ giY]; apply: contra_not_eq Ngx; rewrite -giY => mugi. + by exists i => //; apply: contra_neq mugi => ->; rewrite measure0. +have -> : range g = \bigcup_i (decomp (seqDU B i)). + apply/predeqP => /= Y; split => [[n _ gnY]|[n _ /= YBn]]. + have [/= _ f'nB] : K (f' n) by apply: funS. + by exists (f' n).1 => //=; rewrite -gnY. + by exists (f (n, Y)) => //; rewrite /g /f' funK//= inE. +rewrite esum_bigcup//; last first. + move=> i j /=. + have [->|/set0P DUBiN0] := eqVneq (seqDU B i) set0. + rewrite decomp_set0 ?set_fset1 => /negP[]. + apply/eqP/predeqP=> x; split=> [[Y/=->]|->]//; first by rewrite measure0. + by exists set0. + have [->|/set0P DUBjN0] := eqVneq (seqDU B j) set0. + rewrite decomp_set0 ?set_fset1 => _ /negP[]. + apply/eqP/predeqP=> x; split=> [[Y/=->]|->]//=; first by rewrite measure0. + by exists set0. + move=> _ _ [Y /= [/[dup] +]]. + move=> /mem_set /decomp_sub YBi /mem_set + /mem_set /decomp_sub YBj. + move=> /(decomp_neq0 DUBiN0) [y Yy]. + apply: (@trivIset_seqDU _ B) => //; exists y. + by split => //; [exact: YBi|exact: YBj]. +rewrite nneseries_esumT// le_esum// => i _. +rewrite [leLHS](_ : _ = \sum_(j \in decomp (seqDU B i)) mu j); last first. + by rewrite esum_fset//; exact: decomp_finite_set. +rewrite -SetRing.Rmu_fin_bigcup//=; last 3 first. + exact: decomp_finite_set. + exact: decomp_triv. + by move=> ?; exact: decomp_measurable. +rewrite -[leRHS]SetRing.RmuE// le_measure//; last by rewrite cover_decomp. +- rewrite inE; apply: fin_bigcup_measurable; first exact: decomp_finite_set. + move=> j /mem_set jdec; apply: sub_gen_smallest. + exact: decomp_measurable jdec. +- by rewrite inE; apply: sub_gen_smallest; exact: Am. +Qed. + +End more_premeasure_ring_lemmas. + +Lemma measure_sigma_subadditive_tail d (R : realType) (T : semiRingOfSetsType d) + (mu : {measure set T -> \bar R}) (A : set T) (F : nat -> set T) N : + (forall n, measurable (F n)) -> measurable A -> + A `<=` \bigcup_(n in ~` `I_N) F n -> + (mu A <= \sum_(N <= n mF mA AF; rewrite eseries_cond eseries_mkcondr. +rewrite (@eq_eseriesr _ _ (fun n => mu (if (N <= n)%N then F n else set0))). +- apply: measure_sigma_subadditive => //. + + by move=> n; case: ifPn. + + move: AF; rewrite bigcup_mkcond. + by under eq_bigcupr do rewrite mem_not_I. +- by move=> o _; rewrite (fun_if mu) measure0. +Qed. + +Section ring_sigma_content. +Context d (R : realType) (T : semiRingOfSetsType d) + (mu : {measure set T -> \bar R}). +Local Notation Rmu := (SetRing.measure mu). +Import SetRing. + +Let ring_sigma_content : semi_sigma_additive Rmu. +Proof. exact/ring_semi_sigma_additive/measure_sigma_subadditive. Qed. + +HB.instance Definition _ := Content_isMeasure.Build _ _ _ Rmu + ring_sigma_content. + +End ring_sigma_content. + +Definition fin_num_fun d (T : semiRingOfSetsType d) (R : numDomainType) + (mu : set T -> \bar R) := forall U, measurable U -> mu U \is a fin_num. + +Lemma fin_num_fun_lty d (T : algebraOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) : fin_num_fun mu -> (mu setT < +oo)%E. +Proof. by move=> h; rewrite ltey_eq h. Qed. + +Lemma lty_fin_num_fun d (T : algebraOfSetsType d) + (R : realFieldType) (mu : {measure set T -> \bar R}) : + (mu setT < +oo)%E -> fin_num_fun mu. +Proof. +move=> h U mU; rewrite fin_real// (lt_le_trans _ (measure_ge0 mu U))//=. +by rewrite (le_lt_trans _ h)//= le_measure// inE. +Qed. + +Definition sfinite_measure d (T : sigmaRingType d) (R : realType) + (mu : set T -> \bar R) := + exists2 s : {measure set T -> \bar R}^nat, + forall n, fin_num_fun (s n) & + forall U, measurable U -> mu U = mseries s 0 U. + +Definition sigma_finite d (T : semiRingOfSetsType d) (R : numDomainType) + (A : set T) (mu : set T -> \bar R) := + exists2 F : (set T)^nat, A = \bigcup_(i : nat) F i & + forall i, measurable (F i) /\ (mu (F i) < +oo)%E. + +Lemma fin_num_fun_sigma_finite d (T : algebraOfSetsType d) + (R : realFieldType) (mu : set T -> \bar R) : (mu set0 < +oo)%E -> + fin_num_fun mu -> sigma_finite setT mu. +Proof. +move=> muoo; exists (fun i => if i \in [set 0%N] then setT else set0). + by rewrite -bigcup_mkcondr setTI bigcup_const//; exists 0%N. +by move=> n; split; case: ifPn => // _; rewrite fin_num_fun_lty. +Qed. + +Definition mrestr d (T : sigmaRingType d) (R : realFieldType) (D : set T) + (f : set T -> \bar R) (mD : measurable D) := fun X => f (X `&` D). + +Section measure_restr. +Context d (T : sigmaRingType d) (R : realFieldType). +Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). + +Local Notation restr := (mrestr mu mD). + +Let restr0 : restr set0 = 0%E. Proof. by rewrite /mrestr set0I. Qed. + +Let restr_ge0 (A : set _) : (0 <= restr A)%E. +Proof. by rewrite /restr; apply: measure_ge0; exact: measurableI. Qed. + +Let restr_sigma_additive : semi_sigma_additive restr. +Proof. +move=> F mF tF mU; pose FD i := F i `&` D. +have mFD i : measurable (FD i) by exact: measurableI. +have tFD : trivIset setT FD. + apply/trivIsetP => i j _ _ ij. + move/trivIsetP : tF => /(_ i j Logic.I Logic.I ij). + by rewrite /FD setIACA => ->; rewrite set0I. +by rewrite /restr setI_bigcupl; exact: measure_sigma_additive. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ restr + restr0 restr_ge0 restr_sigma_additive. + +End measure_restr. + +Lemma sfinite_measure_sigma_finite d (T : measurableType d) + (R : realType) (mu : {measure set T -> \bar R}) : + sigma_finite setT mu -> sfinite_measure mu. +Proof. +move=> [F UF mF]; rewrite /sfinite_measure. +have mDF k : measurable (seqDU F k). + apply: measurableD; first exact: (mF k).1. + by apply: bigsetU_measurable => i _; exact: (mF i).1. +exists (fun k => mrestr mu (mDF k)) => [n|U mU]. +- apply: lty_fin_num_fun => //=. + rewrite /mrestr setTI (@le_lt_trans _ _ (mu (F n)))//. + + apply: le_measure; last exact: subDsetl. + * rewrite inE; apply: measurableD; first exact: (mF n).1. + by apply: bigsetU_measurable => i _; exact: (mF i).1. + * by rewrite inE; exact: (mF n).1. + + exact: (mF n).2. +rewrite /mseries/= /mrestr/=; apply/esym/cvg_lim => //. +rewrite -[X in _ --> mu X]setIT UF seqDU_bigcup_eq setI_bigcupr. +apply: (@measure_sigma_additive _ _ _ mu (fun k => U `&` seqDU F k)). + by move=> i; exact: measurableI. +exact/trivIset_setIl/trivIset_seqDU. +Qed. + +HB.mixin Record isSFinite d (T : sigmaRingType d) (R : realType) + (mu : set T -> \bar R) := { + s_finite : sfinite_measure mu }. + +HB.structure Definition SFiniteMeasure d (T : sigmaRingType d) (R : realType) := + {mu of @Measure _ T R mu & isSFinite _ T R mu }. +Arguments s_finite {d T R} _. + +Notation "{ 'sfinite_measure' 'set' T '->' '\bar' R }" := + (SFiniteMeasure.type T R) : ring_scope. + +HB.mixin Record isSigmaFinite d (T : semiRingOfSetsType d) (R : numFieldType) + (mu : set T -> \bar R) := { sigma_finiteT : sigma_finite setT mu }. + +#[short(type="sigma_finite_content")] +HB.structure Definition SigmaFiniteContent d T R := + { mu of @Content d T R mu & isSigmaFinite d T R mu }. + +Arguments sigma_finiteT {d T R} s. +#[global] Hint Resolve sigma_finiteT : core. + +Notation "{ 'sigma_finite_content' 'set' T '->' '\bar' R }" := + (sigma_finite_content T R) : ring_scope. + +#[short(type="sigma_finite_measure")] +HB.structure Definition SigmaFiniteMeasure d T R := + { mu of @SFiniteMeasure d T R mu & isSigmaFinite d T R mu }. + +Notation "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }" := + (sigma_finite_measure T R) : ring_scope. + +HB.factory Record Measure_isSigmaFinite d (T : measurableType d) + (R : realType) (mu : set T -> \bar R) of isMeasure _ _ _ mu := + { sigma_finiteT : sigma_finite setT mu }. + +HB.builders Context d (T : measurableType d) (R : realType) + mu of @Measure_isSigmaFinite d T R mu. + +Lemma sfinite : sfinite_measure mu. +Proof. exact/sfinite_measure_sigma_finite/sigma_finiteT. Qed. + +HB.instance Definition _ := @isSFinite.Build _ _ _ mu sfinite. + +HB.instance Definition _ := @isSigmaFinite.Build _ _ _ mu sigma_finiteT. + +HB.end. + +Lemma sigma_finite_mzero d (T : measurableType d) (R : realFieldType) : + sigma_finite setT (@mzero d T R). +Proof. by apply: fin_num_fun_sigma_finite => //; rewrite measure0. Qed. + +HB.instance Definition _ d (T : measurableType d) (R : realFieldType) := + @isSigmaFinite.Build d T R mzero (@sigma_finite_mzero d T R). + +Lemma sfinite_mzero d (T : measurableType d) (R : realType) : + sfinite_measure (@mzero d T R). +Proof. exact/sfinite_measure_sigma_finite/sigma_finite_mzero. Qed. + +HB.instance Definition _ d (T : measurableType d) (R : realType) := + @isSFinite.Build d T R mzero (@sfinite_mzero d T R). + +HB.mixin Record isFinite d (T : semiRingOfSetsType d) (R : numDomainType) + (k : set T -> \bar R) := { fin_num_measure : fin_num_fun k }. + +HB.structure Definition FinNumFun d (T : semiRingOfSetsType d) + (R : numFieldType) := { k of isFinite _ T R k }. + +HB.structure Definition FiniteMeasure d (T : sigmaRingType d) (R : realType) := + { k of @SigmaFiniteMeasure _ _ _ k & isFinite _ T R k }. +Arguments fin_num_measure {d T R} _. + +Notation "{ 'finite_measure' 'set' T '->' '\bar' R }" := + (FiniteMeasure.type T R) : ring_scope. + +HB.factory Record Measure_isFinite d (T : measurableType d) + (R : realType) (k : set T -> \bar R) + of isMeasure _ _ _ k := { fin_num_measure : fin_num_fun k }. + +HB.builders Context d (T : measurableType d) (R : realType) k + of Measure_isFinite d T R k. + +Let sfinite : sfinite_measure k. +Proof. +apply: sfinite_measure_sigma_finite. +by apply: fin_num_fun_sigma_finite; [rewrite measure0|exact: fin_num_measure]. +Qed. + +HB.instance Definition _ := @isSFinite.Build d T R k sfinite. + +Let sigma_finite : sigma_finite setT k. +Proof. +by apply: fin_num_fun_sigma_finite; [rewrite measure0|exact: fin_num_measure]. +Qed. + +HB.instance Definition _ := @isSigmaFinite.Build d T R k sigma_finite. + +Let finite : fin_num_fun k. Proof. exact: fin_num_measure. Qed. + +HB.instance Definition _ := @isFinite.Build d T R k finite. + +HB.end. + +Section finite_restr. +Context d (T : measurableType d) (R : realType). +Variables (mu : {finite_measure set T -> \bar R}) (D : set T). +Hypothesis mD : measurable D. + +Local Notation restr := (mrestr mu mD). + +Let fin_num_restr : fin_num_fun restr. +Proof. +move=> A mA; have := fin_num_measure mu A mA. +rewrite !ge0_fin_numE//=; apply: le_lt_trans. +by rewrite /mrestr; apply: le_measure => //; rewrite inE//=; exact: measurableI. +Qed. + +HB.instance Definition _ := @Measure_isFinite.Build _ T _ restr fin_num_restr. + +End finite_restr. + +Section finite_mscale. +Context d (T : measurableType d) (R : realType). +Variables (mu : {finite_measure set T -> \bar R}) (r : {nonneg R}). + +Local Notation scale := (mscale r mu). + +Let fin_num_scale : fin_num_fun scale. +Proof. +by move=> A mA; have muA := fin_num_measure mu A mA; rewrite fin_numM. +Qed. + +HB.instance Definition _ := @Measure_isFinite.Build _ T _ scale fin_num_scale. + +End finite_mscale. + +HB.factory Record Measure_isSFinite d (T : sigmaRingType d) + (R : realType) (k : set T -> \bar R) of isMeasure _ _ _ k := { + s_finite : exists s : {finite_measure set T -> \bar R}^nat, + forall U, measurable U -> k U = mseries s 0 U }. + +HB.builders Context d (T : sigmaRingType d) (R : realType) + k of Measure_isSFinite d T R k. + +Let sfinite : sfinite_measure k. +Proof. +have [s sE] := s_finite. +by exists s => //=> n; exact: fin_num_measure. +Qed. + +HB.instance Definition _ := @isSFinite.Build d T R k sfinite. + +HB.end. + +Section sfinite_measure. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) + (mu : {sfinite_measure set T -> \bar R}). + +Let s : (set T -> \bar R)^nat := let: exist2 x _ _ := cid2 (s_finite mu) in x. + +Let s0 n : s n set0 = 0. +Proof. by rewrite /s; case: cid2. Qed. + +Let s_ge0 n x : 0 <= s n x. +Proof. by rewrite /s; case: cid2. Qed. + +Let s_semi_sigma_additive n : semi_sigma_additive (s n). +Proof. +by rewrite /s; case: cid2 => s' s'1 s'2; exact: measure_semi_sigma_additive. +Qed. + +HB.instance Definition _ n := @isMeasure.Build _ _ _ (s n) (s0 n) (s_ge0 n) + (@s_semi_sigma_additive n). + +Let s_fin n : fin_num_fun (s n). +Proof. by rewrite /s; case: cid2 => F finF muE; exact: finF. Qed. + +HB.instance Definition _ n := @Measure_isFinite.Build d T R (s n) (s_fin n). + +Definition sfinite_measure_seq : {finite_measure set T -> \bar R}^nat := s. + +Lemma sfinite_measure_seqP U : measurable U -> + mu U = mseries sfinite_measure_seq O U. +Proof. +by move=> mU; rewrite /mseries /= /s; case: cid2 => // x xfin ->. +Qed. + +End sfinite_measure. + +Definition mfrestr d (T : measurableType d) (R : realFieldType) (D : set T) + (f : set T -> \bar R) (mD : measurable D) of (f D < +oo)%E := + mrestr f mD. + +Section measure_frestr. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). +Hypothesis moo : mu D < +oo. + +Local Notation restr := (mfrestr mD moo). + +HB.instance Definition _ := Measure.on restr. + +Let restr_fin : fin_num_fun restr. +Proof. +move=> U mU; rewrite /restr /mrestr ge0_fin_numE ?measure_ge0//. +by rewrite (le_lt_trans _ moo)// le_measure// ?inE//; exact: measurableI. +Qed. + +HB.instance Definition _ := Measure_isFinite.Build _ _ _ restr restr_fin. + +End measure_frestr. + +Section content_semiRingOfSetsType. +Local Open Scope ereal_scope. +Context d (T : semiRingOfSetsType d) (R : realFieldType). +Variables (mu : {content set T -> \bar R}) (A B : set T). +Hypotheses (mA : measurable A) (mB : measurable B). + +Lemma measureIl : mu (A `&` B) <= mu A. +Proof. by rewrite le_measure ?inE//; apply: measurableI. Qed. + +Lemma measureIr : mu (A `&` B) <= mu B. +Proof. by rewrite le_measure ?inE//; apply: measurableI. Qed. + +Lemma subset_measure0 : A `<=` B -> mu B = 0 -> mu A = 0. +Proof. by move=> ? B0; apply/eqP; rewrite -measure_le0 -B0 le_measure ?inE. Qed. + +End content_semiRingOfSetsType. + +Section content_ringOfSetsType. +Local Open Scope ereal_scope. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variable mu : {content set T -> \bar R}. +Implicit Types A B : set T. + +Lemma measureDI A B : measurable A -> measurable B -> + mu A = mu (A `\` B) + mu (A `&` B). +Proof. +move=> mA mB; rewrite -measure_semi_additive2. +- by rewrite -setDDr setDv setD0. +- exact: measurableD. +- exact: measurableI. +- by apply: measurableU; [exact: measurableD |exact: measurableI]. +- by rewrite setDE setIACA setICl setI0. +Qed. + +Lemma measureD A B : measurable A -> measurable B -> + mu A < +oo -> mu (A `\` B) = mu A - mu (A `&` B). +Proof. +move=> mA mB mAoo. +rewrite (measureDI mA mB) addeK// fin_numE 1?gt_eqF 1?lt_eqF//. +- by rewrite (le_lt_trans _ mAoo)// le_measure // ?inE//; exact: measurableI. +- by rewrite (lt_le_trans _ (measure_ge0 _ _)). +Qed. + +Lemma measureU2 A B : measurable A -> measurable B -> + mu (A `|` B) <= mu A + mu B. +Proof. +move=> ? ?; rewrite -bigcup2inE bigcup_mkord. +rewrite (le_trans (@content_subadditive _ _ _ mu _ (bigcup2 A B) 2%N _ _ _))//. +by move=> -[//|[//|[|]]]. +by apply: bigsetU_measurable => -[] [//|[//|[|]]]. +by rewrite big_ord_recr/= big_ord_recr/= big_ord0 add0e. +Qed. + +End content_ringOfSetsType. + +Section measureU. +Local Open Scope ereal_scope. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variable mu : {measure set T -> \bar R}. + +Lemma measureUfinr A B : measurable A -> measurable B -> mu B < +oo -> + mu (A `|` B) = mu A + mu B - mu (A `&` B). +Proof. +move=> Am Bm mBfin; rewrite -[B in LHS](setDUK (@subIsetl _ _ A)) setUA. +rewrite [A `|` _]setUidl; last exact: subIsetr. +rewrite measureU//=; [|rewrite setDIr setDv set0U ?setDIK//..]. +- by rewrite measureD// ?setIA ?setIid 1?setIC ?addeA//; exact: measurableI. +- exact: measurableD. +Qed. + +Lemma measureUfinl A B : measurable A -> measurable B -> mu A < +oo -> + mu (A `|` B) = mu A + mu B - mu (A `&` B). +Proof. by move=> *; rewrite setUC measureUfinr// setIC [mu B + _]addeC. Qed. + +Lemma null_set_setU A B : measurable A -> measurable B -> + mu A = 0 -> mu B = 0 -> mu (A `|` B) = 0. +Proof. +move=> mA mB A0 B0; rewrite measureUfinl/= ?A0//= ?B0 ?add0e. +by apply/eqP; rewrite oppe_eq0 -measure_le0/= -A0 measureIl. +Qed. + +Lemma measureU0 A B : measurable A -> measurable B -> mu B = 0 -> + mu (A `|` B) = mu A. +Proof. +move=> mA mB B0; rewrite measureUfinr/= ?B0// adde0. +by rewrite (@subset_measure0 _ _ _ _ (A `&` B) B) ?sube0//; exact: measurableI. +Qed. + +End measureU. + +Lemma eq_measureU d (T : ringOfSetsType d) (R : realFieldType) (A B : set T) + (mu mu' : {measure set T -> \bar R}): + measurable A -> measurable B -> + mu A = mu' A -> mu B = mu' B -> mu (A `&` B) = mu' (A `&` B) -> + mu (A `|` B) = mu' (A `|` B). +Proof. +move=> mA mB muA muB muAB; have [mu'ANoo|] := ltP (mu' A) +oo%E. + by rewrite !measureUfinl/= ?muA ?muB ?muAB. +rewrite leye_eq => /eqP mu'A; transitivity (+oo : \bar R)%E; apply/eqP. + by rewrite -leye_eq -mu'A -muA le_measure ?inE//=; apply: measurableU. +by rewrite eq_sym -leye_eq -mu'A le_measure ?inE//=; apply: measurableU. +Qed. + +Section measure_continuity. +Local Open Scope ereal_scope. + +Lemma nondecreasing_cvg_mu d (T : ringOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) (F : (set T) ^nat) : + (forall i, measurable (F i)) -> measurable (\bigcup_n F n) -> + nondecreasing_seq F -> + mu \o F @ \oo --> mu (\bigcup_n F n). +Proof. +move=> mF mbigcupF ndF. +have Binter : trivIset setT (seqD F) := trivIset_seqD ndF. +have FBE : forall n, F n.+1 = F n `|` seqD F n.+1 := setU_seqD ndF. +have FE n : \big[setU/set0]_(i < n.+1) (seqD F) i = F n := + nondecreasing_bigsetU_seqD n ndF. +rewrite -eq_bigcup_seqD. +have mB i : measurable (seqD F i) by elim: i => * //=; exact: measurableD. +apply: cvg_trans (measure_semi_sigma_additive _ mB Binter _); last first. + by rewrite eq_bigcup_seqD. +apply: (@cvg_trans _ (\sum_(i < n.+1) mu (seqD F i) @[n --> \oo])). + rewrite [X in _ --> X @ \oo](_ : _ = mu \o F) // funeqE => n. + by rewrite -measure_semi_additive ?FE// => -[|]. +move=> S [n _] nS; exists n => // m nm. +under eq_fun do rewrite -(big_mkord predT (mu \o seqD F)). +exact/(nS m.+1)/(leq_trans nm). +Qed. + +Lemma nonincreasing_cvg_mu d (T : algebraOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) (F : (set T) ^nat) : + mu (F 0%N) < +oo -> + (forall i, measurable (F i)) -> measurable (\bigcap_n F n) -> + nonincreasing_seq F -> mu \o F @ \oo --> mu (\bigcap_n F n). +Proof. +move=> F0pos mF mbigcapF niF; pose G n := F O `\` F n. +have ? : mu (F 0%N) \is a fin_num by rewrite ge0_fin_numE. +have F0E r : mu (F 0%N) - (mu (F 0%N) - r) = r. + by rewrite oppeB ?addeA ?subee ?add0e// fin_num_adde_defr. +rewrite -[x in _ --> x] F0E. +have -> : mu \o F = fun n => mu (F 0%N) - (mu (F 0%N) - mu (F n)). + by apply: funext => n; rewrite F0E. +apply: cvgeB; rewrite ?fin_num_adde_defr//; first exact: cvg_cst. +have -> : \bigcap_n F n = F 0%N `&` \bigcap_n F n. + by rewrite setIidr//; exact: bigcap_inf. +rewrite -measureD // setDE setC_bigcap setI_bigcupr -[x in bigcup _ x]/G. +have -> : (fun n => mu (F 0%N) - mu (F n)) = mu \o G. + by apply: funext => n /=; rewrite measureD// setIidr//; exact/subsetPset/niF. +apply: nondecreasing_cvg_mu. +- by move=> ?; apply: measurableD; exact: mF. +- rewrite -setI_bigcupr; apply: measurableI; first exact: mF. + by rewrite -@setC_bigcap; exact: measurableC. +- by move=> n m NM; apply/subsetPset; apply: setDS; apply/subsetPset/niF. +Qed. + +End measure_continuity. + + +Section g_sigma_algebra_measure_unique_trace. +Context d (R : realType) (T : measurableType d). +Variables (G : set (set T)) (D : set T) (mD : measurable D). +Let H := [set X | G X /\ X `<=` D] (* "trace" of G wrt D *). +Hypotheses (Hm : H `<=` measurable) (setIH : setI_closed H). +Variables m1 m2 : {measure set T -> \bar R}. +Hypothesis m1m2D : m1 D = m2 D. +Hypotheses (m1m2 : forall A, H A -> m1 A = m2 A) (m1oo : (m1 D < +oo)%E). + +Lemma g_sigma_algebra_measure_unique_trace : + (forall X, (<>) X -> X `<=` D) -> forall X, <> X -> + m1 X = m2 X. +Proof. +move=> sDHD; set E := [set A | [/\ measurable A, m1 A = m2 A & A `<=` D] ]. +have HE : H `<=` E. + by move=> X HX; rewrite /E /=; split; [exact: Hm|exact: m1m2|case: HX]. +have setDE : setSD_closed E. + move=> A B BA [mA m1m2A AD] [mB m1m2B BD]; split; first exact: measurableD. + - rewrite measureD//; last first. + by rewrite (le_lt_trans _ m1oo)//; apply: le_measure => // /[!inE]. + rewrite setIidr//= m1m2A m1m2B measureD// ?setIidr//. + by rewrite (le_lt_trans _ m1oo)//= -m1m2A; apply: le_measure => // /[!inE]. + - by rewrite setDE; apply: subIset; left. +have ndE : ndseq_closed E. + move=> A ndA EA; split; have mA n : measurable (A n) by have [] := EA n. + - exact: bigcupT_measurable. + - transitivity (limn (m1 \o A)). + apply/esym/cvg_lim=>//. + exact/(nondecreasing_cvg_mu mA _ ndA)/bigcupT_measurable. + transitivity (limn (m2 \o A)). + by apply/congr_lim/funext => n; have [] := EA n. + apply/cvg_lim => //. + exact/(nondecreasing_cvg_mu mA _ ndA)/bigcupT_measurable. + - by apply: bigcup_sub => n; have [] := EA n. +have sDHE : <> `<=` E. + by apply: lambda_system_subset => //; split => //; [move=> ? []|split]. +by move=> X /sDHE[]. +Qed. + +End g_sigma_algebra_measure_unique_trace. +Arguments g_sigma_algebra_measure_unique_trace {d R T} G D. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_measure_unique_trace`")] +Notation g_salgebra_measure_unique_trace := g_sigma_algebra_measure_unique_trace (only parsing). + +Definition lim_sup_set T (F : (set T)^nat) := \bigcap_n \bigcup_(j >= n) F j. + +Section borel_cantelli_realFieldType. +Context {d} {T : measurableType d} {R : realFieldType} + (mu : {measure set T -> \bar R}). +Implicit Types F : (set T)^nat. +Local Open Scope ereal_scope. + +Lemma lim_sup_set_ub F n : (forall k, measurable (F k)) -> + mu (lim_sup_set F) <= mu (\bigcup_(k >= n) F k). +Proof. +move=> mF; rewrite /lim_sup_set le_measure// ?inE/=. +- by apply: bigcap_measurable => // k _; exact: bigcup_measurable. +- exact: bigcup_measurable. +- exact: bigcap_inf. +Qed. + +Lemma lim_sup_set_cvg F : (forall k, measurable (F k)) -> + mu (\bigcup_(k >= 0) F k) < +oo -> + mu (\bigcup_(k >= n) F k) @[n --> \oo] --> mu (lim_sup_set F). +Proof. +move=> mF mFoo; apply: nonincreasing_cvg_mu => //. +- by move=> i; apply: bigcup_measurable => k /= _; exact: mF. +- apply: bigcap_measurable => // k _. + by apply: bigcup_measurable => j /= _; exact: mF. +- move=> m n mn; apply/subsetPset => t [k /= nk Akt]. + by exists k => //=; rewrite (leq_trans mn). +Qed. + +End borel_cantelli_realFieldType. +Arguments lim_sup_set_cvg {d T R} mu F. + +Section borel_cantelli. +Context d (T : measurableType d) {R : realType} (mu : {measure set T -> \bar R}). +Implicit Types F : (set T)^nat. +Local Open Scope ereal_scope. + +Lemma lim_sup_set_cvg0 F : (forall k, measurable (F k)) -> + \sum_(n mu (lim_sup_set F) = 0. +Proof. +move=> mF bigUoo; apply/eqP; rewrite eq_le measure_ge0 andbT. +have /cvg_lim <- // : (\sum_(i <= n \oo] --> 0%E. + exact: nneseries_tail_cvg. +apply: lime_ge; first by apply/cvg_ex; exists 0; exact: nneseries_tail_cvg. +apply: nearW => n; rewrite (le_trans (lim_sup_set_ub mu n mF))//. +by apply: measure_sigma_subadditive_tail => //; + [exact: bigcup_measurable|rewrite -setC_I]. +Qed. + +End borel_cantelli. + +Section boole_inequality. +Context d (R : realFieldType) (T : ringOfSetsType d). +Variable mu : {content set T -> \bar R}. + +Theorem Boole_inequality (A : (set T) ^nat) n : + (forall i, (i < n)%N -> measurable (A i)) -> + (mu (\big[setU/set0]_(i < n) A i) <= \sum_(i < n) mu (A i))%E. +Proof. +move=> Am; rewrite content_subadditive// -bigcup_mkord. +exact: fin_bigcup_measurable. +Qed. + +End boole_inequality. +Notation le_mu_bigsetU := Boole_inequality. + +Section sigma_finite_lemma. +Context d (T : ringOfSetsType d) (R : realFieldType) (A : set T) + (mu : {content set T -> \bar R}). + +Lemma sigma_finiteP : sigma_finite A mu <-> + exists F, [/\ A = \bigcup_i F i, + nondecreasing_seq F & forall i, measurable (F i) /\ mu (F i) < +oo]%E. +Proof. +split=> [[F AUF mF]|[F [? ? ?]]]; last by exists F. +exists (fun n => \big[setU/set0]_(i < n.+1) F i); split. +- rewrite AUF; apply/seteqP; split. + by apply: subset_bigcup => i _; exact: bigsetU_sup. + by apply: bigcup_sub => i _; exact: bigsetU_bigcup. +- by move=> i j ij; exact/subsetPset/subset_bigsetU. +- move=> i; split; first by apply: bigsetU_measurable => j _; exact: (mF j).1. + rewrite (le_lt_trans (Boole_inequality _ _))//. + by move=> j _; exact: (mF _).1. + by apply/lte_sum_pinfty => j _; exact: (mF j).2. +Qed. + +End sigma_finite_lemma. + +Section generalized_boole_inequality. +Context d (T : ringOfSetsType d) (R : realType). +Variable mu : {measure set T -> \bar R}. + +Theorem generalized_Boole_inequality (A : (set T) ^nat) : + (forall i, measurable (A i)) -> measurable (\bigcup_n A n) -> + (mu (\bigcup_n A n) <= \sum_(i Am UAm; rewrite measure_sigma_subadditive. Qed. + +End generalized_boole_inequality. +Notation le_mu_bigcup := generalized_Boole_inequality. + +Section g_sigma_algebra_measure_unique. +Context d (R : realType) (T : measurableType d). +Variable G : set (set T). +Hypothesis Gm : G `<=` measurable. +Variable g : (set T)^nat. +Hypotheses Gg : forall i, G (g i). +Hypothesis g_cover : \bigcup_k (g k) = setT. +Variables m1 m2 : {measure set T -> \bar R}. + +Lemma g_sigma_algebra_measure_unique_cover : + (forall n A, <> A -> m1 (g n `&` A) = m2 (g n `&` A)) -> + forall A, <> A -> m1 A = m2 A. +Proof. +pose GT : ringOfSetsType G.-sigma:= g_sigma_algebraType G. +move=> sGm1m2; pose g' k := \bigcup_(i < k) g i. +have sGm := smallest_sub (@sigma_algebra_measurable _ T) Gm. +have Gg' i : <> (g' i). + apply: (@fin_bigcup_measurable _ GT) => //. + by move=> n _; apply: sub_sigma_algebra. +have sG'm1m2 n A : <> A -> m1 (g' n `&` A) = m2 (g' n `&` A). + move=> sGA; rewrite setI_bigcupl bigcup_mkord. + elim: n => [|n IHn] in A sGA *; rewrite (big_ord0, big_ord_recr) ?measure0//=. + have sGgA i : <> (g i `&` A). + by apply: (@measurableI _ GT) => //; exact: sub_sigma_algebra. + apply: eq_measureU; rewrite ?sGm1m2 ?IHn//; last first. + - by rewrite -big_distrl -setIA big_distrl/= IHn// setICA setIid. + - exact/sGm. + - by apply: bigsetU_measurable => i _; apply/sGm. +have g'_cover : \bigcup_k (g' k) = setT. + by rewrite -subTset -g_cover => x [k _ gx]; exists k.+1 => //; exists k => /=. +have nd_g' : nondecreasing_seq g'. + move=> m n lemn; rewrite subsetEset => x [k km gx]; exists k => //=. + exact: leq_trans lemn. +move=> A gA. +have -> : A = \bigcup_n (g' n `&` A) by rewrite -setI_bigcupl g'_cover setTI. +transitivity (lim (m1 (g' n `&` A) @[n --> \oo])). + apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. + - by move=> n; apply: measurableI; exact/sGm. + - by apply: bigcupT_measurable => k; apply: measurableI; exact/sGm. + - by move=> ? ? ?; apply/subsetPset; apply: setSI; exact/subsetPset/nd_g'. +transitivity (lim (m2 (g' n `&` A) @[n --> \oo])). + by apply/congr_lim/funext => x; apply: sG'm1m2 => //; exact/sGm. +apply/cvg_lim => //; apply: nondecreasing_cvg_mu. +- by move=> k; apply: measurableI => //; exact/sGm. +- by apply: bigcupT_measurable => k; apply: measurableI; exact/sGm. +- by move=> a b ab; apply/subsetPset; apply: setSI; exact/subsetPset/nd_g'. +Qed. + +Hypothesis setIG : setI_closed G. +Hypothesis m1m2 : forall A, G A -> m1 A = m2 A. +Hypothesis m1goo : forall k, (m1 (g k) < +oo)%E. + +Lemma g_sigma_algebra_measure_unique : forall E, <> E -> m1 E = m2 E. +Proof. +pose G_ n := [set X | G X /\ X `<=` g n]. (* "trace" *) +have G_E n : G_ n = [set g n `&` C | C in G]. + rewrite eqEsubset; split. + by move=> X [GX Xgn] /=; exists X => //; rewrite setIidr. + by rewrite /G_ => X [Y GY <-{X}]; split; [exact: setIG|apply: subIset; left]. +have gIsGE n : [set g n `&` A | A in <>] = + <>. + rewrite g_sigma_preimageE eqEsubset; split. + by move=> _ /= [Y sGY <-]; exists Y => //; rewrite preimage_id setIC. + by move=> _ [Y mY <-] /=; exists Y => //; rewrite preimage_id setIC. +have preimg_gGE n : preimage_set_system (g n) id G = G_ n. + rewrite eqEsubset; split => [_ [Y GY <-]|]. + by rewrite preimage_id G_E /=; exists Y => //; rewrite setIC. + by move=> X [GX Xgn]; exists X => //; rewrite preimage_id setIidr. +apply: g_sigma_algebra_measure_unique_cover => //. +move=> n A sGA; apply: (g_sigma_algebra_measure_unique_trace G (g n)) => //. +- exact: Gm. +- by move=> ? [? _]; exact/Gm. +- by move=> ? ? [? ?] [? ?]; split; [exact: setIG|apply: subIset; tauto]. +- exact: m1m2. +- by move=> ? [? ?]; exact: m1m2. +- move=> X; rewrite -/(G_ n) -preimg_gGE -gIsGE. + by case=> B sGB <-{X}; apply: subIset; left. +- by rewrite -/(G_ n) -preimg_gGE -gIsGE; exists A. +Qed. + +End g_sigma_algebra_measure_unique. +Arguments g_sigma_algebra_measure_unique {d R T} G. +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_measure_unique_cover`")] +Notation g_salgebra_measure_unique_cover := g_sigma_algebra_measure_unique_cover (only parsing). +#[deprecated(since="mathcomp-analysis 1.2.0", note="renamed `g_sigma_algebra_measure_unique`")] +Notation g_salgebra_measure_unique := g_sigma_algebra_measure_unique (only parsing). + +Section measure_unique. +Context d (R : realType) (T : measurableType d). +Variables (G : set (set T)) (g : (set T)^nat). +Hypotheses (mG : measurable = <>) (setIG : setI_closed G). +Hypothesis Gg : forall i, G (g i). +Hypothesis g_cover : \bigcup_k (g k) = setT. +Variables m1 m2 : {measure set T -> \bar R}. +Hypothesis m1m2 : forall A, G A -> m1 A = m2 A. +Hypothesis m1goo : forall k, (m1 (g k) < +oo)%E. + +Lemma measure_unique A : measurable A -> m1 A = m2 A. +Proof. +move=> mA; apply: (g_sigma_algebra_measure_unique G); rewrite -?mG//. +by rewrite mG; exact: sub_sigma_algebra. +Qed. + +End measure_unique. +Arguments measure_unique {d R T} G g. diff --git a/theories/measure_theory/measure_negligible.v b/theories/measure_theory/measure_negligible.v new file mode 100644 index 0000000000..1ed8f2274f --- /dev/null +++ b/theories/measure_theory/measure_negligible.v @@ -0,0 +1,336 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure measure_function. + +(**md**************************************************************************) +(* # Negligibility *) +(* *) +(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) +(* *) +(* ``` *) +(* mu.-negligible A == A is mu negligible *) +(* measure_is_complete mu == the measure mu is complete *) +(* {ae mu, P} == P holds almost everywhere for the measure mu, *) +(* declared as an instance of the type of *) +(* filters *) +(* P must be of the form forall x, Q x. *) +(* Prefer this notation when P is an existing *) +(* statement (i.e., a definition) that needs to *) +(* be relativised. *) +(* The notation used the definition *) +(* `almost_everywhere`. *) +(* \forall x \ae mu, P x == equivalent to {ae mu, forall x, P x} *) +(* Prefer this notation when the statement *) +(* forall x, P x does not stand alone. *) +(* f = g %[ae mu in D ] == f is equal to g almost everywhere in D *) +(* f = g %[ae mu] == f is equal to g almost everywhere *) +(* ``` *) +(* *) +(******************************************************************************) + +Reserved Notation "mu .-negligible" (format "mu .-negligible"). +Reserved Notation "{ 'ae' m , P }" (format "{ 'ae' m , P }"). +Reserved Notation "\forall x \ae mu , P" + (at level 200, x name, P at level 200, format "\forall x \ae mu , P"). +Reserved Notation "f = g %[ae mu 'in' D ]" + (at level 70, g at next level, format "f = g '%[ae' mu 'in' D ]"). +Reserved Notation "f = g %[ae mu ]" + (at level 70, g at next level, format "f = g '%[ae' mu ]"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Section negligible. +Context d (T : semiRingOfSetsType d) (R : realFieldType). + +Definition negligible (mu : set T -> \bar R) N := + exists A, [/\ measurable A, mu A = 0 & N `<=` A]. + +Local Notation "mu .-negligible" := (negligible mu). + +Variable mu : {content set T -> \bar R}. + +Lemma negligibleP A : measurable A -> mu.-negligible A <-> mu A = 0. +Proof. +move=> mA; split => [[B [mB mB0 AB]]|mA0]; last by exists A; split. +by apply/eqP; rewrite -measure_le0 -mB0 le_measure ?inE. +Qed. + +Lemma negligible_set0 : mu.-negligible set0. +Proof. exact/negligibleP. Qed. + +Lemma measure_negligible (A : set T) : + measurable A -> mu.-negligible A -> mu A = 0%E. +Proof. by move=> mA /negligibleP ->. Qed. + +Lemma negligibleS A B : B `<=` A -> mu.-negligible A -> mu.-negligible B. +Proof. +by move=> BA [N [mN N0 AN]]; exists N; split => //; exact: subset_trans AN. +Qed. + +Lemma negligibleI A B : + mu.-negligible A -> mu.-negligible B -> mu.-negligible (A `&` B). +Proof. +move=> [N [mN N0 AN]] [M [mM M0 BM]]; exists (N `&` M); split => //. +- exact: measurableI. +- by apply/eqP; rewrite -measure_le0 -N0 le_measure ?inE//; exact: measurableI. +- exact: setISS. +Qed. + +End negligible. +Notation "mu .-negligible" := (negligible mu) : type_scope. + +Definition measure_is_complete d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) := + mu.-negligible `<=` measurable. + +Section negligible_ringOfSetsType. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variable mu : {content set T -> \bar R}. + +Lemma negligibleU A B : + mu.-negligible A -> mu.-negligible B -> mu.-negligible (A `|` B). +Proof. +move=> [N [mN N0 AN]] [M [mM M0 BM]]; exists (N `|` M); split => //. +- exact: measurableU. +- apply/eqP; rewrite -measure_le0 -N0 -[leRHS]adde0 -M0 -bigsetU_bigcup2. + apply: le_trans. + + apply: (@content_subadditive _ _ _ _ _ (bigcup2 N M) 2%N) => //. + * by move=> [|[|[|]]]. + * apply: bigsetU_measurable => // i _; rewrite /bigcup2. + by case: ifPn => // i0; case: ifPn. + + by rewrite big_ord_recr/= big_ord_recr/= big_ord0 add0e. +- exact: setUSS. +Qed. + +Lemma negligible_bigsetU (F : (set T)^nat) s (P : pred nat) : + (forall k, P k -> mu.-negligible (F k)) -> + mu.-negligible (\big[setU/set0]_(k <- s | P k) F k). +Proof. +by move=> PF; elim/big_ind : _ => //; + [exact: negligible_set0|exact: negligibleU]. +Qed. + +End negligible_ringOfSetsType. + +Lemma negligible_bigcup d (T : sigmaRingType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) (F : (set T)^nat) : + (forall k, mu.-negligible (F k)) -> mu.-negligible (\bigcup_k F k). +Proof. +move=> mF; exists (\bigcup_k sval (cid (mF k))); split. +- by apply: bigcupT_measurable => // k; have [] := svalP (cid (mF k)). +- rewrite seqDU_bigcup_eq measure_bigcup//; last first. + move=> k _; apply: measurableD; first by case: cid => //= A []. + by apply: bigsetU_measurable => i _; case: cid => //= A []. + rewrite eseries0// => k _ _. + have [mFk mFk0 ?] := svalP (cid (mF k)). + rewrite measureD//=. + + rewrite mFk0 sub0e eqe_oppLRP oppe0; apply/eqP; rewrite -measure_le0. + rewrite -[leRHS]mFk0 le_measure//= ?inE//; apply: measurableI => //. + by apply: bigsetU_measurable => i _; case: cid => // A []. + + by apply: bigsetU_measurable => i _; case: cid => // A []. + + by rewrite mFk0. +- by apply: subset_bigcup => k _; rewrite /sval/=; by case: cid => //= A []. +Qed. + +Section ae. + +Definition almost_everywhere d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) : set_system T := + fun P => mu.-negligible (~` [set x | P x]). + +Let almost_everywhereT d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : {content set T -> \bar R}) : almost_everywhere mu setT. +Proof. by rewrite /almost_everywhere setCT; exact: negligible_set0. Qed. + +Let almost_everywhereS d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) A B : A `<=` B -> + almost_everywhere mu A -> almost_everywhere mu B. +Proof. by move=> AB; apply: negligibleS; exact: subsetC. Qed. + +Let almost_everywhereI d (T : ringOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) A B : + almost_everywhere mu A -> almost_everywhere mu B -> + almost_everywhere mu (A `&` B). +Proof. +by rewrite /almost_everywhere => mA mB; rewrite setCI; exact: negligibleU. +Qed. + +Definition ae_filter_ringOfSetsType d {T : ringOfSetsType d} (R : realFieldType) + (mu : {measure set T -> \bar R}) : Filter (almost_everywhere mu). +Proof. +by split; [exact: almost_everywhereT|exact: almost_everywhereI| + exact: almost_everywhereS]. +Qed. + +Definition ae_properfilter_algebraOfSetsType d {T : algebraOfSetsType d} + (R : realFieldType) (mu : {measure set T -> \bar R}) : + (mu [set: T] > 0)%E -> ProperFilter (almost_everywhere mu). +Proof. +move=> muT; split=> [|]; last exact: ae_filter_ringOfSetsType. +rewrite /almost_everywhere setC0 => /(measure_negligible measurableT). +by move/eqP; rewrite -measure_le0 leNgt => /negP. +Qed. + +End ae. + +#[global] Hint Extern 0 (Filter (almost_everywhere _)) => + (apply: ae_filter_ringOfSetsType) : typeclass_instances. +#[global] Hint Extern 0 (Filter (nbhs (almost_everywhere _))) => + (apply: ae_filter_ringOfSetsType) : typeclass_instances. + +#[global] Hint Extern 0 (ProperFilter (almost_everywhere _)) => + (apply: ae_properfilter_algebraOfSetsType) : typeclass_instances. +#[global] Hint Extern 0 (ProperFilter (nbhs (almost_everywhere _))) => + (apply: ae_properfilter_algebraOfSetsType) : typeclass_instances. + +Notation "{ 'ae' m , P }" := {near almost_everywhere m, P} : type_scope. +Notation "\forall x \ae mu , P" := (\forall x \near almost_everywhere mu, P) + : type_scope. +Definition ae_eq d (T : semiRingOfSetsType d) (R : realType) + (mu : {measure set T -> \bar R}) (V : T -> Type) D (f g : forall x, V x) := + \forall x \ae mu, D x -> f x = g x. +Notation "f = g %[ae mu 'in' D ]" := (\forall x \ae mu, D x -> f x = g x). +Notation "f = g %[ae mu ]" := (f = g %[ae mu in setT ]). + +Lemma measure0_ae d {T : algebraOfSetsType d} {R : realType} + (mu : {measure set T -> \bar R}) (P : set T) : + mu [set: T] = 0 -> \forall x \ae mu, P x. +Proof. by move=> x; exists setT. Qed. + +Lemma aeW {d} {T : semiRingOfSetsType d} {R : realFieldType} + (mu : {measure set _ -> \bar R}) (P : T -> Prop) : + (forall x, P x) -> \forall x \ae mu, P x. +Proof. +move=> aP; have -> : P = setT by rewrite predeqE => t; split. +by apply/negligibleP; [rewrite setCT|rewrite setCT measure0]. +Qed. + +Instance ae_eq_equiv d (T : ringOfSetsType d) R mu V D : + RelationClasses.Equivalence (@ae_eq d T R mu V D). +Proof. +split. +- by move=> f; near=> x. +- by move=> f g eqfg; near=> x => Dx; rewrite (near eqfg). +- by move=> f g h eqfg eqgh; near=> x => Dx; rewrite (near eqfg) ?(near eqgh). +Unshelve. all: by end_near. Qed. + +Section ae_eq. +Local Open Scope ring_scope. +Context d (T : sigmaRingType d) (R : realType). +Implicit Types (U V : Type) (W : ringType). +Variables (mu : {measure set T -> \bar R}) (D : set T). +Local Notation ae_eq := (ae_eq mu D). + +Lemma ae_eq0 U (f g : T -> U) : measurable D -> mu D = 0 -> f = g %[ae mu in D]. +Proof. by move=> mD D0; exists D; split => // t/= /not_implyP[]. Qed. + +Instance comp_ae_eq U V (j : T -> U -> V) : + Proper (ae_eq ==> ae_eq) (fun f x => j x (f x)). +Proof. by move=> f g; apply: filterS => x /[apply] /= ->. Qed. + +Instance comp_ae_eq2 U U' V (j : T -> U -> U' -> V) : + Proper (ae_eq ==> ae_eq ==> ae_eq) (fun f g x => j x (f x) (g x)). +Proof. by move=> f f' + g g'; apply: filterS2 => x + + Dx => -> // ->. Qed. + +Instance comp_ae_eq2' U U' V (j : U -> U' -> V) : + Proper (ae_eq ==> ae_eq ==> ae_eq) (fun f g x => j (f x) (g x)). +Proof. by move=> f f' + g g'; apply: filterS2 => x + + Dx => -> // ->. Qed. + +Instance sub_ae_eq2 : Proper (ae_eq ==> ae_eq ==> ae_eq) (@GRing.sub_fun T R). +Proof. exact: (@comp_ae_eq2' _ _ R (fun x y => x - y)). Qed. + +Lemma ae_eq_refl U (f : T -> U) : ae_eq f f. Proof. exact/aeW. Qed. +Hint Resolve ae_eq_refl : core. + +Lemma ae_eq_comp U V (j : U -> V) f g : ae_eq f g -> ae_eq (j \o f) (j \o g). +Proof. by move->. Qed. + +Lemma ae_eq_comp2 U V (j : T -> U -> V) f g : + ae_eq f g -> ae_eq (fun x => j x (f x)) (fun x => j x (g x)). +Proof. by apply: filterS => x /[swap] + ->. Qed. + +Local Open Scope ereal_scope. +Lemma ae_eq_funeposneg (f g : T -> \bar R) : + ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-. +Proof. +split=> [fg|[pfg nfg]]. + by split; near=> x => Dx; rewrite !(funeposE,funenegE) (near fg). +by near=> x => Dx; rewrite (funeposneg f) (funeposneg g) ?(near pfg, near nfg). +Unshelve. all: by end_near. Qed. +Local Close Scope ereal_scope. + +Lemma ae_eq_sym U (f g : T -> U) : ae_eq f g -> ae_eq g f. +Proof. by symmetry. Qed. + +Lemma ae_eq_trans U (f g h : T -> U) : ae_eq f g -> ae_eq g h -> ae_eq f h. +Proof. by apply transitivity. Qed. + +Lemma ae_eq_sub W (f g h i : T -> W) : ae_eq f g -> ae_eq h i -> ae_eq (f \- h) (g \- i). +Proof. by apply: filterS2 => x + + Dx => /= /(_ Dx) -> /(_ Dx) ->. Qed. + +Lemma ae_eq_mul2r W (f g h : T -> W) : ae_eq f g -> ae_eq (f \* h) (g \* h). +Proof. by move=>/(ae_eq_comp2 (fun x y => y * h x)). Qed. + +Lemma ae_eq_mul2l W (f g h : T -> W) : ae_eq f g -> ae_eq (h \* f) (h \* g). +Proof. by move=>/(ae_eq_comp2 (fun x y => h x * y)). Qed. + +Lemma ae_eq_mul1l W (f g : T -> W) : ae_eq f (cst 1) -> ae_eq g (g \* f). +Proof. by apply: filterS => x /= /[apply] ->; rewrite mulr1. Qed. + +Lemma ae_eq_abse (f g : T -> \bar R) : ae_eq f g -> ae_eq (abse \o f) (abse \o g). +Proof. by apply: filterS => x /[apply] /= ->. Qed. + +Lemma ae_foralln (P : nat -> T -> Prop) : + (forall n, \forall x \ae mu, P n x) -> \forall x \ae mu, forall n, P n x. +Proof. +move=> /(_ _)/cid - /all_sig[A /all_and3[Ameas muA0 NPA]]. +have seqDUAmeas := seqDU_measurable Ameas. +exists (\bigcup_n A n); split => //. +- exact/bigcup_measurable. +- rewrite seqDU_bigcup_eq measure_bigcup// eseries0// => i _ _. + by rewrite (@subset_measure0 _ _ _ _ _ (A i))//=; apply: subset_seqDU. +- by move=> x /=; rewrite -existsNP => -[n NPnx]; exists n => //; apply: NPA. +Qed. + +End ae_eq. + +Section ae_eq_lemmas. +Context d (T : sigmaRingType d) (R : realType) (U : Type). +Implicit Types (mu : {measure set T -> \bar R}) (A : set T) (f g : T -> U). + +Lemma ae_eq_subset mu A B f g : B `<=` A -> ae_eq mu A f g -> ae_eq mu B f g. +Proof. by move=> BA; apply: filterS => x + /BA; apply. Qed. + +End ae_eq_lemmas. + +Section ae_eqe. +Context d (T : sigmaRingType d) (R : realType). +Local Open Scope ereal_scope. +Implicit Types (mu : {measure set T -> \bar R}) (D : set T) (f g h : T -> \bar R). + +Lemma ae_eqe_mul2l mu D f g h : ae_eq mu D f g -> ae_eq mu D (h \* f)%E (h \* g). +Proof. by apply: filterS => x /= /[apply] ->. Qed. + +End ae_eqe. + +Section absolute_continuity_lemmas. +Context d (T : measurableType d) (R : realType) (U : Type). +Implicit Types (m : {measure set T -> \bar R}) (f g : T -> U). + +Lemma measure_dominates_ae_eq m1 m2 f g E : measurable E -> + m2 `<< m1 -> ae_eq m1 E f g -> ae_eq m2 E f g. +Proof. by move=> mE m21 [A [mA A0 ?]]; exists A; split => //; exact: m21. Qed. + +End absolute_continuity_lemmas. diff --git a/theories/measure_theory/probability_measure.v b/theories/measure_theory/probability_measure.v new file mode 100644 index 0000000000..8ce1d7bdee --- /dev/null +++ b/theories/measure_theory/probability_measure.v @@ -0,0 +1,212 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import functions cardinality fsbigop reals. +From mathcomp Require Import interval_inference ereal topology normedtype. +From mathcomp Require Import sequences esum numfun. +From mathcomp Require Import measurable_structure measure_function dirac_measure. + +(**md**************************************************************************) +(* # Probability Measures *) +(* *) +(* ``` *) +(* isSubProbability == interface for functions that satisfy the *) +(* property of subprobability *) +(* The HB class is SubProbability. *) +(* subprobability T R == subprobability measure over the *) +(* measurableType T with values in \bar R with *) +(* R : realType *) +(* The HB class is SubProbability. *) +(* Measure_isSubProbability == interface that extends measures to *) +(* subprobability measures *) +(* isProbability == interface for functions that satisfy the *) +(* property of probability measures *) +(* The HB class is Probability. *) +(* probability T R == type of probability measure over the *) +(* measurableType T with values in \bar R *) +(* with R : realType *) +(* Measure_isProbability == interface that extends measures to *) +(* probability measures *) +(* mnormalize mu == normalization of a measure to a probability *) +(* ``` *) +(* *) +(* ``` *) +(* mset U r == the set of probability measures mu such that *) +(* mu U < r *) +(* pset == the sets mset U r with U measurable and *) +(* r \in [0,1] *) +(* pprobability == the measurable type generated by pset *) +(* ``` *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import ProperNotations. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +HB.mixin Record isSubProbability d (T : sigmaRingType d) (R : realType) + (P : set T -> \bar R) := { sprobability_setT : (P setT <= 1)%E }. + +#[short(type=subprobability)] +HB.structure Definition SubProbability d (T : measurableType d) (R : realType) + := {mu of @FiniteMeasure d T R mu & isSubProbability d T R mu }. + +HB.factory Record Measure_isSubProbability d (T : measurableType d) + (R : realType) (P : set T -> \bar R) of isMeasure _ _ _ P := + { sprobability_setT : (P setT <= 1)%E }. + +HB.builders Context d (T : measurableType d) (R : realType) + P of Measure_isSubProbability d T R P. + +Let finite : @Measure_isFinite d T R P. +Proof. +split; apply: lty_fin_num_fun. +by rewrite (le_lt_trans (@sprobability_setT))// ltey. +Qed. + +HB.instance Definition _ := finite. + +HB.instance Definition _ := @isSubProbability.Build _ _ _ P sprobability_setT. + +HB.end. + +HB.mixin Record isProbability d (T : measurableType d) (R : realType) + (P : set T -> \bar R) := { probability_setT : P setT = 1%E }. + +#[short(type=probability)] +HB.structure Definition Probability d (T : measurableType d) (R : realType) := + {P of @SubProbability d T R P & isProbability d T R P }. + +Arguments probability_setT {d T R} s. + +HB.instance Definition _ d (T : measurableType d) (R : realType) := + gen_eqMixin (probability T R). +HB.instance Definition _ d (T : measurableType d) (R : realType) := + gen_choiceMixin (probability T R). + +Section probability_lemmas. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma probability_le1 (A : set T) : measurable A -> P A <= 1. +Proof. by move=> mA; rewrite -(probability_setT P) ?le_measure ?in_setE. Qed. + +Lemma probability_setC (A : set T) : measurable A -> P (~` A) = 1 - P A. +Proof. +move=> mA; rewrite -(probability_setT P) -(setvU A) measureU ?addeK ?setICl//. +- by rewrite fin_num_measure. +- exact: measurableC. +Qed. + +End probability_lemmas. + +HB.factory Record Measure_isProbability d (T : measurableType d) + (R : realType) (P : set T -> \bar R) of isMeasure _ _ _ P := + { probability_setT : P setT = 1%E }. + +HB.builders Context d (T : measurableType d) (R : realType) + P of Measure_isProbability d T R P. + +Let subprobability : @Measure_isSubProbability d T R P. +Proof. by split; rewrite probability_setT. Qed. + +HB.instance Definition _ := subprobability. + +HB.instance Definition _ := @isProbability.Build _ _ _ P probability_setT. + +HB.end. + +Section pdirac. +Context d (T : measurableType d) (R : realType). + +HB.instance Definition _ x := + Measure_isProbability.Build _ _ _ (@dirac _ T x R) (diracT R x). + +End pdirac. + +Section mnormalize. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (P : probability T R). + +Definition mnormalize := + let evidence := mu [set: T] in + if (evidence == 0) || (evidence == +oo) then fun U => P U + else fun U => mu U * (fine evidence)^-1%:E. + +Let mnormalize0 : mnormalize set0 = 0. +Proof. +by rewrite /mnormalize; case: ifPn => // _; rewrite measure0 mul0e. +Qed. + +Let mnormalize_ge0 U : 0 <= mnormalize U. +Proof. by rewrite /mnormalize; case: ifPn. Qed. + +Let mnormalize_sigma_additive : semi_sigma_additive mnormalize. +Proof. +move=> F mF tF mUF; rewrite /mnormalize/=. +case: ifPn => [_|_]; first exact: measure_semi_sigma_additive. +rewrite [X in X @ _ --> _](_ : _ = (fun n => \sum_(0 <= i < n) mu (F i)) \* + cst (fine (mu setT))^-1%:E); last first. + by apply/funext => n; rewrite -ge0_sume_distrl. +by apply: cvgeZr => //; exact: measure_semi_sigma_additive. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ mnormalize + mnormalize0 mnormalize_ge0 mnormalize_sigma_additive. + +Let mnormalize1 : mnormalize [set: T] = 1. +Proof. +rewrite /mnormalize; case: ifPn; first by rewrite probability_setT. +rewrite negb_or => /andP[ft0 ftoo]. +have ? : mu setT \is a fin_num by rewrite ge0_fin_numE// ltey. +by rewrite -{1}(@fineK _ (mu setT))// -EFinM divff// fine_eq0. +Qed. + +HB.instance Definition _ := + Measure_isProbability.Build _ _ _ mnormalize mnormalize1. + +End mnormalize. + +Lemma mnormalize_id d (T : measurableType d) (R : realType) + (P P' : probability T R) : mnormalize P P' = P. +Proof. +apply/funext => x; rewrite /mnormalize/= probability_setT. +by rewrite onee_eq0/= invr1 mule1. +Qed. + + +HB.instance Definition _ d (T : measurableType d) (R : realType) := + isPointed.Build (probability T R) (dirac point). + +Section dist_sigma_algebra_instance. +Context d (T : measurableType d) (R : realType). + +Definition mset (U : set T) (r : R) := + [set mu : probability T R | mu U < r%:E]%E. + +Lemma lt0_mset (U : set T) (r : R) : (r < 0)%R -> mset U r = set0. +Proof. +move=> r0; apply/seteqP; split => // x/=. +by apply/negP; rewrite -leNgt (@le_trans _ _ 0%E)// lee_fin ltW. +Qed. + +Lemma gt1_mset (U : set T) (r : R) : + measurable U -> (1 < r)%R -> mset U r = [set: probability T R]. +Proof. +move=> mU r1; apply/seteqP; split => // x/= _. +by rewrite /mset/= (le_lt_trans (probability_le1 _ _)). +Qed. + +Definition pset : set (set (probability T R)) := + [set mset U r | r in `[0%R,1%R] & U in measurable]. + +Definition pprobability : measurableType pset.-sigma := + g_sigma_algebraType pset. + +End dist_sigma_algebra_instance. diff --git a/theories/normedtype_theory/normed_module.v b/theories/normedtype_theory/normed_module.v index 6af95b7d03..65de09594c 100644 --- a/theories/normedtype_theory/normed_module.v +++ b/theories/normedtype_theory/normed_module.v @@ -180,7 +180,7 @@ HB.instance Definition _ := NormedModule.copy R R^o. End rcfType. Section archiFieldType. -Variable (R : archiFieldType). +Variable (R : archiRealFieldType). #[export, non_forgetful_inheritance] HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. #[export, non_forgetful_inheritance] @@ -1023,7 +1023,7 @@ Qed. End max_cts. -Lemma limit_pointP (T : archiFieldType) (A : set T) (x : T) : +Lemma limit_pointP (T : archiRealFieldType) (A : set T) (x : T) : limit_point A x <-> exists a_ : nat -> T, [/\ a_ @` setT `<=` A, forall n, a_ n != x & a_ @ \oo --> x]. Proof. diff --git a/theories/normedtype_theory/num_normedtype.v b/theories/normedtype_theory/num_normedtype.v index 8534097e98..91a7b37b92 100644 --- a/theories/normedtype_theory/num_normedtype.v +++ b/theories/normedtype_theory/num_normedtype.v @@ -716,7 +716,7 @@ End near_in_itv. note="use `near_in_itvoo` instead")] Notation near_in_itv := near_in_itvoo (only parsing). -Lemma nbhs_infty_gtr {R : archiFieldType} (r : R) : +Lemma nbhs_infty_gtr {R : archiRealFieldType} (r : R) : \forall n \near \oo, r < n%:R. Proof. exists `|ceil r|.+1 => // n/=; rewrite -(ler_nat R); apply: lt_le_trans. @@ -724,7 +724,7 @@ rewrite -natr1 -[ltLHS]addr0 ler_ltD//. by rewrite (le_trans (ceil_ge _))// natr_absz ler_int ler_norm. Qed. -Lemma near_infty_natSinv_lt (R : archiFieldType) (e : {posnum R}) : +Lemma near_infty_natSinv_lt (R : archiRealFieldType) (e : {posnum R}) : \forall n \near \oo, n.+1%:R^-1 < e%:num. Proof. near=> n; rewrite -(@ltr_pM2r _ n.+1%:R) // mulVf. @@ -733,7 +733,7 @@ rewrite (lt_trans (archi_boundP _)) // ltr_nat. by near: n; exists (Num.bound e%:num^-1). Unshelve. all: by end_near. Qed. -Lemma near_infty_natSinv_expn_lt (R : archiFieldType) (e : {posnum R}) : +Lemma near_infty_natSinv_expn_lt (R : archiRealFieldType) (e : {posnum R}) : \forall n \near \oo, 1 / 2 ^+ n < e%:num. Proof. near=> n. diff --git a/theories/realfun.v b/theories/realfun.v index 68502a78d2..0e4f65bbc4 100644 --- a/theories/realfun.v +++ b/theories/realfun.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum archimedean. From mathcomp Require Import matrix interval zmodp vector fieldext falgebra. diff --git a/theories/sequences.v b/theories/sequences.v index dc29b0589c..2d751c6a61 100644 --- a/theories/sequences.v +++ b/theories/sequences.v @@ -707,7 +707,7 @@ Proof. by rewrite /=. Qed. Lemma harmonic_ge0 {R : numFieldType} i : 0 <= harmonic i :> R. Proof. exact/ltW/harmonic_gt0. Qed. -Lemma cvg_harmonic {R : archiFieldType} : @harmonic R @ \oo --> 0. +Lemma cvg_harmonic {R : archiRealFieldType} : @harmonic R @ \oo --> 0. Proof. apply/cvgrPdist_le => _/posnumP[e]; near=> i. rewrite distrC subr0 ger0_norm//= -lef_pV2 ?qualifE//= invrK. @@ -715,7 +715,8 @@ rewrite (le_trans (ltW (archi_boundP _)))// ler_nat -add1n -leq_subLR. by near: i; apply: nbhs_infty_ge. Unshelve. all: by end_near. Qed. -Lemma cvge_harmonic {R : archiFieldType} : (EFin \o @harmonic R) @ \oo --> 0%E. +Lemma cvge_harmonic {R : archiRealFieldType} : + (EFin \o @harmonic R) @ \oo --> 0%E. Proof. by apply: cvg_EFin; [exact: nearW | exact: cvg_harmonic]. Qed. Lemma dvg_harmonic (R : numFieldType) : ~ cvgn (series (@harmonic R)). @@ -749,7 +750,7 @@ Definition root_mean_square (R : realType) (u_ : R ^nat) : R ^nat := [sequence Num.sqrt (n.+1%:R^-1 * series v_ n.+1)]_n. Section cesaro. -Variable R : archiFieldType. +Variable R : archiRealFieldType. Theorem cesaro (u_ : R ^nat) (l : R) : u_ @ \oo --> l -> arithmetic_mean u_ @ \oo --> l. @@ -783,7 +784,7 @@ Unshelve. all: by end_near. Qed. End cesaro. Section cesaro_converse. -Variable R : archiFieldType. +Variable R : archiRealFieldType. Let cesaro_converse_off_by_one (u_ : R ^nat) : [sequence n.+1%:R^-1 * series u_ n.+1]_n @ \oo --> 0 -> @@ -915,7 +916,7 @@ Arguments geometric {R} a z n /. Lemma exprn_geometric (R : fieldType) : (@GRing.exp R) = geometric 1. Proof. by rewrite funeq2E => z n /=; rewrite mul1r. Qed. -Lemma cvg_arithmetic (R : archiFieldType) a (z : R) : +Lemma cvg_arithmetic (R : archiRealFieldType) a (z : R) : z > 0 -> arithmetic a z @ \oo --> +oo. Proof. move=> z_gt0; apply/cvgryPge => A; near=> n => /=. @@ -924,7 +925,7 @@ rewrite ler_normlW// ltW// (lt_le_trans (archi_boundP _))// ler_nat. by near: n; apply: nbhs_infty_ge. Unshelve. all: by end_near. Qed. -Lemma cvg_expr (R : archiFieldType) (z : R) : +Lemma cvg_expr (R : archiRealFieldType) (z : R) : `|z| < 1 -> (GRing.exp z : R ^nat) @ \oo --> 0. Proof. move=> Nz_lt1; apply/norm_cvg0P; pose t := (1 - `|z|). @@ -951,15 +952,16 @@ rewrite seriesEnat !mulrBr [in LHS]mulr1 mulr_suml -opprB -sumrB. by under eq_bigr do rewrite -mulrA -exprSr; rewrite telescope_sumr// opprB. Qed. -Lemma cvg_geometric_series (R : archiFieldType) (a z : R) : `|z| < 1 -> +Lemma cvg_geometric_series (R : archiRealFieldType) (a z : R) : `|z| < 1 -> series (geometric a z) @ \oo --> (a * (1 - z)^-1). Proof. move=> Nz_lt1; rewrite geometric_seriesE ?lt_eqF 1?ltr_normlW//. have -> : a / (1 - z) = (a * (1 - 0)) / (1 - z) by rewrite subr0 mulr1. -by apply: cvgMr_tmp; apply: cvgMl_tmp; apply: cvgB; [apply: cvg_cst|apply: cvg_expr]. +by apply: cvgMr_tmp; apply: cvgMl_tmp; apply: cvgB; + [apply: cvg_cst|apply: cvg_expr]. Qed. -Lemma cvg_geometric_series_half (R : archiFieldType) (r : R) n : +Lemma cvg_geometric_series_half (R : archiRealFieldType) (r : R) n : series (fun k => r / (2 ^ (k + n.+1))%:R : R^o) @ \oo --> (r / 2 ^+ n : R^o). Proof. rewrite (_ : series _ = series (geometric (r / (2 ^ n.+1)%:R) 2^-1%R)); last first. @@ -978,11 +980,11 @@ Proof. by rewrite (big_addn 0 _ m) addnC addnK; under eq_bigr do rewrite exprD mulrC. Qed. -Lemma cvg_geometric (R : archiFieldType) (a z : R) : `|z| < 1 -> +Lemma cvg_geometric (R : archiRealFieldType) (a z : R) : `|z| < 1 -> geometric a z @ \oo --> 0. Proof. by move=> /cvg_geometric_series/cvgP/cvg_series_cvg_0. Qed. -Lemma is_cvg_geometric_series (R : archiFieldType) (a z : R) : `|z| < 1 -> +Lemma is_cvg_geometric_series (R : archiRealFieldType) (a z : R) : `|z| < 1 -> cvgn (series (geometric a z)). Proof. by move=> /cvg_geometric_series/cvgP; apply. Qed. @@ -1371,7 +1373,7 @@ Arguments eseries {R} u_ n : simpl never. Arguments etelescope {R} u_ n : simpl never. Notation "[ 'series' E ]_ n" := (eseries [sequence E%E]_n) : ereal_scope. -Lemma cvg_geometric_eseries_half {R : archiFieldType} (r : R) (n : nat) : +Lemma cvg_geometric_eseries_half {R : archiRealFieldType} (r : R) (n : nat) : eseries (fun k => (r / (2 ^ (k + n.+1))%:R)%:E) @ \oo --> (r / 2 ^+ n)%:E. Proof. apply: cvg_EFin => //. @@ -1923,9 +1925,53 @@ by move/(lt_le_trans Ml); rewrite ltxx. Unshelve. all: by end_near. Qed. End sequences_ereal. - Arguments nneseries_split {R f} _ _. +Local Open Scope ereal_scope. +Lemma epsilon_trick (R : realType) (A : (\bar R)^nat) e + (P : pred nat) : (forall n, 0 <= A n) -> (0 <= e)%R -> + \sum_(i A0 /nonnegP[{}e]. +rewrite (@le_trans _ _ (lim ((fun n => (\sum_(0 <= i < n | P i) A i) + + \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) @ \oo))) //. + rewrite nneseriesD // limeD //. + - rewrite leeD2l //; apply: lee_lim => //. + + exact: is_cvg_nneseries. + + exact: is_cvg_nneseries. + + by near=> n; exact: lee_sum_nneg_subset. + - exact: is_cvg_nneseries. + - exact: is_cvg_nneseries. + - exact: adde_def_nneseries. +suff cvggeo : (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) @ \oo --> + e%:num%:E. + rewrite limeD //. + - by rewrite leeD2l // (cvg_lim _ cvggeo). + - exact: is_cvg_nneseries. + - by apply: is_cvg_nneseries => ?; rewrite lee_fin divr_ge0. + - by rewrite (cvg_lim _ cvggeo) //= fin_num_adde_defl. +rewrite (_ : (fun n => _) = EFin \o + (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ (i + 1))%:R))%R); last first. + rewrite funeqE => n /=; rewrite (@big_morph _ _ EFin 0 adde)//. + by under [in RHS]eq_bigr do rewrite addn1. +apply: cvg_comp; last by apply cvg_refl. +have := cvg_geometric_series_half e%:num O. +by rewrite expr0 divr1; apply: cvg_trans. +Unshelve. all: by end_near. Qed. + +Lemma epsilon_trick0 (R : realType) (eps : R) (P : pred nat) : + (0 <= eps)%R -> \sum_(i epspos; have := epsilon_trick P (fun=> lexx 0) epspos. +(* TODO: breaks coq 8.15 and below *) +(* (under eq_eseriesr do rewrite add0e) => /le_trans; apply. *) +rewrite (@eq_eseriesr _ (fun n => 0 + _) (fun n => (eps/(2^n.+1)%:R)%:E)). + by move/le_trans; apply; rewrite eseries0 ?add0e; [exact: lexx | move=> ? ?]. +by move=> ? ?; rewrite add0e. +Qed. +Local Close Scope ereal_scope. + Section minr_cvg_0. Local Open Scope ring_scope. Context {R : realFieldType}. diff --git a/theories/topology_theory/num_topology.v b/theories/topology_theory/num_topology.v index e265bb2eac..4be6009321 100644 --- a/theories/topology_theory/num_topology.v +++ b/theories/topology_theory/num_topology.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import all_classical. @@ -121,7 +121,7 @@ HB.instance Definition _ (R : realType) := PseudoPointedMetric.copy R R^o. HB.instance Definition _ (R : rcfType) := PseudoPointedMetric.copy R R^o. #[export, non_forgetful_inheritance] -HB.instance Definition _ (R : archiFieldType) := PseudoPointedMetric.copy R R^o. +HB.instance Definition _ (R : archiRealFieldType) := PseudoPointedMetric.copy R R^o. #[export, non_forgetful_inheritance] HB.instance Definition _ (R : realFieldType) := PseudoPointedMetric.copy R R^o.