From 466ad81fea5cd9fec38a95ce9fa8387a0ab19d9e Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 14 Apr 2023 17:44:54 +0900 Subject: [PATCH 01/73] tentative definition of Lp-spaces --- _CoqProject | 1 + theories/lspace.v | 129 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 130 insertions(+) create mode 100644 theories/lspace.v diff --git a/_CoqProject b/_CoqProject index 29135cf9d2..75c7be01ba 100644 --- a/_CoqProject +++ b/_CoqProject @@ -121,3 +121,4 @@ theories/gauss_integral.v theories/showcase/summability.v analysis_stdlib/Rstruct_topology.v analysis_stdlib/showcase/uniform_bigO.v +theories/lspace.v diff --git a/theories/lspace.v b/theories/lspace.v new file mode 100644 index 0000000000..ca8778d70a --- /dev/null +++ b/theories/lspace.v @@ -0,0 +1,129 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect. +From mathcomp Require Import ssralg ssrnum ssrint interval finmap. +Require Import boolp reals ereal. +From HB Require Import structures. +Require Import classical_sets signed functions topology normedtype cardinality. +Require Import sequences esum measure numfun lebesgue_measure lebesgue_integral. +Require Import exp. + +(******************************************************************************) +(* *) +(* LfunType mu p == type of measurable functions f such that the *) +(* integral of |f| ^ p is finite *) +(* LType mu p == type of the elements of the Lp space *) +(* mu.-Lspace p == Lp space *) +(* *) +(******************************************************************************) + +Reserved Notation "mu .-Lspace p" (at level 4, format "mu .-Lspace p"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +HB.mixin Record isLfun d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (p : R) (f : T -> R) := { + measurable_lfun : measurable_fun [set: T] f ; + lfuny : (\int[mu]_x (`|f x| `^ p)%:E < +oo)%E +}. + +#[short(type=LfunType)] +HB.structure Definition Lfun d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (p : R) := + {f : T -> R & isLfun d T R mu p f}. + +#[global] Hint Resolve measurable_lfun : core. +Arguments lfuny {d} {T} {R} {mu} {p} _. +#[global] Hint Resolve lfuny : core. + +Section Lfun_canonical. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : R). + +Canonical Lfun_eqType := EqType (LfunType mu p) gen_eqMixin. +Canonical Lfun_choiceType := ChoiceType (LfunType mu p) gen_choiceMixin. +End Lfun_canonical. + +Section Lequiv. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : R). + +Definition Lequiv (f g : LfunType mu p) := `[< {ae mu, forall x, f x = g x} >]. + +Let Lequiv_refl : reflexive Lequiv. +Proof. +by move=> f; exact/asboolP/(ae_imply _ (ae_eq_refl mu setT (EFin \o f))). +Qed. + +Let Lequiv_sym : symmetric Lequiv. +Proof. +by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP; exact: ae_imply h. +Qed. + +Let Lequiv_trans : transitive Lequiv. +Proof. +move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(ae_imply2 _ gf fh). +by move=> x ->. +Qed. + +Canonical Lequiv_canonical := + EquivRel Lequiv Lequiv_refl Lequiv_sym Lequiv_trans. + +Local Open Scope quotient_scope. + +Definition LspaceType := {eq_quot Lequiv}. +Canonical LspaceType_quotType := [quotType of LspaceType]. +Canonical LspaceType_eqType := [eqType of LspaceType]. +Canonical LspaceType_choiceType := [choiceType of LspaceType]. +Canonical LspaceType_eqQuotType := [eqQuotType Lequiv of LspaceType]. + +Lemma LequivP (f g : LfunType mu p) : + reflect {ae mu, forall x, f x = g x} (f == g %[mod LspaceType]). +Proof. by apply/(iffP idP); rewrite eqmodE// => /asboolP. Qed. + +Record LType := MemLType { Lfun_class : LspaceType }. +Coercion LfunType_of_LType (f : LType) : LfunType mu p := + repr (Lfun_class f). + +End Lequiv. + +Section Lspace. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. + +Definition Lspace p := [set: LType mu p]. +Arguments Lspace : clear implicits. + +Lemma LType1_integrable (f : LType mu 1) : mu.-integrable setT (EFin \o f). +Proof. +split; first exact/EFin_measurable_fun. +under eq_integral. + move=> x _ /=. + rewrite -(@powere_pose1 _ `|f x|%:E)//. + over. +exact: lfuny f. +Qed. + +Lemma LType2_integrable_sqr (f : LType mu 2) : + mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). +Proof. +split; first exact/EFin_measurable_fun/measurable_fun_exprn. +rewrite (le_lt_trans _ (lfuny f))// ge0_le_integral//. +- apply: measurable_funT_comp => //. + exact/EFin_measurable_fun/measurable_fun_exprn. +- by move=> x _; rewrite lee_fin power_pos_ge0. +- apply/EFin_measurable_fun. + under eq_fun do rewrite power_pos_mulrn//. + exact/measurable_fun_exprn/measurable_funT_comp. +- by move=> t _/=; rewrite lee_fin normrX power_pos_mulrn. +Qed. + +End Lspace. +Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. From 4eda318d0cbd981b1e3f8d19ffd48d0ab4d1eae8 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Mon, 27 May 2024 09:45:45 +0200 Subject: [PATCH 02/73] extended reals - compilation, CI fixes --- theories/lspace.v | 212 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 180 insertions(+), 32 deletions(-) diff --git a/theories/lspace.v b/theories/lspace.v index ca8778d70a..ddc44368a0 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -5,7 +5,7 @@ Require Import boolp reals ereal. From HB Require Import structures. Require Import classical_sets signed functions topology normedtype cardinality. Require Import sequences esum measure numfun lebesgue_measure lebesgue_integral. -Require Import exp. +Require Import exp hoelder. (******************************************************************************) (* *) @@ -29,14 +29,14 @@ Local Open Scope classical_set_scope. Local Open Scope ring_scope. HB.mixin Record isLfun d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : R) (f : T -> R) := { + (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := { measurable_lfun : measurable_fun [set: T] f ; - lfuny : (\int[mu]_x (`|f x| `^ p)%:E < +oo)%E + lfuny : ('N[ mu ]_p [ f ] < +oo)%E }. #[short(type=LfunType)] HB.structure Definition Lfun d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : R) := + (mu : {measure set T -> \bar R}) (p : \bar R) := {f : T -> R & isLfun d T R mu p f}. #[global] Hint Resolve measurable_lfun : core. @@ -45,32 +45,32 @@ Arguments lfuny {d} {T} {R} {mu} {p} _. Section Lfun_canonical. Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : R). +Variables (mu : {measure set T -> \bar R}) (p : \bar R). + +HB.instance Definition _ := gen_eqMixin (LfunType mu p). +HB.instance Definition _ := gen_choiceMixin (LfunType mu p). -Canonical Lfun_eqType := EqType (LfunType mu p) gen_eqMixin. -Canonical Lfun_choiceType := ChoiceType (LfunType mu p) gen_choiceMixin. End Lfun_canonical. Section Lequiv. Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : R). +Variables (mu : {measure set T -> \bar R}) (p : \bar R). Definition Lequiv (f g : LfunType mu p) := `[< {ae mu, forall x, f x = g x} >]. Let Lequiv_refl : reflexive Lequiv. Proof. -by move=> f; exact/asboolP/(ae_imply _ (ae_eq_refl mu setT (EFin \o f))). +by move=> f; exact/asboolP/(filterS _ (ae_eq_refl mu setT (EFin \o f))). Qed. Let Lequiv_sym : symmetric Lequiv. Proof. -by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP; exact: ae_imply h. +by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP; exact: filterS h. Qed. Let Lequiv_trans : transitive Lequiv. Proof. -move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(ae_imply2 _ gf fh). -by move=> x ->. +by move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(filterS2 _ _ gf fh) => x ->. Qed. Canonical Lequiv_canonical := @@ -79,10 +79,10 @@ Canonical Lequiv_canonical := Local Open Scope quotient_scope. Definition LspaceType := {eq_quot Lequiv}. -Canonical LspaceType_quotType := [quotType of LspaceType]. -Canonical LspaceType_eqType := [eqType of LspaceType]. -Canonical LspaceType_choiceType := [choiceType of LspaceType]. -Canonical LspaceType_eqQuotType := [eqQuotType Lequiv of LspaceType]. +Canonical LspaceType_quotType := [the quotType _ of LspaceType]. +Canonical LspaceType_eqType := [the eqType of LspaceType]. +Canonical LspaceType_choiceType := [the choiceType of LspaceType]. +Canonical LspaceType_eqQuotType := [the eqQuotType Lequiv of LspaceType]. Lemma LequivP (f g : LfunType mu p) : reflect {ae mu, forall x, f x = g x} (f == g %[mod LspaceType]). @@ -103,27 +103,175 @@ Arguments Lspace : clear implicits. Lemma LType1_integrable (f : LType mu 1) : mu.-integrable setT (EFin \o f). Proof. -split; first exact/EFin_measurable_fun. -under eq_integral. - move=> x _ /=. - rewrite -(@powere_pose1 _ `|f x|%:E)//. - over. -exact: lfuny f. +apply/integrableP; split; first exact/EFin_measurable_fun. +have := lfuny f. +rewrite unlock /Lnorm ifF ?oner_eq0// invr1 poweRe1; last first. + by apply integral_ge0 => x _; rewrite lee_fin powRr1//. +by under eq_integral => i _ do rewrite powRr1//. Qed. -Lemma LType2_integrable_sqr (f : LType mu 2) : +Lemma LType2_integrable_sqr (f : LType mu 2%:E) : mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). Proof. -split; first exact/EFin_measurable_fun/measurable_fun_exprn. -rewrite (le_lt_trans _ (lfuny f))// ge0_le_integral//. -- apply: measurable_funT_comp => //. - exact/EFin_measurable_fun/measurable_fun_exprn. -- by move=> x _; rewrite lee_fin power_pos_ge0. -- apply/EFin_measurable_fun. - under eq_fun do rewrite power_pos_mulrn//. - exact/measurable_fun_exprn/measurable_funT_comp. -- by move=> t _/=; rewrite lee_fin normrX power_pos_mulrn. +apply/integrableP; split. + exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f)/measurable_lfun. +rewrite (@lty_poweRy _ _ (2^-1))//. +rewrite (le_lt_trans _ (lfuny f))//. +rewrite unlock /Lnorm ifF ?gt_eqF//. +rewrite gt0_ler_poweR//. +- by rewrite in_itv/= integral_ge0// leey. +- rewrite in_itv/= leey integral_ge0// => x _. + by rewrite lee_fin powR_ge0. +rewrite ge0_le_integral//. +- apply: measurableT_comp => //. + exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f)/measurable_lfun. +- by move=> x _; rewrite lee_fin powR_ge0. +- exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R)/measurableT_comp/measurable_lfun. +- by move=> t _/=; rewrite lee_fin normrX powR_mulrn. Qed. End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. + +Section Lspace_norm. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Variable (p : R). (* add hypothesis p > 1 *) + +(* 0 - + should come with proofs that they are in LfunType mu p *) + +Notation ty := (T -> R). +Definition nm f := fine ('N[mu]_p%:E[f]). + +(* Program Definition fct_zmodMixin := *) +(* @GRing.isZmodule.Build (LfunType mu p%:E) 0 (fun f x => - f x) (fun f g => f \+ g). *) + +(* measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R *) + +(* Notation ty := (LfunType mu p%:E). *) +(* Definition nm (f : ty) := fine ('N[mu]_p%:E[f]). *) + +(* HB.instance Definition _ := GRing.Zmodule.on ty. *) + +Lemma ler_Lnorm_add (f g : ty) : + nm (f \+ g) <= nm f + nm g. +Proof. +rewrite /nm. +have : (-oo < 'N[mu]_p%:E[f])%E by exact: (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _)). +have : (-oo < 'N[mu]_p%:E[g])%E by exact: (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _)). +rewrite !ltNye_eq => /orP[f_fin /orP[g_fin|/eqP foo]|/eqP goo]. +- rewrite -fineD ?fine_le//. + - admit. + - by rewrite fin_numD f_fin g_fin//. + rewrite minkowski//. admit. admit. admit. +- rewrite foo/= add0r. + have : ('N[mu]_p%:E[f] <= 'N[mu]_p%:E[(f \+ g)])%E. + rewrite unlock /Lnorm. + rewrite {1}(@ifF _ (p == 0)). + rewrite {1}(@ifF _ (p == 0)). + rewrite gt0_ler_poweR. + - by []. + - admit. + - admit. + - admit. + rewrite ge0_le_integral//. + - move => x _. rewrite lee_fin powR_ge0//. + - admit. + - move => x _. rewrite lee_fin powR_ge0//. + - admit. + - move => x _. rewrite lee_fin gt0_ler_powR//. admit. (* rewrite normr_le. *) + +Admitted. + +Lemma natmulfctE (U : pointedType) (K : ringType) (f : U -> K) n : + f *+ n = (fun x => f x *+ n). +Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. + + +Lemma Lnorm_eq0 f : nm f = 0 -> {ae mu, f =1 0}. +rewrite /nm => /eqP. +rewrite fine_eq0; last first. admit. +move/eqP/Lnorm_eq0_eq0. +(* ale: I don't think it holds almost everywhere equal does not mean equal * +rewrite unlock /Lnorm ifF. +rewrite poweR_eq0. +rewrite integral_abs_eq0. *) +Admitted. + +Lemma Lnorm_natmul f k : nm (f *+ k) = nm f *+ k. +rewrite /nm unlock /Lnorm. +case: (ifP (p == 0)). + admit. + +move => p0. +under eq_integral => x _. + rewrite -mulr_natr/=. + rewrite fctE (_ : k%:R _ = k%:R); last by rewrite natmulfctE. + rewrite normrM powRM//=. + rewrite mulrC EFinM. + over. +rewrite /=. +rewrite integralZl//; last first. admit. +rewrite poweRM; last 2 first. +- by rewrite lee_fin powR_ge0. +- by rewrite integral_ge0// => x _; rewrite lee_fin powR_ge0. + +rewrite poweR_EFin -powRrM mulfV; last admit. +rewrite powRr1//. +rewrite fineM//; last admit. +rewrite mulrC. + +Admitted. + +Lemma LnormN f : nm (-f) = nm f. +rewrite /nm. +congr (fine _). +rewrite unlock /Lnorm. +case: ifP. +move=> p0. + admit. + +move=> p0. +congr (_ `^ _)%E. +apply eq_integral => x _. +congr ((_ `^ _)%:E). +by rewrite normrN. +Admitted. + +(* +Lemma ler_Lnorm_add f g : + 'N[mu]_p%:E[(f \+ g)%R] <= 'N[mu]_p%:E[f] + 'N[mu]_p%:E[g]. +Admitted. + +Lemma Lnorm_eq0 f : 'N[mu]_p%:E[f] = 0 -> f = 0%R. +Admitted. + +Lemma Lnorm_natmul f k : 'N[mu]_p%:E [f *+ k]%R = 'N[mu]_p%:E [f] *+ k. +Admitted. + +Lemma LnormN f : 'N[mu]_p%:E [- f]%R = 'N[mu]_p%:E [f]. +Admitted. +*) + +HB.instance Definition _ := + @Num.Zmodule_isNormed.Build R (*LType mu p%:E*) ty + nm ler_Lnorm_add Lnorm_eq0 Lnorm_natmul LnormN. + +(* todo: add equivalent of mx_normZ and HB instance *) + +End Lspace_norm. + +(* +Section Lspace_inclusion. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. + +Lemma Lspace_inclusion p q : (p <= q)%E -> + forall (f : LfunType mu q), ('N[ mu ]_p [ f ] < +oo)%E. +Proof. +move=> pleq f. + +isLfun d T R mu p f. + +End Lspace_inclusion. +*) From 8b722e8ee29a97a75cf5abb61a3e5f7ab6b5802c Mon Sep 17 00:00:00 2001 From: Cyril Cohen Date: Mon, 27 Jan 2025 17:35:30 +0100 Subject: [PATCH 03/73] WIP --- .nix/config.nix | 3 +-- theories/lspace.v | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/.nix/config.nix b/.nix/config.nix index 73bf03fcfa..17704e242b 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -51,7 +51,6 @@ in bundles."8.20".coqPackages = common-bundle // { coq.override.version = "8.20"; - mathcomp.override.version = "2.2.0"; }; bundles."9.0".coqPackages = common-bundle // { @@ -70,7 +69,7 @@ in coq-elpi.override.version = "master"; coq-elpi.override.elpi-version = "2.0.7"; hierarchy-builder.override.version = "master"; - mathcomp.override.version = "master"; + mathcomp.override.version = "CohenCyril:seminorm"; mathcomp-bigenough.override.version = "master"; mathcomp-finmap.override.version = "master"; ssprove.job = false; diff --git a/theories/lspace.v b/theories/lspace.v index ddc44368a0..4a39a17202 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -1,7 +1,7 @@ (* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect. From mathcomp Require Import ssralg ssrnum ssrint interval finmap. -Require Import boolp reals ereal. +From mathcomp Require Import boolp reals ereal. From HB Require Import structures. Require Import classical_sets signed functions topology normedtype cardinality. Require Import sequences esum measure numfun lebesgue_measure lebesgue_integral. From 7e49d4b6ac1848cf2abefdbd3ad3f6064d67d58e Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Tue, 28 Jan 2025 09:38:10 +0100 Subject: [PATCH 04/73] norms - lspace.v headers --- theories/hoelder.v | 70 ++++++++++++++++++++++++++++++++++++++++++++++ theories/lspace.v | 10 +++---- 2 files changed, 75 insertions(+), 5 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 06385c4acf..e1289621d2 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -93,6 +93,26 @@ move=> r0; rewrite unlock (negbTE r0) -poweRrM mulVf// poweRe1//. by apply: integral_ge0 => x _; rewrite lee_fin// powR_ge0. Qed. +Lemma opp_Lnorm f p : + 'N_p[-%R \o f] = 'N_p[f]. +Proof. +rewrite unlock /Lnorm. +case: p => /= [r||//]. + case: eqP => _. congr (mu _). + rewrite !preimage_setI. + congr (_ `&` _). + rewrite -!preimage_setC. + congr (~` _). + rewrite /preimage. + apply: funext => x/=. + rewrite -{1}oppr0. + apply: propext. split; last by move=> ->. + by move/oppr_inj. + by under eq_integral => x _ do rewrite normrN. +rewrite compA (_ : normr \o -%R = normr)//. +apply: funext => x/=; exact: normrN. +Qed. + End Lnorm_properties. #[global] @@ -490,4 +510,54 @@ congr (_ * _); rewrite poweRN. - by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. Qed. +Lemma minkowski' f g p : + measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R -> + 'N_p%:E[f] <= 'N_p%:E[f \+ g] + 'N_p%:E[g]. +Proof. +move=> mf mg p1. +rewrite (_ : f = ((f \+ g) \+ (-%R \o g))%R); last admit. +rewrite [X in _ <= 'N__[X] + _](_ : ((f \+ g \- g) \+ g)%R = (f \+ g)%R); last admit. +rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last admit. +apply: minkowski => //. + apply: measurable_funD => //. +apply: measurableT_comp => //. +Admitted. + End minkowski. + +Section Lnorm_properties. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. +Implicit Types (p : \bar R) (f g : T -> R) (r : R). + +Lemma LnormD_fin_num p f g : + 1 <= p -> + measurable_fun setT f -> measurable_fun setT g -> + 'N[mu]_p[f] \is a fin_num -> 'N[mu]_p[g] \is a fin_num -> + 'N[mu]_p[f \+ g] \is a fin_num. +Proof. +case: p => [p|_|]. +- move=> p1 mf mg Nffin Ngfin. + rewrite fin_numElt (@lt_le_trans _ _ 0)//= ?Lnorm_ge0//. + rewrite (@le_lt_trans _ _ ('N[mu]_p%:E[f] + 'N[mu]_p%:E[g]))//. + apply: minkowski => //. + by rewrite lte_add_pinfty// -ge0_fin_numE// Lnorm_ge0. +- move=> mf mg. + rewrite unlock /Lnorm. + case: ifPn => // mu_ge0. + rewrite !fin_numElt => /andP[_ fley] /andP[_ gley]. + rewrite (@lt_le_trans _ _ 0)//= ?ess_sup_ge0//; last first. + move=> t/=; exact: normr_ge0. + admit. +- by rewrite leeNy_eq => /eqP. +Admitted. + +Lemma LnormD_pinfty p f g : + 1 <= p -> measurable_fun setT f -> measurable_fun setT g -> + 'N[mu]_p[f] = +oo -> 'N[mu]_p[f \+ g] = +oo. +Proof. +case: p => [p||]. +- move=> p1 mf mg. + +End Lnorm_properties. diff --git a/theories/lspace.v b/theories/lspace.v index 4a39a17202..db1807b51f 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -3,9 +3,9 @@ From mathcomp Require Import all_ssreflect. From mathcomp Require Import ssralg ssrnum ssrint interval finmap. From mathcomp Require Import boolp reals ereal. From HB Require Import structures. -Require Import classical_sets signed functions topology normedtype cardinality. -Require Import sequences esum measure numfun lebesgue_measure lebesgue_integral. -Require Import exp hoelder. +From mathcomp Require Import classical_sets signed functions topology normedtype cardinality. +From mathcomp Require Import sequences esum measure numfun lebesgue_measure lebesgue_integral. +From mathcomp Require Import exp hoelder. (******************************************************************************) (* *) @@ -254,8 +254,8 @@ Admitted. *) HB.instance Definition _ := - @Num.Zmodule_isNormed.Build R (*LType mu p%:E*) ty - nm ler_Lnorm_add Lnorm_eq0 Lnorm_natmul LnormN. + @Num.Zmodule_isSemiNormed.Build R (*LType mu p%:E*) ty + nm ler_Lnorm_add Lnorm_natmul LnormN. (* todo: add equivalent of mx_normZ and HB instance *) From 00464879eebe4d69b122b41cea88243c5ca6590d Mon Sep 17 00:00:00 2001 From: Cyril Cohen Date: Tue, 28 Jan 2025 17:00:55 +0100 Subject: [PATCH 05/73] ae improvements - making ae work as a filter - Adding notations for ae - generalizing ae_eq --- theories/charge.v | 3 ++ theories/lspace.v | 4 +-- theories/measure.v | 69 +++++++++++++++++++++++----------------------- 3 files changed, 40 insertions(+), 36 deletions(-) diff --git a/theories/charge.v b/theories/charge.v index 95c10c2199..a42ecd1899 100644 --- a/theories/charge.v +++ b/theories/charge.v @@ -1866,6 +1866,9 @@ have nuf A : d.-measurable A -> nu A = \int[mu]_(x in A) f x. move=> A mA; rewrite nuf ?inE//; apply: ae_eq_integral => //. - exact/measurable_funTS. - exact/measurable_funTS. +- move: ff'. + have := @ae_eq_subset _ _ _ mu setT A f f'. + apply: ae_eq_subset. - exact: ae_eq_subset ff'. Qed. diff --git a/theories/lspace.v b/theories/lspace.v index db1807b51f..f8c3ad6901 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -56,7 +56,7 @@ Section Lequiv. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). -Definition Lequiv (f g : LfunType mu p) := `[< {ae mu, forall x, f x = g x} >]. +Definition Lequiv (f g : LfunType mu p) := `[< f = g [%ae mu] >]. Let Lequiv_refl : reflexive Lequiv. Proof. @@ -85,7 +85,7 @@ Canonical LspaceType_choiceType := [the choiceType of LspaceType]. Canonical LspaceType_eqQuotType := [the eqQuotType Lequiv of LspaceType]. Lemma LequivP (f g : LfunType mu p) : - reflect {ae mu, forall x, f x = g x} (f == g %[mod LspaceType]). + reflect (f = g %[ae mu]) (f == g %[mod LspaceType]). Proof. by apply/(iffP idP); rewrite eqmodE// => /asboolP. Qed. Record LType := MemLType { Lfun_class : LspaceType }. diff --git a/theories/measure.v b/theories/measure.v index 8a077a7127..77ca0b23b4 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -4092,7 +4092,8 @@ Qed. Section ae. Definition almost_everywhere d (T : semiRingOfSetsType d) (R : realFieldType) - (mu : set T -> \bar R) (P : T -> Prop) := mu.-negligible (~` [set x | P x]). + (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. @@ -4111,16 +4112,14 @@ Proof. by rewrite /almost_everywhere => mA mB; rewrite setCI; exact: negligibleU. Qed. -#[global] -Instance ae_filter_ringOfSetsType d {T : ringOfSetsType d} (R : realFieldType) +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. -#[global] -Instance ae_properfilter_algebraOfSetsType d {T : algebraOfSetsType d} +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. @@ -4133,19 +4132,27 @@ 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. -Definition almost_everywhere_notation d (T : semiRingOfSetsType d) - (R : realFieldType) (mu : set T -> \bar R) (P : T -> Prop) - & (phantom Prop (forall x, P x)) := almost_everywhere mu P. -Notation "{ 'ae' m , P }" := - (almost_everywhere_notation m (inPhantom P)) : type_scope. - -Lemma aeW {d} {T : semiRingOfSetsType d} {R : realFieldType} +Notation "{ 'ae' m , P }" := {near almost_everywhere m, P} : type_scope. +Notation "\forall x \ae mu , P" := (\forall x \near almost_everywhere mu, P) + (format "\forall x \ae mu , P", + x name, P at level 200, at level 200): type_scope. +Notation ae_eq mu D f g := (\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) + (format "f = g '%[ae' mu 'in' D ]", g at next level, D at level 200, at level 70). +Notation "f = g %[ae mu ]" := (f = g %[ae mu in setT ]) + (format "f = g '%[ae' mu ]", g at next level, at level 70). + +Lemma aeW {d} {T : ringOfSetsType d} {R : realFieldType} (mu : {measure set _ -> \bar R}) (P : T -> Prop) : - (forall x, P x) -> {ae mu, forall x, P x}. + (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]. @@ -4153,29 +4160,26 @@ Qed. Section ae_eq. Local Open Scope ereal_scope. -Context d (T : sigmaRingType d) (R : realType). +Context d (T : sigmaRingType d) (R : realType) (U V : Type). Variables (mu : {measure set T -> \bar R}) (D : set T). -Implicit Types f g h i : T -> \bar R. +Local Notation ae_eq f g := (\forall x \ae mu, D x -> f x = g x). -Definition ae_eq f g := {ae mu, forall x, D x -> f x = g x}. - -Lemma ae_eq0 f g : measurable D -> mu D = 0 -> ae_eq f g. +Lemma ae_eq0 (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. -Lemma ae_eq_comp (j : \bar R -> \bar R) f g : +Lemma ae_eq_comp (j : U -> V) f g : ae_eq f g -> ae_eq (j \o f) (j \o g). Proof. by apply: filterS => x /[apply] /= ->. Qed. -Lemma ae_eq_funeposneg f g : ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-. +Lemma ae_eq_funeposneg (f g : T -> \bar R) : + ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-. Proof. -split=> [fg|[]]. - split; apply: filterS fg => x /[apply]. - by rewrite !funeposE => ->. - by rewrite !funenegE => ->. -apply: filterS2 => x + + Dx => /(_ Dx) fg /(_ Dx) gf. -by rewrite (funeposneg f) (funeposneg g) fg gf. -Qed. +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. +Implicit Types (f g : T -> U). Lemma ae_eq_refl f : ae_eq f f. Proof. exact/aeW. Qed. Lemma ae_eq_sym f g : ae_eq f g -> ae_eq g f. @@ -4202,14 +4206,11 @@ Proof. by apply: filterS => x /[apply] /= ->. Qed. End ae_eq. Section ae_eq_lemmas. -Context d (T : sigmaRingType d) (R : realType). -Implicit Types mu : {measure set T -> \bar R}. +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. -move=> BA [N [mN N0 fg]]; exists N; split => //. -by apply: subset_trans fg; apply: subsetC => z /= /[swap] /BA ? ->. -Qed. +Proof. by move=> BA; apply: filterS => x + /BA; apply. Qed. End ae_eq_lemmas. @@ -5346,7 +5347,7 @@ Notation "m1 `<< m2" := (measure_dominates m1 m2). Section absolute_continuity_lemmas. Context d (T : measurableType d) (R : realType). -Implicit Types m : {measure set T -> \bar R}. +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. From cdc6feb0229335a931e312f6f88b9403ad5f3b66 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Tue, 28 Jan 2025 18:11:08 +0100 Subject: [PATCH 06/73] improvements - more generalizations of ae_eq - hoelder.v doc - better interface in lspace.v --- theories/charge.v | 9 +- theories/hoelder.v | 56 ++---- theories/lspace.v | 435 +++++++++++++++++++++++++++++++++------------ theories/measure.v | 98 +++++++--- 4 files changed, 409 insertions(+), 189 deletions(-) diff --git a/theories/charge.v b/theories/charge.v index a42ecd1899..0e81630c20 100644 --- a/theories/charge.v +++ b/theories/charge.v @@ -1866,10 +1866,7 @@ have nuf A : d.-measurable A -> nu A = \int[mu]_(x in A) f x. move=> A mA; rewrite nuf ?inE//; apply: ae_eq_integral => //. - exact/measurable_funTS. - exact/measurable_funTS. -- move: ff'. - have := @ae_eq_subset _ _ _ mu setT A f f'. - apply: ae_eq_subset. -- exact: ae_eq_subset ff'. +- exact: (@ae_eq_subset _ _ _ _ mu setT A f f' (@subsetT _ A)). Qed. End radon_nikodym_sigma_finite. @@ -2095,6 +2092,10 @@ move=> mE; apply: integral_ae_eq => //. by rewrite -Radon_Nikodym_SigmaFinite.f_integral. Qed. +(* TODO: move back to measure.v, current version incompatible *) +Lemma ae_eq_mul2l (f g h : T -> \bar R) D : f = g %[ae mu in D] -> (h \* f) = (h \* g) %[ae mu in D]. +Proof. by apply: filterS => x /= /[apply] ->. Qed. + Lemma Radon_Nikodym_change_of_variables f E : measurable E -> nu.-integrable E f -> \int[mu]_(x in E) (f x * ('d (charge_of_finite_measure nu) '/d mu) x) = diff --git a/theories/hoelder.v b/theories/hoelder.v index e1289621d2..4b0ac05b7d 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -10,10 +10,10 @@ From mathcomp Require Import numfun exp convex interval_inference. (**md**************************************************************************) (* # Hoelder's Inequality *) (* *) -(* This file provides Hoelder's inequality. *) +(* This file provides Hoelder's inequality and its consequences, most notably *) +(* Minkowski's inequality and the convexity of the power function. *) (* ``` *) -(* 'N[mu]_p[f] := (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1 *) -(* The corresponding definition is Lnorm. *) +(* 'N[mu]_p[f] == the p-norm of f with measure mu *) (* ``` *) (* *) (******************************************************************************) @@ -93,7 +93,7 @@ move=> r0; rewrite unlock (negbTE r0) -poweRrM mulVf// poweRe1//. by apply: integral_ge0 => x _; rewrite lee_fin// powR_ge0. Qed. -Lemma opp_Lnorm f p : +Lemma oppr_Lnorm f p : 'N_p[-%R \o f] = 'N_p[f]. Proof. rewrite unlock /Lnorm. @@ -515,49 +515,15 @@ Lemma minkowski' f g p : 'N_p%:E[f] <= 'N_p%:E[f \+ g] + 'N_p%:E[g]. Proof. move=> mf mg p1. -rewrite (_ : f = ((f \+ g) \+ (-%R \o g))%R); last admit. -rewrite [X in _ <= 'N__[X] + _](_ : ((f \+ g \- g) \+ g)%R = (f \+ g)%R); last admit. -rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last admit. +rewrite (_ : f = ((f \+ g) \+ (-%R \o g))%R); last first. + by apply: funext => x /=; rewrite -addrA subrr addr0. +rewrite [X in _ <= 'N__[X] + _](_ : ((f \+ g \- g) \+ g)%R = (f \+ g)%R); last first. + by apply: funext => x /=; rewrite -addrA [X in _ + _ + X]addrC subrr addr0. +rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last first. + by rewrite oppr_Lnorm. apply: minkowski => //. apply: measurable_funD => //. apply: measurableT_comp => //. -Admitted. +Qed. End minkowski. - -Section Lnorm_properties. -Context d {T : measurableType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Local Open Scope ereal_scope. -Implicit Types (p : \bar R) (f g : T -> R) (r : R). - -Lemma LnormD_fin_num p f g : - 1 <= p -> - measurable_fun setT f -> measurable_fun setT g -> - 'N[mu]_p[f] \is a fin_num -> 'N[mu]_p[g] \is a fin_num -> - 'N[mu]_p[f \+ g] \is a fin_num. -Proof. -case: p => [p|_|]. -- move=> p1 mf mg Nffin Ngfin. - rewrite fin_numElt (@lt_le_trans _ _ 0)//= ?Lnorm_ge0//. - rewrite (@le_lt_trans _ _ ('N[mu]_p%:E[f] + 'N[mu]_p%:E[g]))//. - apply: minkowski => //. - by rewrite lte_add_pinfty// -ge0_fin_numE// Lnorm_ge0. -- move=> mf mg. - rewrite unlock /Lnorm. - case: ifPn => // mu_ge0. - rewrite !fin_numElt => /andP[_ fley] /andP[_ gley]. - rewrite (@lt_le_trans _ _ 0)//= ?ess_sup_ge0//; last first. - move=> t/=; exact: normr_ge0. - admit. -- by rewrite leeNy_eq => /eqP. -Admitted. - -Lemma LnormD_pinfty p f g : - 1 <= p -> measurable_fun setT f -> measurable_fun setT g -> - 'N[mu]_p[f] = +oo -> 'N[mu]_p[f \+ g] = +oo. -Proof. -case: p => [p||]. -- move=> p1 mf mg. - -End Lnorm_properties. diff --git a/theories/lspace.v b/theories/lspace.v index f8c3ad6901..7da76be76a 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -28,35 +28,40 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +Definition finite_norm d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := + ('N[ mu ]_p [ f ] < +oo)%E. + HB.mixin Record isLfun d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := { - measurable_lfun : measurable_fun [set: T] f ; - lfuny : ('N[ mu ]_p [ f ] < +oo)%E + (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) (f : T -> R) + of @MeasurableFun d _ T R f := { + lfuny : finite_norm mu p f }. #[short(type=LfunType)] HB.structure Definition Lfun d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : \bar R) := - {f : T -> R & isLfun d T R mu p f}. + (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) := + {f of @MeasurableFun d _ T R f & isLfun d T R mu p p1 f}. -#[global] Hint Resolve measurable_lfun : core. Arguments lfuny {d} {T} {R} {mu} {p} _. #[global] Hint Resolve lfuny : core. +#[global] Hint Extern 0 (@LfunType _ _ _ _ _) => + solve [apply: lfuny] : core. Section Lfun_canonical. Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R). +Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). -HB.instance Definition _ := gen_eqMixin (LfunType mu p). -HB.instance Definition _ := gen_choiceMixin (LfunType mu p). +HB.instance Definition _ := gen_eqMixin (LfunType mu p1). +HB.instance Definition _ := gen_choiceMixin (LfunType mu p1). End Lfun_canonical. Section Lequiv. Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R). +Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). -Definition Lequiv (f g : LfunType mu p) := `[< f = g [%ae mu] >]. +Definition Lequiv (f g : LfunType mu p1) := `[< f = g %[ae mu] >]. Let Lequiv_refl : reflexive Lequiv. Proof. @@ -65,12 +70,12 @@ Qed. Let Lequiv_sym : symmetric Lequiv. Proof. -by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP; exact: filterS h. +by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP/ae_eq_sym. Qed. Let Lequiv_trans : transitive Lequiv. Proof. -by move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(filterS2 _ _ gf fh) => x ->. +by move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(ae_eq_trans gf fh). Qed. Canonical Lequiv_canonical := @@ -84,12 +89,12 @@ Canonical LspaceType_eqType := [the eqType of LspaceType]. Canonical LspaceType_choiceType := [the choiceType of LspaceType]. Canonical LspaceType_eqQuotType := [the eqQuotType Lequiv of LspaceType]. -Lemma LequivP (f g : LfunType mu p) : +Lemma LequivP (f g : LfunType mu p1) : reflect (f = g %[ae mu]) (f == g %[mod LspaceType]). Proof. by apply/(iffP idP); rewrite eqmodE// => /asboolP. Qed. Record LType := MemLType { Lfun_class : LspaceType }. -Coercion LfunType_of_LType (f : LType) : LfunType mu p := +Coercion LfunType_of_LType (f : LType) : LfunType mu p1 := repr (Lfun_class f). End Lequiv. @@ -98,25 +103,31 @@ Section Lspace. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. -Definition Lspace p := [set: LType mu p]. +Definition Lspace p (p1 : (1 <= p)%E) := [set: LType mu p1]. Arguments Lspace : clear implicits. -Lemma LType1_integrable (f : LType mu 1) : mu.-integrable setT (EFin \o f). +Lemma LType1_integrable (f : LType mu (@lexx _ _ 1%E)) : mu.-integrable setT (EFin \o f). Proof. apply/integrableP; split; first exact/EFin_measurable_fun. -have := lfuny f. -rewrite unlock /Lnorm ifF ?oner_eq0// invr1 poweRe1; last first. +have := lfuny _ f. +rewrite /finite_norm unlock /Lnorm ifF ?oner_eq0// invr1 poweRe1; last first. by apply integral_ge0 => x _; rewrite lee_fin powRr1//. by under eq_integral => i _ do rewrite powRr1//. Qed. -Lemma LType2_integrable_sqr (f : LType mu 2%:E) : +Let le12 : (1 <= 2%:E :> \bar R)%E. +rewrite lee_fin. +rewrite (ler_nat _ 1 2). +by []. +Qed. + +Lemma LType2_integrable_sqr (f : LType mu le12) : mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). Proof. apply/integrableP; split. - exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f)/measurable_lfun. + exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). rewrite (@lty_poweRy _ _ (2^-1))//. -rewrite (le_lt_trans _ (lfuny f))//. +rewrite (le_lt_trans _ (lfuny _ f))//. rewrite unlock /Lnorm ifF ?gt_eqF//. rewrite gt0_ler_poweR//. - by rewrite in_itv/= integral_ge0// leey. @@ -124,27 +135,219 @@ rewrite gt0_ler_poweR//. by rewrite lee_fin powR_ge0. rewrite ge0_le_integral//. - apply: measurableT_comp => //. - exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f)/measurable_lfun. + exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). - by move=> x _; rewrite lee_fin powR_ge0. -- exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R)/measurableT_comp/measurable_lfun. +- exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R)/measurableT_comp. - by move=> t _/=; rewrite lee_fin normrX powR_mulrn. Qed. End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. +(* move to hoelder.v *) +Section conjugate. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R). +Hypothesis (p1 : (1 <= p)%E). + +Local Open Scope classical_set_scope. +Local Open Scope ereal_scope. + +Definition conjugate := + match p with + | r%:E => [get q : R | r^-1 + q^-1 = 1]%:E + | +oo => 1 + | -oo => 0 + end. + +Lemma conjugateE : + conjugate = if p is r%:E then (r * (r-1)^-1)%:E + else if p == +oo then 1 else 0. +Proof. +rewrite /conjugate. +move: p1. +case: p => [r|//=|//]. +rewrite lee_fin => r1. +have r0 : r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). +congr (_%:E). +apply: get_unique. + by rewrite invf_div mulrBl divff// mul1r addrCA subrr addr0. +move=> /= y h0. +suffices -> : y = (1 - r^-1)^-1. + by rewrite -(mul1r r^-1) -{1}(divff r0) -mulrBl invf_div. +by rewrite -h0 -addrAC subrr add0r invrK. +Qed. + +End conjugate. + + +Section lfun_pred. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R). + +Definition finlfun : {pred _ -> _} := mem [set f | finite_norm mu p f]. +Definition lfun : {pred _ -> _} := [predI @mfun _ _ T R & finlfun]. +Definition lfun_key : pred_key lfun. Proof. exact. Qed. +Canonical lfun_keyed := KeyedPred lfun_key. +Lemma sub_lfun_mfun : {subset lfun <= mfun}. Proof. by move=> x /andP[]. Qed. +Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. Proof. by move=> x /andP[]. Qed. +End lfun_pred. + + +Lemma minkowskie : +forall [d : measure_display] [T : measurableType d] [R : realType] + (mu : measure T R) [f g : T -> R] [p : \bar R], +measurable_fun [set: T] f -> +measurable_fun [set: T] g -> +(1 <= p)%E -> ('N[mu]_p[(f \+ g)%R] <= 'N[mu]_p[f] + 'N[mu]_p[g])%E. +(* TODO: Jairo is working on this *) +Admitted. + + +Section lfun. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). + +Notation lfun := (@lfun _ T R mu p). +Section Sub. +Context (f : T -> R) (fP : f \in lfun). +Definition lfun_Sub1_subproof := + @isMeasurableFun.Build d _ T R f (set_mem (sub_lfun_mfun fP)). +#[local] HB.instance Definition _ := lfun_Sub1_subproof. +Definition lfun_Sub2_subproof := + @isLfun.Build d T R mu p p1 f (set_mem (sub_lfun_finlfun fP)). + +Import HBSimple. + +#[local] HB.instance Definition _ := lfun_Sub2_subproof. +Definition lfun_Sub : LfunType mu p1 := f. +End Sub. + +Lemma lfun_rect (K : LfunType mu p1 -> Type) : + (forall f (Pf : f \in lfun), K (lfun_Sub Pf)) -> forall u, K u. +Proof. +move=> Ksub [f [[Pf1] [Pf2]]]. +have Pf : f \in lfun by apply/andP; rewrite ?inE. +have -> : Pf1 = set_mem (sub_lfun_mfun Pf) by []. +have -> : Pf2 = set_mem (sub_lfun_finlfun Pf) by []. +exact: Ksub. +Qed. + +Lemma lfun_valP f (Pf : f \in lfun) : lfun_Sub Pf = f :> (_ -> _). +Proof. by []. Qed. + +HB.instance Definition _ := isSub.Build _ _ (LfunType mu p1) lfun_rect lfun_valP. + +Lemma lfuneqP (f g : LfunType mu p1) : f = g <-> f =1 g. +Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. + +HB.instance Definition _ := [Choice of LfunType mu p1 by <:]. + +Import numFieldNormedType.Exports. + +Lemma ess_sup_cst_lty r : (0 < mu setT)%E -> (ess_sup mu (cst r) < +oo)%E. +Proof. +rewrite /ess_sup => mu0. +under eq_set do rewrite preimage_cst/=. +rewrite ereal_inf_EFin ?ltry//. +- exists r => x/=; case: ifPn => [_|]. + by move: mu0 => /[swap] ->; rewrite ltNge lexx. + by rewrite set_itvE notin_setE//= ltNge => /negP/negbNE. +by exists r => /=; rewrite ifF//; rewrite set_itvE; + rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. +Qed. + +Lemma ess_sup_cst r : (0 < mu setT)%E -> (ess_sup mu (cst r) = r%:E)%E. +Proof. +rewrite /ess_sup => mu0. +under eq_set do rewrite preimage_cst/=. +rewrite ereal_inf_EFin. +- congr (_%:E). + rewrite [X in inf X](_ : _ = `[r, +oo[%classic); last first. + apply/seteqP; split => /=x/=. + case: ifPn => [_|]; first by move: mu0=> /[swap] ->; rewrite ltNge lexx. + by rewrite set_itvE notin_setE/= ltNge in_itv andbT/= => /negP /negPn. + rewrite in_itv/= => /andP[x0 _]. + by rewrite ifF// set_itvE; apply/negP; rewrite in_setE/= ltNge => /negP. + by rewrite inf_itv. +- exists r => x/=; case: ifPn => [_|]. + by move: mu0 => /[swap] ->; rewrite ltNge lexx. + by rewrite set_itvE notin_setE//= ltNge => /negP/negbNE. +by exists r => /=; rewrite ifF//; rewrite set_itvE; + rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. +Qed. + +Lemma Lnorm0 : 'N[mu]_p[cst 0] = 0. +Proof. +rewrite unlock /Lnorm. +move: p1. +case: p => [r||//]. +- rewrite lee_fin => r1. + have r0: r != 0 by rewrite gt_eqF// (lt_le_trans _ r1). + rewrite gt_eqF ?(lt_le_trans _ r1)//. + under eq_integral => x _ do rewrite /= normr0 powR0//. + by rewrite integral0 poweR0r// invr_neq0. +case: ifPn => //mu0 _. +rewrite (_ : normr \o _ = 0); last by apply: funext => x/=; rewrite normr0. +exact: ess_sup_cst. +Qed. + +Lemma lfuny0 : finite_norm mu p (cst 0). +Proof. by rewrite /finite_norm Lnorm0. Qed. + +HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. + +Lemma mfunP (f : {mfun T >-> R}) : (f : T -> R) \in mfun. +Proof. exact: valP. Qed. + +Lemma lfunP (f : LfunType mu p1) : (f : T -> R) \in lfun. +Proof. exact: valP. Qed. + +Lemma mfun_scaler_closed : scaler_closed (@mfun _ _ T R). +Proof. move=> a/= f; rewrite !inE; exact: measurable_funM. Qed. + +HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) + mfun_scaler_closed. +HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. + +Lemma LnormZ (f : LfunType mu p1) a : ('N[mu]_p[a \*: f] = `|a|%:E * 'N[mu]_p[f])%E. +Admitted. + +Lemma lfun_submod_closed : submod_closed (lfun). +Proof. +split. + rewrite -[0]/(cst 0). exact: lfunP. +move=> a/= f g fP gP. +rewrite -[f]lfun_valP -[g]lfun_valP. +move: (lfun_Sub _) (lfun_Sub _) => {fP} f {gP} g. +rewrite !inE rpredD ?rpredZ ?mfunP//=. +apply: mem_set => /=. +rewrite /finite_norm. +apply: (le_lt_trans (minkowskie _ _ _ _)) => //=. + suff: a *: (g : T -> R) \in mfun by exact: set_mem. + by rewrite rpredZ//; exact: mfunP. +rewrite lte_add_pinfty//; last exact: lfuny. +by rewrite LnormZ lte_mul_pinfty//; exact: lfuny. +Qed. + +HB.instance Definition _ := GRing.isSubmodClosed.Build _ _ lfun + lfun_submod_closed. +HB.instance Definition _ := [SubChoice_isSubLmodule of LfunType mu p1 by <:]. + +End lfun. + Section Lspace_norm. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. -Variable (p : R). (* add hypothesis p > 1 *) +Variable (p : \bar R) (p1 : (1 <= p)%E). (* 0 - + should come with proofs that they are in LfunType mu p *) -Notation ty := (T -> R). -Definition nm f := fine ('N[mu]_p%:E[f]). +Notation ty := (LfunType mu p1). +Definition nm f := fine ('N[mu]_p[f]). -(* Program Definition fct_zmodMixin := *) -(* @GRing.isZmodule.Build (LfunType mu p%:E) 0 (fun f x => - f x) (fun f g => f \+ g). *) + +(* HB.instance Definition _ := GRing.Zmodule.on ty. *) (* measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R *) @@ -154,110 +357,110 @@ Definition nm f := fine ('N[mu]_p%:E[f]). (* HB.instance Definition _ := GRing.Zmodule.on ty. *) Lemma ler_Lnorm_add (f g : ty) : - nm (f \+ g) <= nm f + nm g. + nm (f + g) <= nm f + nm g. Proof. -rewrite /nm. -have : (-oo < 'N[mu]_p%:E[f])%E by exact: (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _)). -have : (-oo < 'N[mu]_p%:E[g])%E by exact: (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _)). -rewrite !ltNye_eq => /orP[f_fin /orP[g_fin|/eqP foo]|/eqP goo]. -- rewrite -fineD ?fine_le//. - - admit. - - by rewrite fin_numD f_fin g_fin//. - rewrite minkowski//. admit. admit. admit. -- rewrite foo/= add0r. - have : ('N[mu]_p%:E[f] <= 'N[mu]_p%:E[(f \+ g)])%E. - rewrite unlock /Lnorm. - rewrite {1}(@ifF _ (p == 0)). - rewrite {1}(@ifF _ (p == 0)). - rewrite gt0_ler_poweR. - - by []. - - admit. - - admit. - - admit. - rewrite ge0_le_integral//. - - move => x _. rewrite lee_fin powR_ge0//. - - admit. - - move => x _. rewrite lee_fin powR_ge0//. - - admit. - - move => x _. rewrite lee_fin gt0_ler_powR//. admit. (* rewrite normr_le. *) - -Admitted. +rewrite /nm -fineD ?fine_le ?minkowskie// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. +- rewrite (le_lt_trans (minkowskie _ _ _ _))//. + by rewrite lte_add_pinfty//; exact: lfuny. +- by rewrite lte_add_pinfty//; exact: lfuny. +- by rewrite adde_ge0 ?Lnorm_ge0. +all: exact: lfuny. +Qed. Lemma natmulfctE (U : pointedType) (K : ringType) (f : U -> K) n : f *+ n = (fun x => f x *+ n). Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. +Lemma LnormN (f : ty) : nm (\-f) = nm f. +Proof. by rewrite /nm oppr_Lnorm. Qed. -Lemma Lnorm_eq0 f : nm f = 0 -> {ae mu, f =1 0}. -rewrite /nm => /eqP. -rewrite fine_eq0; last first. admit. -move/eqP/Lnorm_eq0_eq0. -(* ale: I don't think it holds almost everywhere equal does not mean equal * -rewrite unlock /Lnorm ifF. -rewrite poweR_eq0. -rewrite integral_abs_eq0. *) -Admitted. +Lemma enatmul_ninfty (n : nat) : (-oo *+ n.+1 = -oo :> \bar R)%E \/ (-oo *+ n.+1 = +oo :> \bar R)%E. +Proof. by elim: n => //=[|n []->]; rewrite ?addNye; left. Qed. + +Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. +Proof. +rewrite /nm -scaler_nat LnormZ fineM//= ?normr_nat ?mulr_natl// fin_numElt. +have := lfuny p1 f. +by rewrite /finite_norm (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _)) => ->. +Qed. -Lemma Lnorm_natmul f k : nm (f *+ k) = nm f *+ k. -rewrite /nm unlock /Lnorm. -case: (ifP (p == 0)). - admit. - -move => p0. -under eq_integral => x _. - rewrite -mulr_natr/=. - rewrite fctE (_ : k%:R _ = k%:R); last by rewrite natmulfctE. - rewrite normrM powRM//=. - rewrite mulrC EFinM. - over. -rewrite /=. -rewrite integralZl//; last first. admit. -rewrite poweRM; last 2 first. -- by rewrite lee_fin powR_ge0. -- by rewrite integral_ge0// => x _; rewrite lee_fin powR_ge0. - -rewrite poweR_EFin -powRrM mulfV; last admit. -rewrite powRr1//. -rewrite fineM//; last admit. -rewrite mulrC. -Admitted. +HB.about Num.Zmodule_isSemiNormed.Build. -Lemma LnormN f : nm (-f) = nm f. -rewrite /nm. -congr (fine _). -rewrite unlock /Lnorm. -case: ifP. -move=> p0. - admit. - -move=> p0. -congr (_ `^ _)%E. -apply eq_integral => x _. -congr ((_ `^ _)%:E). -by rewrite normrN. -Admitted. +(* TODO : fix the definition *) +HB.instance Definition _ := + @Num.Zmodule_isSemiNormed.Build R (LfunType mu p1) + nm ler_Lnorm_add Lnorm_natmul LnormN. -(* -Lemma ler_Lnorm_add f g : - 'N[mu]_p%:E[(f \+ g)%R] <= 'N[mu]_p%:E[f] + 'N[mu]_p%:E[g]. -Admitted. +(* todo: add equivalent of mx_normZ and HB instance *) -Lemma Lnorm_eq0 f : 'N[mu]_p%:E[f] = 0 -> f = 0%R. -Admitted. +Lemma ess_sup_ger f (r : R) : (forall x, f x <= r) -> (ess_sup mu f <= r%:E)%E. +Proof. +move=> fr. +rewrite /ess_sup. +apply: ereal_inf_le. +apply/exists2P. +exists r%:E => /=; split => //. +apply/exists2P. +exists r; split => //. +rewrite preimage_itvoy. +suffices -> : [set x | r < f x] = set0 by []. +apply/seteqP; split => x //=. +rewrite lt_neqAle => /andP[rneqfx rlefx]. +move: (fr x) => fxler. +have: (f x <= r <= f x) by rewrite rlefx fxler. +by move/le_anti; move: rneqfx => /[swap] -> /eqP. +Qed. -Lemma Lnorm_natmul f k : 'N[mu]_p%:E [f *+ k]%R = 'N[mu]_p%:E [f] *+ k. +Lemma ess_sup_eq0 (f : {mfun T >-> R}) : ess_sup mu (normr \o f) = 0 -> f = 0 %[ae mu]. Admitted. -Lemma LnormN f : 'N[mu]_p%:E [- f]%R = 'N[mu]_p%:E [f]. -Admitted. -*) -HB.instance Definition _ := - @Num.Zmodule_isSemiNormed.Build R (*LType mu p%:E*) ty - nm ler_Lnorm_add Lnorm_natmul LnormN. +(* TODO: move to hoelder *) +Lemma Lnorm_eq0_eq0 (f : {mfun T >-> R}) : (0 < p)%E -> + 'N[mu]_p[f] = 0 -> f = 0 %[ae mu]. +Proof. +rewrite unlock /Lnorm => p0. +move: p0. +case: p => [r r0||]. +- case: ifPn => _. + rewrite preimage_setI preimage_setT setTI -preimage_setC => /negligibleP. + move/(_ (measurableC _)); rewrite -[X in d.-measurable X]setTI. + move/(_ (measurable_funP _ measurableT _ (measurable_set1 _))) => /=. + by case => A [mA muA0 fA]; exists A; split => // x/= ?; exact: fA. + move=> /poweR_eq0_eq0. + move=> /(_ (integral_ge0 _ _)) h. + have: (\int[mu]_x (`|f x| `^ r)%:E)%E = 0 by apply: h => x _; rewrite lee_fin powR_ge0. + under eq_integral => x _ do rewrite -[_%:E]gee0_abs ?lee_fin ?powR_ge0//. + have mp: measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). + apply: measurableT_comp => //. + apply (measurableT_comp (measurable_powR _)) => //. + apply: measurableT_comp => //. + move/(ae_eq_integral_abs _ measurableT mp). + apply: filterS => x/= /[apply]. + by case=> /powR_eq0_eq0 /eqP; rewrite normr_eq0 => /eqP. +- case: ifPn => [mu0 _|]. + exact: ess_sup_eq0. + rewrite ltNge => /negbNE mu0 _ _. + suffices mueq0: mu setT = 0 by exact: ae_eq0. + move: mu0 (measure_ge0 mu setT) => mu0 mu1. + suffices: (mu setT <= 0 <= mu setT)%E by move/le_anti. + by rewrite mu0 mu1. +by []. +Qed. + + +Lemma Lnorm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. +Proof. +have: 'N[mu]_p[f] \is a fin_num by + rewrite fin_numElt (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _))//=; exact: lfuny. +have p0 : (0 < p)%E by exact: lt_le_trans. +rewrite /nm => h /eqP. +rewrite fine_eq0//. +move/eqP. +exact: Lnorm_eq0_eq0. +Qed. -(* todo: add equivalent of mx_normZ and HB instance *) End Lspace_norm. diff --git a/theories/measure.v b/theories/measure.v index 77ca0b23b4..5da0205df8 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -4144,7 +4144,8 @@ Notation "{ 'ae' m , P }" := {near almost_everywhere m, P} : type_scope. Notation "\forall x \ae mu , P" := (\forall x \near almost_everywhere mu, P) (format "\forall x \ae mu , P", x name, P at level 200, at level 200): type_scope. -Notation ae_eq mu D f g := (\forall x \ae mu, D x -> f x = g x). +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) (format "f = g '%[ae' mu 'in' D ]", g at next level, D at level 200, at level 70). Notation "f = g %[ae mu ]" := (f = g %[ae mu in setT ]) @@ -4158,18 +4159,70 @@ move=> aP; have -> : P = setT by rewrite predeqE => t; split. by apply/negligibleP; [rewrite setCT|rewrite setCT measure0]. Qed. +Require Import -(notations) Setoid. + +Declare Scope signature_scope. +Delimit Scope signature_scope with signature. +Import -(notations) Morphisms. +Module ProperNotations. + + Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) + (right associativity, at level 55) : signature_scope. + + Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature)) + (right associativity, at level 55) : signature_scope. + + Notation " R ~~> R' " := (@respectful _ _ (Program.Basics.flip (R%signature)) (R'%signature)) + (right associativity, at level 55) : signature_scope. + +End ProperNotations. +Import ProperNotations. + +Arguments Proper {A}%_type R%_signature m. +Arguments respectful {A B}%_type (R R')%_signature _ _. + +Instance ae_eq_equiv d (T : ringOfSetsType d) R mu V D: 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 ereal_scope. -Context d (T : sigmaRingType d) (R : realType) (U V : Type). +Local Open Scope ring_scope. +Context d (T : sigmaRingType d) (R : realType). +Implicit Types (U V : Type) (W : nzRingType). Variables (mu : {measure set T -> \bar R}) (D : set T). -Local Notation ae_eq f g := (\forall x \ae mu, D x -> f x = g x). +Local Notation ae_eq := (ae_eq mu D). -Lemma ae_eq0 (f g : T -> U) : measurable D -> mu D = 0 -> f = g %[ae mu in 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. -Lemma ae_eq_comp (j : U -> V) f g : +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 apply: filterS => x /[apply] /= ->. Qed. +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^\-. @@ -4179,28 +4232,25 @@ split=> [fg|[pfg nfg]]. by near=> x => Dx; rewrite (funeposneg f) (funeposneg g) ?(near pfg, near nfg). Unshelve. all: by end_near. Qed. -Implicit Types (f g : T -> U). -Lemma ae_eq_refl f : ae_eq f f. Proof. exact/aeW. Qed. - -Lemma ae_eq_sym f g : ae_eq f g -> ae_eq g f. -Proof. by apply: filterS => x + Dx => /(_ Dx). 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 f g h : ae_eq f g -> ae_eq g h -> ae_eq f h. -Proof. by apply: filterS2 => x + + Dx => /(_ Dx) ->; exact. 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 f g h i : 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_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 f g h : ae_eq f g -> ae_eq (f \* h) (g \* h). -Proof. by apply: filterS => x /[apply] ->. 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 f g h : ae_eq f g -> ae_eq (h \* f) (h \* g). -Proof. by apply: filterS => x /[apply] ->. 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 f g : ae_eq f (cst 1) -> ae_eq g (g \* f). -Proof. by apply: filterS => x /[apply] ->; rewrite mule1. 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 : ae_eq f g -> ae_eq (abse \o f) (abse \o g). +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. End ae_eq. @@ -5346,7 +5396,7 @@ End absolute_continuity. Notation "m1 `<< m2" := (measure_dominates m1 m2). Section absolute_continuity_lemmas. -Context d (T : measurableType d) (R : realType). +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 -> From 13de29aff87c061d0dddf25168015cbe968b00d1 Mon Sep 17 00:00:00 2001 From: Cyril Cohen Date: Fri, 7 Feb 2025 17:57:47 +0100 Subject: [PATCH 07/73] compressions --- theories/lspace.v | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/theories/lspace.v b/theories/lspace.v index 7da76be76a..8d8393c89a 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -277,22 +277,17 @@ by exists r => /=; rewrite ifF//; rewrite set_itvE; rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. Qed. -Lemma Lnorm0 : 'N[mu]_p[cst 0] = 0. +Lemma Lnorm0 : 'N[mu]_p[0] = 0. Proof. -rewrite unlock /Lnorm. -move: p1. -case: p => [r||//]. -- rewrite lee_fin => r1. - have r0: r != 0 by rewrite gt_eqF// (lt_le_trans _ r1). - rewrite gt_eqF ?(lt_le_trans _ r1)//. - under eq_integral => x _ do rewrite /= normr0 powR0//. - by rewrite integral0 poweR0r// invr_neq0. -case: ifPn => //mu0 _. -rewrite (_ : normr \o _ = 0); last by apply: funext => x/=; rewrite normr0. -exact: ess_sup_cst. +rewrite unlock /Lnorm; case: p p1 => [r| |//]; last first. + case: ifPn => // *; under [_ \o _]funext do rewrite /= normr0. + exact: ess_sup_cst. +rewrite lee_fin => r1; have r0 : r != 0 by rewrite gt_eqF// (lt_le_trans _ r1). +rewrite (negPf r0) integral0_eq ?poweR0r ?invr_eq0// => *. +by rewrite normr0 powR0. Qed. -Lemma lfuny0 : finite_norm mu p (cst 0). +Lemma lfuny0 : finite_norm mu p 0. Proof. by rewrite /finite_norm Lnorm0. Qed. HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. From 9a1d651c3b6392913d3abf02da8dd57d626f8415 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Sat, 8 Feb 2025 00:28:59 +0100 Subject: [PATCH 08/73] inclusion of lp spaces - refactoring - extension to Loo - measure 0 --- .nix/config.nix | 2 +- theories/hoelder.v | 75 ++++++++++--- theories/lspace.v | 257 +++++++++++++++++++++------------------------ theories/measure.v | 49 +++++++++ 4 files changed, 231 insertions(+), 152 deletions(-) diff --git a/.nix/config.nix b/.nix/config.nix index 17704e242b..2b4ed657fa 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -69,7 +69,7 @@ in coq-elpi.override.version = "master"; coq-elpi.override.elpi-version = "2.0.7"; hierarchy-builder.override.version = "master"; - mathcomp.override.version = "CohenCyril:seminorm"; + mathcomp.override.version = "master"; mathcomp-bigenough.override.version = "master"; mathcomp-finmap.override.version = "master"; ssprove.job = false; diff --git a/theories/hoelder.v b/theories/hoelder.v index 4b0ac05b7d..1156c1521b 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -40,11 +40,11 @@ HB.lock Definition Lnorm {d} {T : measurableType d} {R : realType} (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := match p with | p%:E => (if p == 0%R then - mu (f @^-1` (setT `\ 0%R)) + (mu (f @^-1` (setT `\ 0%R))) else (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1)%E | +oo%E => (if mu [set: T] > 0 then ess_sup mu (normr \o f) else 0)%E - | -oo%E => 0%E + | -oo%E => (if mu [set: T] > 0 then ess_inf mu (normr \o f) else 0)%E end. Canonical locked_Lnorm := Unlockable Lnorm.unlock. Arguments Lnorm {d T R} mu p f. @@ -57,6 +57,20 @@ Implicit Types (p : \bar R) (f g : T -> R) (r : R). Local Notation "'N_ p [ f ]" := (Lnorm mu p f). +Lemma Lnorm0 p : 1 <= p -> 'N_p[cst 0%R] = 0. +Proof. +rewrite unlock /Lnorm. +case: p => [r||//]. +- rewrite lee_fin => r1. + have r0: r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). + rewrite gt_eqF ?(lt_le_trans _ r1)//. + under eq_integral => x _ do rewrite /= normr0 powR0//. + by rewrite integral0 poweR0r// invr_neq0. +case: ifPn => //mu0 _. +rewrite (_ : normr \o _ = 0%R); last by apply: funext => x/=; rewrite normr0. +exact: ess_sup_cst. +Qed. + Lemma Lnorm1 f : 'N_1[f] = \int[mu]_x `|f x|%:E. Proof. rewrite unlock oner_eq0 invr1// poweRe1//. @@ -74,16 +88,36 @@ Qed. Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. Proof. by move=> fg; congr Lnorm; exact/funext. Qed. -Lemma Lnorm_eq0_eq0 r f : (0 < r)%R -> measurable_fun setT f -> - 'N_r%:E[f] = 0 -> ae_eq mu [set: T] (fun t => (`|f t| `^ r)%:E) (cst 0). +Lemma Lnorm_eq0_eq0 (f : T -> R) p : + measurable_fun setT f -> (0 < p)%E -> 'N_p[f] = 0 -> f = 0%R %[ae mu]. Proof. -move=> r0 mf; rewrite unlock (gt_eqF r0) => /poweR_eq0_eq0 fp. -apply/ae_eq_integral_abs => //=. - apply: measurableT_comp => //. - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. - exact: measurableT_comp. -under eq_integral => x _ do rewrite ger0_norm ?powR_ge0//. -by rewrite fp//; apply: integral_ge0 => t _; rewrite lee_fin powR_ge0. +rewrite unlock /Lnorm => mf. +case: p => [r r0||]. +- case: ifPn => _. + rewrite preimage_setI preimage_setT setTI -preimage_setC. + move=> /poweR_eq0_eq0 /negligibleP. + move/(_ (measurableC _)); rewrite -[X in d.-measurable X]setTI. + move/(_ (mf _ _ _)). + by case=> // A [mA muA0 fA]; exists A; split => // x/= ?; exact: fA. + move=> /poweR_eq0_eq0. + move=> /(_ (integral_ge0 _ _)) h. + have: (\int[mu]_x (`|f x| `^ r)%:E)%E = 0 by apply: h => x _; rewrite lee_fin powR_ge0. + under eq_integral => x _ do rewrite -[_%:E]gee0_abs ?lee_fin ?powR_ge0//. + have mp: measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). + apply: measurableT_comp => //. + apply (measurableT_comp (measurable_powR _)) => //. + exact: measurableT_comp. + move/(ae_eq_integral_abs _ measurableT mp). + apply: filterS => x/= /[apply]. + by case=> /powR_eq0_eq0 /eqP; rewrite normr_eq0 => /eqP. +- case: ifPn => [mu0 _|]. + exact: ess_sup_eq0. + rewrite ltNge => /negbNE mu0 _ _. + suffices mueq0: mu setT = 0 by exact: ae_eq0. + move: mu0 (measure_ge0 mu setT) => mu0 mu1. + suffices: (mu setT <= 0 <= mu setT)%E by move/le_anti. + by rewrite mu0 mu1. +by []. Qed. Lemma powR_Lnorm f r : r != 0%R -> @@ -94,11 +128,11 @@ by apply: integral_ge0 => x _; rewrite lee_fin// powR_ge0. Qed. Lemma oppr_Lnorm f p : - 'N_p[-%R \o f] = 'N_p[f]. + 'N_p[\- f]%R = 'N_p[f]. Proof. rewrite unlock /Lnorm. case: p => /= [r||//]. - case: eqP => _. congr (mu _). + case: eqP => _. congr ((mu _) `^ _). rewrite !preimage_setI. congr (_ `&` _). rewrite -!preimage_setC. @@ -113,9 +147,19 @@ rewrite compA (_ : normr \o -%R = normr)//. apply: funext => x/=; exact: normrN. Qed. +Lemma Lnorm_cst1 r : ('N_r%:E[cst 1%R] = (mu setT)`^(r^-1)). +Proof. +rewrite unlock /Lnorm. +case: ifPn => [_|]. + by rewrite preimage_cst ifT// inE/=; split => //; apply/eqP; rewrite oner_neq0. +under eq_integral => x _ do rewrite normr1 powR1 (_ : 1 = cst 1 x)%R// -indicT. +by rewrite integral_indic// setTI. +Qed. + End Lnorm_properties. #[global] + Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnorm_ge0] : core. Notation "'N[ mu ]_ p [ f ]" := (Lnorm mu p f). @@ -161,11 +205,12 @@ Let hoelder0 f g p q : measurable_fun setT f -> measurable_fun setT g -> (0 < p)%R -> (0 < q)%R -> (p^-1 + q^-1 = 1)%R -> 'N_p%:E[f] = 0 -> 'N_1[(f \* g)%R] <= 'N_p%:E[f] * 'N_q%:E[g]. Proof. +rewrite -lte_fin. move=> mf mg p0 q0 pq f0; rewrite f0 mul0e Lnorm1 [leLHS](_ : _ = 0)//. rewrite (ae_eq_integral (cst 0)) => [|//||//|]; first by rewrite integral0. - by do 2 apply: measurableT_comp => //; exact: measurable_funM. -- apply: filterS (Lnorm_eq0_eq0 p0 mf f0) => x /(_ I)[] /powR_eq0_eq0 + _. - by rewrite normrM => ->; rewrite mul0r. +- apply: filterS (Lnorm_eq0_eq0 mf p0 f0) => x /(_ I)[] + _. + by rewrite normrM => ->; rewrite normr0 mul0r. Qed. Let normalized p f x := `|f x| / fine 'N_p%:E[f]. diff --git a/theories/lspace.v b/theories/lspace.v index 8d8393c89a..60a3b887c1 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -245,49 +245,7 @@ HB.instance Definition _ := [Choice of LfunType mu p1 by <:]. Import numFieldNormedType.Exports. -Lemma ess_sup_cst_lty r : (0 < mu setT)%E -> (ess_sup mu (cst r) < +oo)%E. -Proof. -rewrite /ess_sup => mu0. -under eq_set do rewrite preimage_cst/=. -rewrite ereal_inf_EFin ?ltry//. -- exists r => x/=; case: ifPn => [_|]. - by move: mu0 => /[swap] ->; rewrite ltNge lexx. - by rewrite set_itvE notin_setE//= ltNge => /negP/negbNE. -by exists r => /=; rewrite ifF//; rewrite set_itvE; - rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. -Qed. - -Lemma ess_sup_cst r : (0 < mu setT)%E -> (ess_sup mu (cst r) = r%:E)%E. -Proof. -rewrite /ess_sup => mu0. -under eq_set do rewrite preimage_cst/=. -rewrite ereal_inf_EFin. -- congr (_%:E). - rewrite [X in inf X](_ : _ = `[r, +oo[%classic); last first. - apply/seteqP; split => /=x/=. - case: ifPn => [_|]; first by move: mu0=> /[swap] ->; rewrite ltNge lexx. - by rewrite set_itvE notin_setE/= ltNge in_itv andbT/= => /negP /negPn. - rewrite in_itv/= => /andP[x0 _]. - by rewrite ifF// set_itvE; apply/negP; rewrite in_setE/= ltNge => /negP. - by rewrite inf_itv. -- exists r => x/=; case: ifPn => [_|]. - by move: mu0 => /[swap] ->; rewrite ltNge lexx. - by rewrite set_itvE notin_setE//= ltNge => /negP/negbNE. -by exists r => /=; rewrite ifF//; rewrite set_itvE; - rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. -Qed. - -Lemma Lnorm0 : 'N[mu]_p[0] = 0. -Proof. -rewrite unlock /Lnorm; case: p p1 => [r| |//]; last first. - case: ifPn => // *; under [_ \o _]funext do rewrite /= normr0. - exact: ess_sup_cst. -rewrite lee_fin => r1; have r0 : r != 0 by rewrite gt_eqF// (lt_le_trans _ r1). -rewrite (negPf r0) integral0_eq ?poweR0r ?invr_eq0// => *. -by rewrite normr0 powR0. -Qed. - -Lemma lfuny0 : finite_norm mu p 0. +Lemma lfuny0 : finite_norm mu p (cst 0). Proof. by rewrite /finite_norm Lnorm0. Qed. HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. @@ -305,8 +263,36 @@ HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) mfun_scaler_closed. HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. -Lemma LnormZ (f : LfunType mu p1) a : ('N[mu]_p[a \*: f] = `|a|%:E * 'N[mu]_p[f])%E. -Admitted. +Lemma LnormZ (f : LfunType mu p1) a : + ('N[mu]_p[a \*: f] = `|a|%:E * 'N[mu]_p[f])%E. +Proof. +rewrite unlock /Lnorm. +move: p p1 f. +case=> //[r r1 f|]. + rewrite gt_eqF ?(lt_le_trans ltr01)//. + under eq_integral => x _/= do rewrite -mulr_algl scaler1 normrM powRM ?EFinM//. + rewrite integralZl//; last first. + apply /integrableP; split. + apply: measurableT_comp => //. + rewrite (_ : (fun x : T => `|f x| `^ r) = (@powR R)^~ r \o normr \o f)//. + by repeat apply: measurableT_comp => //. + apply: (@lty_poweRy _ _ r^-1). + by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). + have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[f])%E. + rewrite unlock /Lnorm gt_eqF ?(lt_le_trans ltr01)//. + by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. + exact: (lfuny r1 f). + rewrite poweRM ?integral_ge0=> //[||x _]; rewrite ?lee_fin ?powR_ge0//. + by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. +move=> p0 f. +case: ifP => mu0. + rewrite (_ : normr \o a \*: f = (`|a|) \*: (normr \o f)); last first. + by apply: funext => x/=; rewrite normrZ. + rewrite ess_supM//. + by near=> x=> /=. +by rewrite mule0. +Unshelve. end_near. +Qed. Lemma lfun_submod_closed : submod_closed (lfun). Proof. @@ -331,6 +317,7 @@ HB.instance Definition _ := [SubChoice_isSubLmodule of LfunType mu p1 by <:]. End lfun. + Section Lspace_norm. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. @@ -341,26 +328,14 @@ Variable (p : \bar R) (p1 : (1 <= p)%E). Notation ty := (LfunType mu p1). Definition nm f := fine ('N[mu]_p[f]). - -(* HB.instance Definition _ := GRing.Zmodule.on ty. *) - -(* measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R *) - -(* Notation ty := (LfunType mu p%:E). *) -(* Definition nm (f : ty) := fine ('N[mu]_p%:E[f]). *) - -(* HB.instance Definition _ := GRing.Zmodule.on ty. *) +Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[f]. +Proof. +by rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=; exact: lfuny. +Qed. Lemma ler_Lnorm_add (f g : ty) : nm (f + g) <= nm f + nm g. -Proof. -rewrite /nm -fineD ?fine_le ?minkowskie// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. -- rewrite (le_lt_trans (minkowskie _ _ _ _))//. - by rewrite lte_add_pinfty//; exact: lfuny. -- by rewrite lte_add_pinfty//; exact: lfuny. -- by rewrite adde_ge0 ?Lnorm_ge0. -all: exact: lfuny. -Qed. +Proof. by rewrite -lee_fin EFinD !finite_norm_fine minkowskie. Qed. Lemma natmulfctE (U : pointedType) (K : ringType) (f : U -> K) n : f *+ n = (fun x => f x *+ n). @@ -374,9 +349,8 @@ Proof. by elim: n => //=[|n []->]; rewrite ?addNye; left. Qed. Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. Proof. -rewrite /nm -scaler_nat LnormZ fineM//= ?normr_nat ?mulr_natl// fin_numElt. -have := lfuny p1 f. -by rewrite /finite_norm (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _)) => ->. +apply/EFin_inj; rewrite finite_norm_fine -scaler_nat LnormZ normr_nat. +by rewrite -[in RHS]mulr_natl EFinM finite_norm_fine. Qed. @@ -389,87 +363,98 @@ HB.instance Definition _ := (* todo: add equivalent of mx_normZ and HB instance *) -Lemma ess_sup_ger f (r : R) : (forall x, f x <= r) -> (ess_sup mu f <= r%:E)%E. +Lemma nm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. Proof. -move=> fr. -rewrite /ess_sup. -apply: ereal_inf_le. -apply/exists2P. -exists r%:E => /=; split => //. -apply/exists2P. -exists r; split => //. -rewrite preimage_itvoy. -suffices -> : [set x | r < f x] = set0 by []. -apply/seteqP; split => x //=. -rewrite lt_neqAle => /andP[rneqfx rlefx]. -move: (fr x) => fxler. -have: (f x <= r <= f x) by rewrite rlefx fxler. -by move/le_anti; move: rneqfx => /[swap] -> /eqP. -Qed. - -Lemma ess_sup_eq0 (f : {mfun T >-> R}) : ess_sup mu (normr \o f) = 0 -> f = 0 %[ae mu]. -Admitted. - - -(* TODO: move to hoelder *) -Lemma Lnorm_eq0_eq0 (f : {mfun T >-> R}) : (0 < p)%E -> - 'N[mu]_p[f] = 0 -> f = 0 %[ae mu]. -Proof. -rewrite unlock /Lnorm => p0. -move: p0. -case: p => [r r0||]. -- case: ifPn => _. - rewrite preimage_setI preimage_setT setTI -preimage_setC => /negligibleP. - move/(_ (measurableC _)); rewrite -[X in d.-measurable X]setTI. - move/(_ (measurable_funP _ measurableT _ (measurable_set1 _))) => /=. - by case => A [mA muA0 fA]; exists A; split => // x/= ?; exact: fA. - move=> /poweR_eq0_eq0. - move=> /(_ (integral_ge0 _ _)) h. - have: (\int[mu]_x (`|f x| `^ r)%:E)%E = 0 by apply: h => x _; rewrite lee_fin powR_ge0. - under eq_integral => x _ do rewrite -[_%:E]gee0_abs ?lee_fin ?powR_ge0//. - have mp: measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). - apply: measurableT_comp => //. - apply (measurableT_comp (measurable_powR _)) => //. - apply: measurableT_comp => //. - move/(ae_eq_integral_abs _ measurableT mp). - apply: filterS => x/= /[apply]. - by case=> /powR_eq0_eq0 /eqP; rewrite normr_eq0 => /eqP. -- case: ifPn => [mu0 _|]. - exact: ess_sup_eq0. - rewrite ltNge => /negbNE mu0 _ _. - suffices mueq0: mu setT = 0 by exact: ae_eq0. - move: mu0 (measure_ge0 mu setT) => mu0 mu1. - suffices: (mu setT <= 0 <= mu setT)%E by move/le_anti. - by rewrite mu0 mu1. -by []. -Qed. - - -Lemma Lnorm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. -Proof. -have: 'N[mu]_p[f] \is a fin_num by - rewrite fin_numElt (lt_le_trans ltNy0 (Lnorm_ge0 _ _ _))//=; exact: lfuny. -have p0 : (0 < p)%E by exact: lt_le_trans. -rewrite /nm => h /eqP. -rewrite fine_eq0//. -move/eqP. -exact: Lnorm_eq0_eq0. +rewrite /nm=> /eqP; rewrite -eqe=> /eqP; rewrite finite_norm_fine=> /Lnorm_eq0_eq0. +by apply; rewrite ?(lt_le_trans _ p1). Qed. End Lspace_norm. -(* Section Lspace_inclusion. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. -Lemma Lspace_inclusion p q : (p <= q)%E -> - forall (f : LfunType mu q), ('N[ mu ]_p [ f ] < +oo)%E. -Proof. -move=> pleq f. +(* the following lemma is not needed, but looks useful, should we include it anyways? *) +Lemma mul_lte_pinfty (x y : \bar R) : (x \is a fin_num -> 0 < x -> x * y < +oo -> y < +oo)%E. +Proof. rewrite fin_numE => /andP[/eqP xNoo /eqP xoo]. +move: x xNoo xoo. +case => // r _ _ rgt0. +rewrite /mule. +case: y => //[r0 ?|]. + by rewrite ltry. +case: ifP => //. by move: rgt0 => /[swap] /eqP -> /eqP; rewrite ltxx. +case: ifP => //. by rewrite rgt0. +Qed. + +Local Open Scope ereal_scope. -isLfun d T R mu p f. +Lemma measure_is_zero : mu [set: T] = 0%E -> mu = mzero. +Admitted. + +Lemma Lspace_inclusion (p q : \bar R) : + forall (p1 : 1 <= p) (q1 : 1 <= q), + mu [set: T] < +oo -> p < q -> forall (f : {mfun T >-> R}), finite_norm mu q f -> finite_norm mu p f. +Proof. +have := measure_ge0 mu [set: T]; rewrite le_eqVlt => /orP[/eqP mu0 p1 q1 _ _ f _|mu_pos]. + rewrite /finite_norm unlock /Lnorm. + move: p p1; case=> //; last by rewrite -mu0 ltxx. + move=> r r1; rewrite gt_eqF ?(lt_le_trans ltr01)//. + rewrite measure_is_zero// integral_measure_zero. + by rewrite poweR0r// gt_eqF// invr_gt0 (lt_le_trans ltr01). +move: p q. +case=> //[p|]; case=> //[q|] p1 q1; last first. + have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). + move=> muoo _ f. + rewrite /finite_norm unlock /Lnorm mu_pos gt_eqF// => supf_lty. + rewrite poweR_lty// integral_fune_lt_pinfty => //. + apply: measurable_bounded_integrable => //. + rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. + apply: measurableT_comp => //=. + exact: measurableT_comp. + rewrite boundedE. + near=> A=> x/= _. + rewrite norm_powR// normr_id normr1 mulr1. + admit. +move=> mu_fin pleq f ffin. +have:= ffin; rewrite /finite_norm. +have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). +have q0 : (0 < q)%R by rewrite ?(lt_le_trans ltr01). +have qinv0 : q^-1 != 0%R by rewrite invr_neq0// gt_eqF. +pose r := q/p. +pose r' := (1 - r^-1)^-1. +have := (@hoelder _ _ _ mu (fun x => `|f x| `^ p) (cst 1)%R r r')%R. +rewrite (_ : (_ \* cst 1)%R = (fun x : T => `|f x| `^ p))%R -?fctM ?mulr1//. +rewrite Lnorm_cst1 unlock /Lnorm invr1. +rewrite !ifF; last 4 first. +- by apply/eqP => p0'; rewrite p0' ltxx in p0. +- by apply/eqP => q0'; rewrite q0' ltxx in q0. +- by rewrite /r gt_eqF// divr_gt0// (lt_le_trans ltr01). +- exact/negP/negP. +under [X in X `^ 1 <= _] eq_integral => x _ do + rewrite powRr1// norm_powR// normrE. +under [X in X`^ r^-1 * mu _ `^_]eq_integral => x _ do + rewrite /r norm_powR normrE ?powR_ge0// -powRrM mulrCA mulfV ?mulr1// ?gt_eqF//. +rewrite [X in X <= _]poweRe1; last + by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. +move=> h1 /lty_poweRy h2. +apply: poweR_lty. +apply: le_lt_trans. + apply: h1. + - rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. + apply: measurableT_comp => //=. + exact: measurableT_comp => //=. + - exact: measurable_cst. + - rewrite/r divr_gt0//. + - rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; + by rewrite /r ltr_pdivlMr// mul1r. + - by rewrite /r' /r invf_div invrK addrCA subrr addr0. +rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. + by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?poweR_lty. +rewrite poweR_lty// (lty_poweRy qinv0)//. +have:= ffin; rewrite /finite_norm unlock/Lnorm ifF//. +by apply/eqP => q0'; rewrite q0' ltxx in q0. +Admitted. End Lspace_inclusion. -*) diff --git a/theories/measure.v b/theories/measure.v index 5da0205df8..ab132fd61f 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -5413,6 +5413,10 @@ Implicit Types f : T -> R. Definition ess_sup f := ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). +Definition ess_inf f := -ess_sup (-f). + +Lemma ess_infE f : ess_inf f f = ereal_sup (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). + Lemma ess_sup_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> 0 <= ess_sup f. Proof. @@ -5421,4 +5425,49 @@ apply/negP => r0; apply/negP : rf; rewrite gt_eqF// (_ : _ @^-1` _ = setT)//. by apply/seteqP; split => // x _ /=; rewrite in_itv/= (lt_le_trans _ (f0 x)). Qed. +Lemma ess_sup_cst r : (0 < mu setT)%E -> (ess_sup (cst r) = r%:E)%E. +Proof. +rewrite /ess_sup => mu0. +under eq_set do rewrite preimage_cst/=. +rewrite ereal_inf_EFin. +- congr (_%:E). + rewrite [X in inf X](_ : _ = `[r, +oo[%classic); last first. + apply/seteqP; split => /=x/=. + case: ifPn => [_|]; first by move: mu0=> /[swap] ->; rewrite ltNge lexx. + by rewrite set_itvE notin_setE/= ltNge in_itv andbT/= => /negP /negPn. + rewrite in_itv/= => /andP[x0 _]. + by rewrite ifF// set_itvE; apply/negP; rewrite in_setE/= ltNge => /negP. + by rewrite inf_itv. +- exists r => x/=; case: ifPn => [_|]. + by move: mu0 => /[swap] ->; rewrite ltNge lexx. + by rewrite set_itvE notin_setE//= ltNge => /negP/negbNE. +by exists r => /=; rewrite ifF//; rewrite set_itvE; + rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. +Qed. + +Lemma ess_sup_ger f (r : R) : (forall x, f x <= r)%R -> (ess_sup f <= r%:E). +Proof. +move=> fr. +rewrite /ess_sup. +apply: ereal_inf_le. +apply/exists2P. +exists r%:E => /=; split => //. +apply/exists2P. +exists r; split => //. +rewrite preimage_itvoy. +suffices -> : [set x | r < f x]%R = set0 by []. +apply/seteqP; split => x //=. +rewrite lt_neqAle => /andP[rneqfx rlefx]. +move: (fr x) => fxler. +have: (f x <= r <= f x)%R by rewrite rlefx fxler. +by move/le_anti; move: rneqfx => /[swap] -> /eqP. +Qed. + +Lemma ess_sup_eq0 f : ess_sup (normr \o f) = 0 -> f = 0%R %[ae mu]. +Admitted. + +Lemma ess_supM (f : T -> R) (a : R) : (0 <= a)%R -> (\forall x \ae mu, 0 <= f x)%R -> + (ess_sup (cst a \* f)%R = a%:E * ess_sup f)%E. +Admitted. + End essential_supremum. From 40f94cd0bd1adc008e40cbcfb47be4a7143ec54d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 28 Feb 2025 12:25:30 +0900 Subject: [PATCH 09/73] make it compile on top of master - temporary admits --- experimental_reals/discrete.v | 2 +- reals/reals.v | 2 +- theories/hoelder.v | 15 ++++++++------- theories/lspace.v | 21 ++++++++++++--------- theories/measure.v | 13 ++++++++----- 5 files changed, 30 insertions(+), 23 deletions(-) diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 63ca0e73b8..412877a07b 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -4,7 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -From Corelib Require Setoid. +From Coq Require Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. diff --git a/reals/reals.v b/reals/reals.v index 601ad4fe7c..90bb30d878 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -38,7 +38,7 @@ (* *) (******************************************************************************) -From Corelib Require Import Setoid. +From Coq Require Import Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import boolp classical_sets set_interval. diff --git a/theories/hoelder.v b/theories/hoelder.v index 1156c1521b..4c3d6ed69e 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -83,7 +83,8 @@ Proof. rewrite unlock; move: p => [r/=|/=|//]. by case: ifPn => // r0; exact: poweR_ge0. by case: ifPn => // /ess_sup_ge0; apply => t/=. -Qed. +case: ifPn => // muT0. +Admitted. Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. Proof. by move=> fg; congr Lnorm; exact/funext. Qed. @@ -95,7 +96,7 @@ rewrite unlock /Lnorm => mf. case: p => [r r0||]. - case: ifPn => _. rewrite preimage_setI preimage_setT setTI -preimage_setC. - move=> /poweR_eq0_eq0 /negligibleP. +(* move=> /poweR_eq0_eq0 /negligibleP. move/(_ (measurableC _)); rewrite -[X in d.-measurable X]setTI. move/(_ (mf _ _ _)). by case=> // A [mA muA0 fA]; exists A; split => // x/= ?; exact: fA. @@ -118,7 +119,7 @@ case: p => [r r0||]. suffices: (mu setT <= 0 <= mu setT)%E by move/le_anti. by rewrite mu0 mu1. by []. -Qed. +Qed.*) Admitted. Lemma powR_Lnorm f r : r != 0%R -> 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r)%:E. @@ -132,7 +133,7 @@ Lemma oppr_Lnorm f p : Proof. rewrite unlock /Lnorm. case: p => /= [r||//]. - case: eqP => _. congr ((mu _) `^ _). + case: eqP => _. (*congr ((mu _) `^ _). rewrite !preimage_setI. congr (_ `&` _). rewrite -!preimage_setC. @@ -145,16 +146,16 @@ case: p => /= [r||//]. by under eq_integral => x _ do rewrite normrN. rewrite compA (_ : normr \o -%R = normr)//. apply: funext => x/=; exact: normrN. -Qed. +Qed.*) Admitted. Lemma Lnorm_cst1 r : ('N_r%:E[cst 1%R] = (mu setT)`^(r^-1)). Proof. rewrite unlock /Lnorm. case: ifPn => [_|]. - by rewrite preimage_cst ifT// inE/=; split => //; apply/eqP; rewrite oner_neq0. +(* by rewrite preimage_cst ifT// inE/=; split => //; apply/eqP; rewrite oner_neq0. under eq_integral => x _ do rewrite normr1 powR1 (_ : 1 = cst 1 x)%R// -indicT. by rewrite integral_indic// setTI. -Qed. +Qed.*) Admitted. End Lnorm_properties. diff --git a/theories/lspace.v b/theories/lspace.v index 60a3b887c1..8d35992abd 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -130,10 +130,13 @@ rewrite (@lty_poweRy _ _ (2^-1))//. rewrite (le_lt_trans _ (lfuny _ f))//. rewrite unlock /Lnorm ifF ?gt_eqF//. rewrite gt0_ler_poweR//. -- by rewrite in_itv/= integral_ge0// leey. +- rewrite in_itv/= leey integral_ge0// => x _. + by rewrite lee_fin. - rewrite in_itv/= leey integral_ge0// => x _. by rewrite lee_fin powR_ge0. rewrite ge0_le_integral//. +- move=> x _. + by rewrite abse_ge0. - apply: measurableT_comp => //. exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). - by move=> x _; rewrite lee_fin powR_ge0. @@ -246,7 +249,7 @@ HB.instance Definition _ := [Choice of LfunType mu p1 by <:]. Import numFieldNormedType.Exports. Lemma lfuny0 : finite_norm mu p (cst 0). -Proof. by rewrite /finite_norm Lnorm0. Qed. +Proof. by rewrite /finite_norm Lnorm0// ltry. Qed. HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. @@ -308,7 +311,8 @@ apply: (le_lt_trans (minkowskie _ _ _ _)) => //=. suff: a *: (g : T -> R) \in mfun by exact: set_mem. by rewrite rpredZ//; exact: mfunP. rewrite lte_add_pinfty//; last exact: lfuny. -by rewrite LnormZ lte_mul_pinfty//; exact: lfuny. +rewrite LnormZ lte_mul_pinfty// ?lee_fin//. +exact: lfuny. Qed. HB.instance Definition _ := GRing.isSubmodClosed.Build _ _ lfun @@ -353,13 +357,12 @@ apply/EFin_inj; rewrite finite_norm_fine -scaler_nat LnormZ normr_nat. by rewrite -[in RHS]mulr_natl EFinM finite_norm_fine. Qed. - -HB.about Num.Zmodule_isSemiNormed.Build. - (* TODO : fix the definition *) +(* waiting for MathComp 2.4.0 HB.instance Definition _ := @Num.Zmodule_isSemiNormed.Build R (LfunType mu p1) nm ler_Lnorm_add Lnorm_natmul LnormN. +*) (* todo: add equivalent of mx_normZ and HB instance *) @@ -399,10 +402,10 @@ Lemma Lspace_inclusion (p q : \bar R) : Proof. have := measure_ge0 mu [set: T]; rewrite le_eqVlt => /orP[/eqP mu0 p1 q1 _ _ f _|mu_pos]. rewrite /finite_norm unlock /Lnorm. - move: p p1; case=> //; last by rewrite -mu0 ltxx. + move: p p1; case=> //; last admit. (*by rewrite -mu0 ltxx.*) move=> r r1; rewrite gt_eqF ?(lt_le_trans ltr01)//. rewrite measure_is_zero// integral_measure_zero. - by rewrite poweR0r// gt_eqF// invr_gt0 (lt_le_trans ltr01). + by rewrite poweR0r ?ltry// gt_eqF// invr_gt0 (lt_le_trans ltr01). move: p q. case=> //[p|]; case=> //[q|] p1 q1; last first. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). @@ -451,7 +454,7 @@ apply: le_lt_trans. by rewrite /r ltr_pdivlMr// mul1r. - by rewrite /r' /r invf_div invrK addrCA subrr addr0. rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. - by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?poweR_lty. + by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?ltNyr// ?poweR_lty. rewrite poweR_lty// (lty_poweRy qinv0)//. have:= ffin; rewrite /finite_norm unlock/Lnorm ifF//. by apply/eqP => q0'; rewrite q0' ltxx in q0. diff --git a/theories/measure.v b/theories/measure.v index ab132fd61f..388a84dff0 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -4189,12 +4189,10 @@ split. - 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 : nzRingType). +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). @@ -5413,9 +5411,14 @@ Implicit Types f : T -> R. Definition ess_sup f := ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). -Definition ess_inf f := -ess_sup (-f). +Definition ess_inf f := -ess_sup (-f)%R. -Lemma ess_infE f : ess_inf f f = ereal_sup (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). +Lemma ess_infE f : + ess_inf f = ereal_sup (EFin @` [set r | mu (f @^-1` `]-oo, r[) = 0]). +Proof. +rewrite /ess_inf /ess_sup /ereal_inf oppeK; congr ereal_sup. +rewrite !image_comp. +Admitted. Lemma ess_sup_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> 0 <= ess_sup f. From 15fe9a89720facf4681b06d7be512bab30eddf41 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Fri, 28 Feb 2025 04:54:28 +0100 Subject: [PATCH 10/73] wip --- theories/measure.v | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/theories/measure.v b/theories/measure.v index 388a84dff0..438d83afb3 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -5411,14 +5411,8 @@ Implicit Types f : T -> R. Definition ess_sup f := ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). -Definition ess_inf f := -ess_sup (-f)%R. - -Lemma ess_infE f : - ess_inf f = ereal_sup (EFin @` [set r | mu (f @^-1` `]-oo, r[) = 0]). -Proof. -rewrite /ess_inf /ess_sup /ereal_inf oppeK; congr ereal_sup. -rewrite !image_comp. -Admitted. +Definition ess_inf f := + ereal_sup (EFin @` [set r | mu (f @^-1` `]-oo, r[) = 0]). Lemma ess_sup_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> 0 <= ess_sup f. From 35e6b2e1bc39802ca9378c7170ff32afcb24450f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 2 Mar 2025 00:17:16 +0900 Subject: [PATCH 11/73] proved one property of ess_sup --- theories/hoelder.v | 102 ++++++---------- theories/lspace.v | 156 ++++++++++++------------ theories/measurable_realfun.v | 93 ++++++++++++++ theories/measure.v | 76 +++++------- theories/topology_theory/nat_topology.v | 13 +- 5 files changed, 245 insertions(+), 195 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 4c3d6ed69e..27065241bf 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -36,18 +36,18 @@ Reserved Notation "'N_ p [ F ]" Declare Scope Lnorm_scope. +Local Open Scope ereal_scope. HB.lock Definition Lnorm {d} {T : measurableType d} {R : realType} (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := match p with - | p%:E => (if p == 0%R then - (mu (f @^-1` (setT `\ 0%R))) - else - (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1)%E - | +oo%E => (if mu [set: T] > 0 then ess_sup mu (normr \o f) else 0)%E - | -oo%E => (if mu [set: T] > 0 then ess_inf mu (normr \o f) else 0)%E + | p%:E => (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1 + (* (mu (f @^-1` (setT `\ 0%R))) when p = 0? *) + | +oo%E => if mu [set: T] > 0 then ess_sup mu (normr \o f) else 0 + | -oo%E => if mu [set: T] > 0 then ess_inf mu (normr \o f) else 0 end. Canonical locked_Lnorm := Unlockable Lnorm.unlock. Arguments Lnorm {d T R} mu p f. +Local Close Scope ereal_scope. Section Lnorm_properties. Context d {T : measurableType d} {R : realType}. @@ -62,8 +62,7 @@ Proof. rewrite unlock /Lnorm. case: p => [r||//]. - rewrite lee_fin => r1. - have r0: r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). - rewrite gt_eqF ?(lt_le_trans _ r1)//. + have r0 : r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). under eq_integral => x _ do rewrite /= normr0 powR0//. by rewrite integral0 poweR0r// invr_neq0. case: ifPn => //mu0 _. @@ -73,18 +72,17 @@ Qed. Lemma Lnorm1 f : 'N_1[f] = \int[mu]_x `|f x|%:E. Proof. -rewrite unlock oner_eq0 invr1// poweRe1//. +rewrite unlock invr1// poweRe1//. by apply: eq_integral => t _; rewrite powRr1. by apply: integral_ge0 => t _; rewrite powRr1. Qed. Lemma Lnorm_ge0 p f : 0 <= 'N_p[f]. Proof. -rewrite unlock; move: p => [r/=|/=|//]. - by case: ifPn => // r0; exact: poweR_ge0. -by case: ifPn => // /ess_sup_ge0; apply => t/=. -case: ifPn => // muT0. -Admitted. +rewrite unlock; move: p => [r/=|/=|//]; first exact: poweR_ge0. +- by case: ifPn => // /ess_sup_ger; apply => t/=. +- by case: ifPn => // muT0; apply: ess_inf_ge0 => //=. +Qed. Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. Proof. by move=> fg; congr Lnorm; exact/funext. Qed. @@ -93,69 +91,47 @@ Lemma Lnorm_eq0_eq0 (f : T -> R) p : measurable_fun setT f -> (0 < p)%E -> 'N_p[f] = 0 -> f = 0%R %[ae mu]. Proof. rewrite unlock /Lnorm => mf. -case: p => [r r0||]. -- case: ifPn => _. - rewrite preimage_setI preimage_setT setTI -preimage_setC. -(* move=> /poweR_eq0_eq0 /negligibleP. - move/(_ (measurableC _)); rewrite -[X in d.-measurable X]setTI. - move/(_ (mf _ _ _)). - by case=> // A [mA muA0 fA]; exists A; split => // x/= ?; exact: fA. - move=> /poweR_eq0_eq0. - move=> /(_ (integral_ge0 _ _)) h. - have: (\int[mu]_x (`|f x| `^ r)%:E)%E = 0 by apply: h => x _; rewrite lee_fin powR_ge0. +case: p => [r||//]. +- rewrite lte_fin => r0 /poweR_eq0_eq0 => /(_ (integral_ge0 _ _)) h. + have : \int[mu]_x (`|f x| `^ r)%:E = 0. + by apply: h => x _; rewrite lee_fin powR_ge0. under eq_integral => x _ do rewrite -[_%:E]gee0_abs ?lee_fin ?powR_ge0//. - have mp: measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). + have mp : measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). apply: measurableT_comp => //. apply (measurableT_comp (measurable_powR _)) => //. exact: measurableT_comp. move/(ae_eq_integral_abs _ measurableT mp). apply: filterS => x/= /[apply]. by case=> /powR_eq0_eq0 /eqP; rewrite normr_eq0 => /eqP. -- case: ifPn => [mu0 _|]. - exact: ess_sup_eq0. +- case: ifPn => [mu0 _|]; first exact: ess_sup_eq0_ae. rewrite ltNge => /negbNE mu0 _ _. suffices mueq0: mu setT = 0 by exact: ae_eq0. - move: mu0 (measure_ge0 mu setT) => mu0 mu1. - suffices: (mu setT <= 0 <= mu setT)%E by move/le_anti. - by rewrite mu0 mu1. -by []. -Qed.*) Admitted. + by apply/eqP; rewrite eq_le mu0/=. +Qed. Lemma powR_Lnorm f r : r != 0%R -> 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r)%:E. Proof. -move=> r0; rewrite unlock (negbTE r0) -poweRrM mulVf// poweRe1//. +move=> r0; rewrite unlock -poweRrM mulVf// poweRe1//. by apply: integral_ge0 => x _; rewrite lee_fin// powR_ge0. Qed. -Lemma oppr_Lnorm f p : - 'N_p[\- f]%R = 'N_p[f]. +Lemma oppr_Lnorm f p : 'N_p[\- f]%R = 'N_p[f]. Proof. -rewrite unlock /Lnorm. -case: p => /= [r||//]. - case: eqP => _. (*congr ((mu _) `^ _). - rewrite !preimage_setI. - congr (_ `&` _). - rewrite -!preimage_setC. - congr (~` _). - rewrite /preimage. - apply: funext => x/=. - rewrite -{1}oppr0. - apply: propext. split; last by move=> ->. - by move/oppr_inj. - by under eq_integral => x _ do rewrite normrN. -rewrite compA (_ : normr \o -%R = normr)//. -apply: funext => x/=; exact: normrN. -Qed.*) Admitted. +rewrite unlock /Lnorm; case: p => /= [r||//]. +- by under eq_integral => x _ do rewrite normrN. +- rewrite compA (_ : normr \o -%R = normr)//. + by apply: funext => x/=; exact: normrN. +- rewrite compA (_ : normr \o -%R = normr)//. + by apply: funext => x/=; exact: normrN. +Qed. Lemma Lnorm_cst1 r : ('N_r%:E[cst 1%R] = (mu setT)`^(r^-1)). Proof. rewrite unlock /Lnorm. -case: ifPn => [_|]. -(* by rewrite preimage_cst ifT// inE/=; split => //; apply/eqP; rewrite oner_neq0. under eq_integral => x _ do rewrite normr1 powR1 (_ : 1 = cst 1 x)%R// -indicT. by rewrite integral_indic// setTI. -Qed.*) Admitted. +Qed. End Lnorm_properties. @@ -173,7 +149,7 @@ Local Notation "'N_ p [ f ]" := (Lnorm counting p f). Lemma Lnorm_counting p (f : R^nat) : (0 < p)%R -> 'N_p%:E [f] = (\sum_(k p0; rewrite unlock gt_eqF// ge0_integral_count. Qed. +Proof. by move=> p0; rewrite unlock ge0_integral_count. Qed. End lnorm. @@ -198,7 +174,7 @@ move=> p0 mf foo; apply/integrableP; split. exact: measurableT_comp. rewrite ltey; apply: contra foo. move=> /eqP/(@eqy_poweR _ _ p^-1); rewrite invr_gt0 => /(_ p0) <-. -rewrite unlock (gt_eqF p0); apply/eqP; congr (_ `^ _). +rewrite unlock; apply/eqP; congr (_ `^ _). by apply/eq_integral => t _; rewrite [RHS]gee0_abs// lee_fin powR_ge0. Qed. @@ -234,10 +210,10 @@ transitivity (\int[mu]_x (`|f x| `^ p / fine ('N_p%:E[f] `^ p))%:E). rewrite -[in LHS]powR_inv1; last by rewrite fine_ge0 // Lnorm_ge0. by rewrite fine_poweR powRAC -powR_inv1 // powR_ge0. have fp0 : 0 < \int[mu]_x (`|f x| `^ p)%:E. - rewrite unlock (gt_eqF p0) in fpos. + rewrite unlock in fpos. apply: gt0_poweR fpos; rewrite ?invr_gt0//. by apply integral_ge0 => x _; rewrite lee_fin; exact: powR_ge0. -rewrite unlock (gt_eqF p0) -poweRrM mulVf ?(gt_eqF p0)// (poweRe1 (ltW fp0))//. +rewrite unlock -poweRrM mulVf ?(gt_eqF p0)// (poweRe1 (ltW fp0))//. under eq_integral do rewrite EFinM muleC. have foo : \int[mu]_x (`|f x| `^ p)%:E < +oo. move/integrableP: ifp => -[_]. @@ -445,7 +421,7 @@ have h x : (`| f x + g x | `^ p <= rewrite !normrM (@ger0_norm _ 2)// !mulrA mulVf// !mul1r => /le_trans; apply. rewrite !powRM// !mulrA -powR_inv1// -powRD ?pnatr_eq0 ?implybT//. by rewrite (addrC _ p) -mulrDr. -rewrite unlock (gt_eqF (lt_le_trans _ p1))// poweR_lty//. +rewrite unlock poweR_lty//. pose x := \int[mu]_x (2 `^ (p - 1) * (`|f x| `^ p + `|g x| `^ p))%:E. apply: (@le_lt_trans _ _ x). rewrite ge0_le_integral//=. @@ -524,7 +500,7 @@ rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * rewrite Lnorm1; apply: eq_integral => x _. by rewrite normrM (ger0_norm (powR_ge0 _ _)). rewrite [X in _ * X](_ : _ = 'N_(p / (p - 1))%:E[h]); last first. - rewrite unlock mulf_eq0 gt_eqF//= invr_eq0 subr_eq0 (gt_eqF p1). + rewrite unlock. rewrite onemV ?gt_eqF// invf_div; apply: congr2; last by []. apply: eq_integral => x _; congr EFin. rewrite norm_powR// normr_id -powRrM mulrCA divff ?mulr1//. @@ -538,8 +514,8 @@ rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * rewrite Lnorm1; apply: eq_integral => x _ . by rewrite normrM norm_powR// normr_id. rewrite [X in _ * X](_ : _ = 'N_((1 - p^-1)^-1)%:E[h])//; last first. - rewrite unlock invrK invr_eq0 subr_eq0 eq_sym invr_eq1 (gt_eqF p1). - apply: congr2; last by []. + rewrite unlock. + apply: congr2; last by rewrite invrK. apply: eq_integral => x _; congr EFin. rewrite -/(onem p^-1) onemV ?gt_eqF// norm_powR// normr_id -powRrM. by rewrite invf_div mulrCA divff ?subr_eq0 ?gt_eqF// ?mulr1. @@ -552,7 +528,7 @@ under [X in X * _]eq_integral=> x _ do rewrite mulr_powRB1 ?subr_gt0//. rewrite poweRD; last by rewrite poweRD_defE gt_eqF ?implyFb// subr_gt0 invf_lt1. rewrite poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. congr (_ * _); rewrite poweRN. -- by rewrite unlock gt_eqF// fine_poweR. +- by rewrite unlock fine_poweR. - by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. Qed. diff --git a/theories/lspace.v b/theories/lspace.v index 8d35992abd..a2811f1bc2 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -1,11 +1,11 @@ (* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. From mathcomp Require Import all_ssreflect. From mathcomp Require Import ssralg ssrnum ssrint interval finmap. -From mathcomp Require Import boolp reals ereal. -From HB Require Import structures. -From mathcomp Require Import classical_sets signed functions topology normedtype cardinality. -From mathcomp Require Import sequences esum measure numfun lebesgue_measure lebesgue_integral. -From mathcomp Require Import exp hoelder. +From mathcomp Require Import boolp classical_sets interval_inference reals. +From mathcomp Require Import functions cardinality topology normedtype ereal. +From mathcomp Require Import sequences esum exp measure numfun lebesgue_measure. +From mathcomp Require Import lebesgue_integral hoelder. (******************************************************************************) (* *) @@ -106,12 +106,13 @@ Variable mu : {measure set T -> \bar R}. Definition Lspace p (p1 : (1 <= p)%E) := [set: LType mu p1]. Arguments Lspace : clear implicits. -Lemma LType1_integrable (f : LType mu (@lexx _ _ 1%E)) : mu.-integrable setT (EFin \o f). +Lemma LType1_integrable (f : LType mu (@lexx _ _ 1%E)) : + mu.-integrable setT (EFin \o f). Proof. -apply/integrableP; split; first exact/EFin_measurable_fun. +apply/integrableP; split; first exact/measurable_EFinP. have := lfuny _ f. -rewrite /finite_norm unlock /Lnorm ifF ?oner_eq0// invr1 poweRe1; last first. - by apply integral_ge0 => x _; rewrite lee_fin powRr1//. +rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. + by apply integral_ge0 => x _; rewrite lee_fin powRr1. by under eq_integral => i _ do rewrite powRr1//. Qed. @@ -125,23 +126,21 @@ Lemma LType2_integrable_sqr (f : LType mu le12) : mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). Proof. apply/integrableP; split. - exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). -rewrite (@lty_poweRy _ _ (2^-1))//. + apply/measurable_EFinP. + exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). +rewrite (@lty_poweRy _ _ 2^-1)//. rewrite (le_lt_trans _ (lfuny _ f))//. -rewrite unlock /Lnorm ifF ?gt_eqF//. +rewrite unlock. rewrite gt0_ler_poweR//. -- rewrite in_itv/= leey integral_ge0// => x _. - by rewrite lee_fin. -- rewrite in_itv/= leey integral_ge0// => x _. - by rewrite lee_fin powR_ge0. -rewrite ge0_le_integral//. -- move=> x _. - by rewrite abse_ge0. -- apply: measurableT_comp => //. - exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). -- by move=> x _; rewrite lee_fin powR_ge0. -- exact/EFin_measurable_fun/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R)/measurableT_comp. -- by move=> t _/=; rewrite lee_fin normrX powR_mulrn. +- by rewrite in_itv/= leey integral_ge0. +- by rewrite in_itv/= leey integral_ge0. +- rewrite ge0_le_integral//. + + apply: measurableT_comp => //; apply/measurable_EFinP. + exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). + + apply/measurable_EFinP. + apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. + exact/measurableT_comp. + + by move=> t _/=; rewrite lee_fin normrX powR_mulrn. Qed. End Lspace. @@ -196,17 +195,15 @@ Lemma sub_lfun_mfun : {subset lfun <= mfun}. Proof. by move=> x /andP[]. Qed. Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. Proof. by move=> x /andP[]. Qed. End lfun_pred. - -Lemma minkowskie : -forall [d : measure_display] [T : measurableType d] [R : realType] - (mu : measure T R) [f g : T -> R] [p : \bar R], -measurable_fun [set: T] f -> -measurable_fun [set: T] g -> -(1 <= p)%E -> ('N[mu]_p[(f \+ g)%R] <= 'N[mu]_p[f] + 'N[mu]_p[g])%E. +Lemma minkowskie [d : measure_display] [T : measurableType d] [R : realType] + (mu : measure T R) [f g : T -> R] [p : \bar R] : + measurable_fun [set: T] f -> + measurable_fun [set: T] g -> + (1 <= p)%E -> ('N[mu]_p[(f \+ g)%R] <= 'N[mu]_p[f] + 'N[mu]_p[g])%E. +Proof. (* TODO: Jairo is working on this *) Admitted. - Section lfun. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). @@ -272,8 +269,7 @@ Proof. rewrite unlock /Lnorm. move: p p1 f. case=> //[r r1 f|]. - rewrite gt_eqF ?(lt_le_trans ltr01)//. - under eq_integral => x _/= do rewrite -mulr_algl scaler1 normrM powRM ?EFinM//. +- under eq_integral => x _/= do rewrite -mulr_algl scaler1 normrM powRM ?EFinM//. rewrite integralZl//; last first. apply /integrableP; split. apply: measurableT_comp => //. @@ -282,20 +278,19 @@ case=> //[r r1 f|]. apply: (@lty_poweRy _ _ r^-1). by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[f])%E. - rewrite unlock /Lnorm gt_eqF ?(lt_le_trans ltr01)//. + rewrite unlock /Lnorm. by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. exact: (lfuny r1 f). - rewrite poweRM ?integral_ge0=> //[||x _]; rewrite ?lee_fin ?powR_ge0//. + rewrite poweRM ?integral_ge0=> //; rewrite ?lee_fin ?powR_ge0//. by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. -move=> p0 f. -case: ifP => mu0. - rewrite (_ : normr \o a \*: f = (`|a|) \*: (normr \o f)); last first. - by apply: funext => x/=; rewrite normrZ. - rewrite ess_supM//. - by near=> x=> /=. -by rewrite mule0. -Unshelve. end_near. -Qed. +- move=> p0 f. + case: ifP => mu0. + rewrite (_ : normr \o a \*: f = (`|a|) \*: (normr \o f)); last first. + by apply: funext => x/=; rewrite normrZ. + rewrite ess_supMr//. + by near=> x=> /=. + by rewrite mule0. +Unshelve. end_near. Qed. Lemma lfun_submod_closed : submod_closed (lfun). Proof. @@ -321,7 +316,6 @@ HB.instance Definition _ := [SubChoice_isSubLmodule of LfunType mu p1 by <:]. End lfun. - Section Lspace_norm. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. @@ -333,8 +327,9 @@ Notation ty := (LfunType mu p1). Definition nm f := fine ('N[mu]_p[f]). Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[f]. -Proof. -by rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=; exact: lfuny. +Proof. +rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. +exact: lfuny. Qed. Lemma ler_Lnorm_add (f g : ty) : @@ -348,7 +343,8 @@ Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. Lemma LnormN (f : ty) : nm (\-f) = nm f. Proof. by rewrite /nm oppr_Lnorm. Qed. -Lemma enatmul_ninfty (n : nat) : (-oo *+ n.+1 = -oo :> \bar R)%E \/ (-oo *+ n.+1 = +oo :> \bar R)%E. +Lemma enatmul_ninfty (n : nat) : + (-oo *+ n.+1 = -oo :> \bar R)%E \/ (-oo *+ n.+1 = +oo :> \bar R)%E. Proof. by elim: n => //=[|n []->]; rewrite ?addNye; left. Qed. Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. @@ -372,7 +368,6 @@ rewrite /nm=> /eqP; rewrite -eqe=> /eqP; rewrite finite_norm_fine=> /Lnorm_eq0_e by apply; rewrite ?(lt_le_trans _ p1). Qed. - End Lspace_norm. Section Lspace_inclusion. @@ -380,37 +375,42 @@ Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. (* the following lemma is not needed, but looks useful, should we include it anyways? *) -Lemma mul_lte_pinfty (x y : \bar R) : (x \is a fin_num -> 0 < x -> x * y < +oo -> y < +oo)%E. -Proof. rewrite fin_numE => /andP[/eqP xNoo /eqP xoo]. +Lemma mul_lte_pinfty (x y : \bar R) : + (x \is a fin_num -> 0 < x -> x * y < +oo -> y < +oo)%E. +Proof. +rewrite fin_numE => /andP[/eqP xNoo /eqP xoo]. move: x xNoo xoo. -case => // r _ _ rgt0. +case => // r _ _; rewrite lte_fin => r0. rewrite /mule. -case: y => //[r0 ?|]. - by rewrite ltry. -case: ifP => //. by move: rgt0 => /[swap] /eqP -> /eqP; rewrite ltxx. -case: ifP => //. by rewrite rgt0. +case: y => //[s|]. + by rewrite !ltry. +by rewrite eqe gt_eqF// lte_fin r0. Qed. Local Open Scope ereal_scope. Lemma measure_is_zero : mu [set: T] = 0%E -> mu = mzero. +Proof. +move=> mu0. Admitted. Lemma Lspace_inclusion (p q : \bar R) : forall (p1 : 1 <= p) (q1 : 1 <= q), - mu [set: T] < +oo -> p < q -> forall (f : {mfun T >-> R}), finite_norm mu q f -> finite_norm mu p f. + mu [set: T] < +oo -> p < q -> + forall f : {mfun T >-> R}, finite_norm mu q f -> finite_norm mu p f. Proof. -have := measure_ge0 mu [set: T]; rewrite le_eqVlt => /orP[/eqP mu0 p1 q1 _ _ f _|mu_pos]. +have := measure_ge0 mu [set: T]. +rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. rewrite /finite_norm unlock /Lnorm. - move: p p1; case=> //; last admit. (*by rewrite -mu0 ltxx.*) - move=> r r1; rewrite gt_eqF ?(lt_le_trans ltr01)//. + move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. + move=> r r1. rewrite measure_is_zero// integral_measure_zero. by rewrite poweR0r ?ltry// gt_eqF// invr_gt0 (lt_le_trans ltr01). move: p q. case=> //[p|]; case=> //[q|] p1 q1; last first. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). move=> muoo _ f. - rewrite /finite_norm unlock /Lnorm mu_pos gt_eqF// => supf_lty. + rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. rewrite poweR_lty// integral_fune_lt_pinfty => //. apply: measurable_bounded_integrable => //. rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. @@ -430,11 +430,19 @@ pose r' := (1 - r^-1)^-1. have := (@hoelder _ _ _ mu (fun x => `|f x| `^ p) (cst 1)%R r r')%R. rewrite (_ : (_ \* cst 1)%R = (fun x : T => `|f x| `^ p))%R -?fctM ?mulr1//. rewrite Lnorm_cst1 unlock /Lnorm invr1. -rewrite !ifF; last 4 first. -- by apply/eqP => p0'; rewrite p0' ltxx in p0. -- by apply/eqP => q0'; rewrite q0' ltxx in q0. -- by rewrite /r gt_eqF// divr_gt0// (lt_le_trans ltr01). -- exact/negP/negP. +have mfp : measurable_fun [set: T] (fun x : T => (`|f x| `^ p)%R). + rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. + apply: measurableT_comp => //=. + exact: measurableT_comp => //=. +have m1 : measurable_fun [set: T] (@cst _ R 1%R). + exact: measurable_cst. +have r0 : (0 < r)%R by rewrite/r divr_gt0. +have r'0 : (0 < r')%R. + by rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; + rewrite /r ltr_pdivlMr// mul1r. +have rr'1 : r^-1 + r'^-1 = 1%R. + by rewrite /r' /r invf_div invrK addrCA subrr addr0. +move=> /(_ mfp m1 r0 r'0 rr'1). under [X in X `^ 1 <= _] eq_integral => x _ do rewrite powRr1// norm_powR// normrE. under [X in X`^ r^-1 * mu _ `^_]eq_integral => x _ do @@ -443,21 +451,11 @@ rewrite [X in X <= _]poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. move=> h1 /lty_poweRy h2. apply: poweR_lty. -apply: le_lt_trans. - apply: h1. - - rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. - apply: measurableT_comp => //=. - exact: measurableT_comp => //=. - - exact: measurable_cst. - - rewrite/r divr_gt0//. - - rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; - by rewrite /r ltr_pdivlMr// mul1r. - - by rewrite /r' /r invf_div invrK addrCA subrr addr0. +apply: (le_lt_trans h1). rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?ltNyr// ?poweR_lty. rewrite poweR_lty// (lty_poweRy qinv0)//. -have:= ffin; rewrite /finite_norm unlock/Lnorm ifF//. -by apply/eqP => q0'; rewrite q0' ltxx in q0. +by have:= ffin; rewrite /finite_norm unlock /Lnorm. Admitted. End Lspace_inclusion. diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 5bf2ac0ead..0c4702f6dc 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -1598,6 +1598,99 @@ Qed. End open_itv_cover. +Section essential_supremum. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types f : T -> R. +Local Open Scope ereal_scope. + +Lemma ess_sup_max f : measurable_fun setT f -> + ess_sup mu (normr \o f) != -oo -> + mu [set r | ess_sup mu (normr \o f) < `|f r|%:E] = 0. +Proof. +move=> mf fNy. +move hm : (ess_sup mu (normr \o f)) => m. +case: m hm => [m| |] hm. +- pose x_ n := m%:E + n.+1%:R^-1%:E. + have -> : [set r | m%:E < `|f r|%:E] = \bigcup_n [set r | x_ n < `|f r|%:E]. + apply/seteqP; split => [r /= mfr|r/=]. + near \oo => n. + suff : x_ n < `|f r|%:E by move=> ?; exists n. + rewrite /x_ -EFinD lte_fin -ltrBrDl. + rewrite invf_plt ?posrE//; last by rewrite subr_gt0 -lte_fin. + by rewrite -natr1 -ltrBlDr; near: n; exact: nbhs_infty_gtr. + by move=> [n _/=]; apply: le_lt_trans;rewrite /x_ -EFinD lee_fin lerDl. + have H n : mu [set r | x_ n < `|f r|%:E] = 0%R. + have : ess_sup mu (normr \o f) \is a fin_num by rewrite hm. + move/lb_ereal_inf_adherent => /(_ n.+1%:R^-1). + rewrite invr_gt0// ltr0n => /(_ erefl)[_ /= [r/= mufr0] <-]. + rewrite -/(ess_sup mu _) hm /x_ => rmn. + apply/eqP; rewrite eq_le measure_ge0 andbT. + rewrite -mufr0 le_measure// ?inE//. + + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. + + rewrite (_ : _ @^-1` _ = [set t | r%:E < `|f t|%:E]); last first. + by apply/seteqP; split => [x|x]/=; rewrite in_itv/= andbT. + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. + + move=> x/=; rewrite in_itv/= andbT. + rewrite -EFinD lte_fin; apply/le_lt_trans. + by move: rmn; rewrite -EFinD lte_fin => /ltW. + apply/eqP; rewrite eq_le measure_ge0 andbT. + have <- : \sum_(0 <= i [i|]. + + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. + + apply: bigcup_measurable => i _. + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. +- rewrite (_ : [set r | +oo < `|f r|%:E] = set0)// -subset0 => x/=. + by rewrite ltNge leey. +- by rewrite hm in fNy. +Unshelve. all: by end_near. Qed. + +Lemma ess_sup_eq0 f : measurable_fun setT f -> + f = 0%R %[ae mu] <-> mu [set r | (0%R < `|f r|)%R] = 0. +Proof. +move=> mf; split=> [|f0]. +- case => N [mN N0 fN]. + apply/eqP; rewrite eq_le measure_ge0 andbT -N0. + rewrite le_measure ?inE//. + rewrite [X in measurable X](_ : _ = [set t | 0 < `|f t|%:E]); last first. + by apply/seteqP; split => [x|x]/=; rewrite lte_fin. + rewrite -[X in measurable X]setTI. + apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. + apply: subset_trans fN => t/= ft0. + apply/not_implyP; split => //. + apply/eqP. + by rewrite -normr_eq0 gt_eqF. +- exists [set r | (0 < `|f r|)%R]; split => //. + rewrite [X in measurable X](_ : _ = [set t | 0 < `|f t|%:E]); last first. + by apply/seteqP; split => [x|x]/=; rewrite lte_fin. + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. + move=> t/= /not_implyP[_ /eqP]; rewrite -normr_eq0 => ft0. + by rewrite lt_neqAle eq_sym ft0/=. +Qed. + +Lemma ess_sup_eq0_ae f : measurable_fun setT f -> + ess_sup mu (normr \o f) = 0 -> f = 0%R %[ae mu]. +Proof. +move=> mf f0; apply/ess_sup_eq0 => //. +rewrite [X in mu X](_ : _ = [set r | (0 < `|f r|%:E)%E]); last first. + by apply/seteqP; split => [x|x]/=; rewrite lte_fin. +by rewrite -f0 ess_sup_max// f0. +Qed. + +Lemma ess_supMr f (r : R) : (0 <= r)%R -> (\forall x \ae mu, 0 <= f x)%R -> + ess_sup mu (cst r \* f)%R = r%:E * ess_sup mu f. +Proof. +Admitted. + +End essential_supremum. + Section egorov. Context d {R : realType} {T : measurableType d}. Context (mu : {measure set T -> \bar R}). diff --git a/theories/measure.v b/theories/measure.v index 438d83afb3..c92c09bd5b 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -275,6 +275,7 @@ From mathcomp Require Import sequences esum numfun. (* 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 *) +(* ess_inf f == essential infimum *) (* ``` *) (* *) (******************************************************************************) @@ -5411,60 +5412,39 @@ Implicit Types f : T -> R. Definition ess_sup f := ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). -Definition ess_inf f := - ereal_sup (EFin @` [set r | mu (f @^-1` `]-oo, r[) = 0]). - -Lemma ess_sup_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> - 0 <= ess_sup f. +Lemma ess_sup_ger f x : 0 < mu [set: T] -> (forall t, x <= f t)%R -> + x%:E <= ess_sup f. Proof. move=> muT f0; apply: lb_ereal_inf => _ /= [r /eqP rf <-]; rewrite leNgt. apply/negP => r0; apply/negP : rf; rewrite gt_eqF// (_ : _ @^-1` _ = setT)//. -by apply/seteqP; split => // x _ /=; rewrite in_itv/= (lt_le_trans _ (f0 x)). +by apply/seteqP; split => // t _ /=; rewrite in_itv/= (lt_le_trans _ (f0 t)). +Qed. + +Lemma ess_sup_ler f (r : R) : (forall x, f x <= r)%R -> ess_sup f <= r%:E. +Proof. +move=> fr; apply: ereal_inf_le; apply/exists2P. +exists r%:E => /=; split => //; apply/exists2P; exists r; split => //. +rewrite preimage_itvoy [X in mu X](_ : _ = set0)// -subset0 => x //=. +rewrite lt_neqAle => /andP[+ rlefx]. +by apply/negP/negPn; rewrite eq_le rlefx fr. Qed. Lemma ess_sup_cst r : (0 < mu setT)%E -> (ess_sup (cst r) = r%:E)%E. Proof. -rewrite /ess_sup => mu0. -under eq_set do rewrite preimage_cst/=. -rewrite ereal_inf_EFin. -- congr (_%:E). - rewrite [X in inf X](_ : _ = `[r, +oo[%classic); last first. - apply/seteqP; split => /=x/=. - case: ifPn => [_|]; first by move: mu0=> /[swap] ->; rewrite ltNge lexx. - by rewrite set_itvE notin_setE/= ltNge in_itv andbT/= => /negP /negPn. - rewrite in_itv/= => /andP[x0 _]. - by rewrite ifF// set_itvE; apply/negP; rewrite in_setE/= ltNge => /negP. - by rewrite inf_itv. -- exists r => x/=; case: ifPn => [_|]. - by move: mu0 => /[swap] ->; rewrite ltNge lexx. - by rewrite set_itvE notin_setE//= ltNge => /negP/negbNE. -by exists r => /=; rewrite ifF//; rewrite set_itvE; - rewrite memNset //=; apply/negP; rewrite -real_leNgt ?num_real. -Qed. - -Lemma ess_sup_ger f (r : R) : (forall x, f x <= r)%R -> (ess_sup f <= r%:E). -Proof. -move=> fr. -rewrite /ess_sup. -apply: ereal_inf_le. -apply/exists2P. -exists r%:E => /=; split => //. -apply/exists2P. -exists r; split => //. -rewrite preimage_itvoy. -suffices -> : [set x | r < f x]%R = set0 by []. -apply/seteqP; split => x //=. -rewrite lt_neqAle => /andP[rneqfx rlefx]. -move: (fr x) => fxler. -have: (f x <= r <= f x)%R by rewrite rlefx fxler. -by move/le_anti; move: rneqfx => /[swap] -> /eqP. -Qed. - -Lemma ess_sup_eq0 f : ess_sup (normr \o f) = 0 -> f = 0%R %[ae mu]. -Admitted. - -Lemma ess_supM (f : T -> R) (a : R) : (0 <= a)%R -> (\forall x \ae mu, 0 <= f x)%R -> - (ess_sup (cst a \* f)%R = a%:E * ess_sup f)%E. -Admitted. +move => mu0. +by apply/eqP; rewrite eq_le; apply/andP; split; + [exact: ess_sup_ler|exact: ess_sup_ger]. +Qed. + +Definition ess_inf f := + ereal_sup (EFin @` [set r | mu (f @^-1` `]-oo, r[) = 0]). + +Lemma ess_inf_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> + 0 <= ess_inf f. +Proof. +move=> muT f0; apply: ereal_sup_le; exists 0 => //=; exists 0%R => //=. +rewrite [X in mu X](_ : _ = set0)// -subset0 => x/=. +by rewrite in_itv/= ltNge => /negP; exact. +Qed. End essential_supremum. diff --git a/theories/topology_theory/nat_topology.v b/theories/topology_theory/nat_topology.v index 79bc3a1b39..82c92c7270 100644 --- a/theories/topology_theory/nat_topology.v +++ b/theories/topology_theory/nat_topology.v @@ -38,7 +38,7 @@ Qed. HB.instance Definition _ := Order_isNbhs.Build _ nat nat_nbhs_itv. HB.instance Definition _ := DiscreteUniform_ofNbhs.Build nat. -HB.instance Definition _ {R : numDomainType} := +HB.instance Definition _ {R : numDomainType} := @DiscretePseudoMetric_ofUniform.Build R nat. Lemma nbhs_infty_gt N : \forall n \near \oo, (N < n)%N. @@ -48,13 +48,16 @@ Proof. by exists N.+1. Qed. Lemma nbhs_infty_ge N : \forall n \near \oo, (N <= n)%N. Proof. by exists N. Qed. -Lemma nbhs_infty_ger {R : realType} (r : R) : - \forall n \near \oo, (r <= n%:R)%R. +Lemma nbhs_infty_gtr {R : realType} (r : R) : \forall n \near \oo, r < n%:R. Proof. -exists `|Num.ceil r|%N => // n /=; rewrite -(ler_nat R); apply: le_trans. -by rewrite (le_trans (ceil_ge _))// natr_absz ler_int ler_norm. +exists `|Num.ceil r|.+1%N => // n /=; rewrite -(ler_nat R); apply: lt_le_trans. +rewrite (le_lt_trans (ceil_ge _))// -natr1 natr_absz ltr_pwDr// ler_int. +exact: ler_norm. Qed. +Lemma nbhs_infty_ger {R : realType} (r : R) : \forall n \near \oo, r <= n%:R. +Proof. by apply: filterS (nbhs_infty_gtr r) => x /ltW. Qed. + Lemma cvg_addnl N : addn N @ \oo --> \oo. Proof. by move=> P [n _ Pn]; exists (n - N)%N => // m; rewrite /= leq_subLR => /Pn. From 4d352d8ab3caf420bab7351fc6054009dfd46492 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 2 Mar 2025 17:41:19 +0900 Subject: [PATCH 12/73] ess_supM --- theories/lspace.v | 35 ++++++++---------- theories/measurable_realfun.v | 68 +++++++++++++++++++++++++++++++++-- theories/measure.v | 20 ++++++----- 3 files changed, 92 insertions(+), 31 deletions(-) diff --git a/theories/lspace.v b/theories/lspace.v index a2811f1bc2..91d7c3f058 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -146,7 +146,7 @@ Qed. End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. -(* move to hoelder.v *) +(* TODO: move to hoelder.v *) Section conjugate. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). @@ -167,22 +167,19 @@ Lemma conjugateE : else if p == +oo then 1 else 0. Proof. rewrite /conjugate. -move: p1. -case: p => [r|//=|//]. +case: p p1 => [r|//=|//]. rewrite lee_fin => r1. have r0 : r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). -congr (_%:E). -apply: get_unique. +congr EFin; apply: get_unique. by rewrite invf_div mulrBl divff// mul1r addrCA subrr addr0. -move=> /= y h0. -suffices -> : y = (1 - r^-1)^-1. +move=> /= y ry1. +suff -> : y = (1 - r^-1)^-1. by rewrite -(mul1r r^-1) -{1}(divff r0) -mulrBl invf_div. -by rewrite -h0 -addrAC subrr add0r invrK. +by rewrite -ry1 -addrAC subrr add0r invrK. Qed. End conjugate. - Section lfun_pred. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). @@ -267,14 +264,13 @@ Lemma LnormZ (f : LfunType mu p1) a : ('N[mu]_p[a \*: f] = `|a|%:E * 'N[mu]_p[f])%E. Proof. rewrite unlock /Lnorm. -move: p p1 f. -case=> //[r r1 f|]. +case: p p1 f => //[r r1 f|]. - under eq_integral => x _/= do rewrite -mulr_algl scaler1 normrM powRM ?EFinM//. rewrite integralZl//; last first. apply /integrableP; split. apply: measurableT_comp => //. - rewrite (_ : (fun x : T => `|f x| `^ r) = (@powR R)^~ r \o normr \o f)//. - by repeat apply: measurableT_comp => //. + rewrite [X in measurable_fun _ X](_ : _ = (@powR R)^~ r \o normr \o f)//. + by apply: measurableT_comp => //; apply: measurableT_comp. apply: (@lty_poweRy _ _ r^-1). by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[f])%E. @@ -283,14 +279,11 @@ case=> //[r r1 f|]. exact: (lfuny r1 f). rewrite poweRM ?integral_ge0=> //; rewrite ?lee_fin ?powR_ge0//. by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. -- move=> p0 f. - case: ifP => mu0. - rewrite (_ : normr \o a \*: f = (`|a|) \*: (normr \o f)); last first. - by apply: funext => x/=; rewrite normrZ. - rewrite ess_supMr//. - by near=> x=> /=. - by rewrite mule0. -Unshelve. end_near. Qed. +- move=> p0 f; case: ifP => mu0; last by rewrite mule0. + rewrite (_ : normr \o a \*: f = `|a| \*: (normr \o f)); last first. + by apply: funext => x/=; rewrite normrZ. + by rewrite ess_supMl. +Qed. Lemma lfun_submod_closed : submod_closed (lfun). Proof. diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 0c4702f6dc..e6ee226a36 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -1598,6 +1598,58 @@ Qed. End open_itv_cover. +Section ereal_supZ. +Context {R : realType}. +Implicit Types (r s : R) (A : set R). +Local Open Scope ereal_scope. + +Lemma ereal_supZl A r : (0 < r)%R -> + ereal_sup [set r%:E * x%:E | x in A] = r%:E * ereal_sup (EFin @` A). +Proof. +move=> r0. +apply/eqP; rewrite eq_le; apply/andP; split. + (*TODO: should be ereal_sup_le and the current ereal_sup_le should be named something else*) + apply: ub_ereal_sup => /= _ [s As <-]. + rewrite -lee_pdivlMl// muleA -EFinM mulVf ?gt_eqF// mul1e. + by apply: ereal_sup_le; exists s%:E => //=; exists s. +rewrite -lee_pdivlMl//. +apply: ub_ereal_sup => /= _ [s As <-]. +rewrite lee_pdivlMl//. +apply: ereal_sup_le; exists (r * s)%:E => //=. +by exists s => //; rewrite EFinM. +Qed. + +Let ereal_infZl' A r : (0 < r)%R -> + ereal_sup [set - x | x in [set r%:E * x%:E | x in A]] = + r%:E * ereal_sup [set - x | x in [set x%:E | x in A]]. +Proof. +move=> r0. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: ub_ereal_sup => /= _ [_ [s As <-]] <-. + rewrite -muleN -lee_pdivlMl// muleA -EFinM mulVf ?gt_eqF// mul1e. + apply: ereal_sup_le; exists (- s%:E) => //=. + exists s%:E. + by exists s. + by rewrite EFinN. +rewrite -lee_pdivlMl//. +apply: ub_ereal_sup => /= _ [_ [s As <-]] <-. +rewrite lee_pdivlMl//. +apply: ereal_sup_le; exists (- (r * s)%:E) => //=. + exists (r * s)%:E. + by exists s => //; rewrite EFinM. + by rewrite EFinN. +by rewrite EFinN muleN -EFinM EFinN. +Qed. + +Lemma ereal_infZl A r : (0 < r)%R -> + ereal_inf [set r%:E * x%:E | x in A] = r%:E * ereal_inf (EFin @` A). +Proof. +move=> r0; rewrite /ereal_inf muleN; congr -%E. +exact: ereal_infZl'. +Qed. + +End ereal_supZ. + Section essential_supremum. Context d {T : measurableType d} {R : realType}. Variable mu : {measure set T -> \bar R}. @@ -1684,10 +1736,22 @@ rewrite [X in mu X](_ : _ = [set r | (0 < `|f r|%:E)%E]); last first. by rewrite -f0 ess_sup_max// f0. Qed. -Lemma ess_supMr f (r : R) : (0 <= r)%R -> (\forall x \ae mu, 0 <= f x)%R -> +Lemma ess_supMl f (r : R) : mu setT > 0 -> (0 <= r)%R -> ess_sup mu (cst r \* f)%R = r%:E * ess_sup mu f. Proof. -Admitted. +move=> muT0; rewrite le_eqVlt => /predU1P[<-|r0]. + rewrite mul0e (_ : _ \* f = cst 0)%R; first by rewrite ess_sup_cst. + by apply/funext => ?; rewrite /= mul0r. +rewrite -ereal_infZl//. +have rf s : (cst r \* f)%R @^-1` `]s, +oo[ = f%R @^-1` `]s / r, +oo[. + by apply/seteqP; split => [y|y]/=; rewrite !in_itv/= !andbT; + rewrite ltr_pdivrMr// mulrC. +congr ereal_inf; apply/seteqP; split => [_ [s /= M <-]|_ [s /= M <-]]/=. +- exists (s / r)%R; first by rewrite -rf. + by rewrite EFinM muleCA -EFinM divff ?mulr1// gt_eqF. +- exists (r * s)%R; last by rewrite EFinM. + by rewrite rf mulrAC divff ?mul1r// gt_eqF. +Qed. End essential_supremum. diff --git a/theories/measure.v b/theories/measure.v index c92c09bd5b..3fddb6f858 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -5412,21 +5412,25 @@ Implicit Types f : T -> R. Definition ess_sup f := ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). -Lemma ess_sup_ger f x : 0 < mu [set: T] -> (forall t, x <= f t)%R -> - x%:E <= ess_sup f. +Lemma ess_sup_ger f x : 0 < mu [set: T] -> (forall t, x <= (f t)%:E) -> + x <= ess_sup f. Proof. -move=> muT f0; apply: lb_ereal_inf => _ /= [r /eqP rf <-]; rewrite leNgt. -apply/negP => r0; apply/negP : rf; rewrite gt_eqF// (_ : _ @^-1` _ = setT)//. -by apply/seteqP; split => // t _ /=; rewrite in_itv/= (lt_le_trans _ (f0 t)). +move=> muT f0; apply: lb_ereal_inf => _ /= [r /eqP fr0 <-]; rewrite leNgt. +apply/negP => rx; apply/negP : fr0; rewrite gt_eqF// (_ : _ @^-1` _ = setT)//. +apply/seteqP; split => // t _ /=; rewrite in_itv/= andbT. +by rewrite -lte_fin (lt_le_trans _ (f0 t)). Qed. -Lemma ess_sup_ler f (r : R) : (forall x, f x <= r)%R -> ess_sup f <= r%:E. +Lemma ess_sup_ler f r : (forall t, (f t)%:E <= r) -> ess_sup f <= r. Proof. -move=> fr; apply: ereal_inf_le; apply/exists2P. +case: r => [r| |] fr; last 2 first. + by rewrite leey. + by have := fr point; rewrite leNgt ltNye. +apply: ereal_inf_le; apply/exists2P. exists r%:E => /=; split => //; apply/exists2P; exists r; split => //. rewrite preimage_itvoy [X in mu X](_ : _ = set0)// -subset0 => x //=. rewrite lt_neqAle => /andP[+ rlefx]. -by apply/negP/negPn; rewrite eq_le rlefx fr. +by apply/negP/negPn; rewrite eq_le rlefx/= -lee_fin. Qed. Lemma ess_sup_cst r : (0 < mu setT)%E -> (ess_sup (cst r) = r%:E)%E. From ef1eca8a44f42bc0b0de153fbb23de3db8f7132e Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 2 Mar 2025 18:14:15 +0900 Subject: [PATCH 13/73] do w.o. measure_is_zero --- theories/lspace.v | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/theories/lspace.v b/theories/lspace.v index 91d7c3f058..1425b4c914 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -269,8 +269,8 @@ case: p p1 f => //[r r1 f|]. rewrite integralZl//; last first. apply /integrableP; split. apply: measurableT_comp => //. - rewrite [X in measurable_fun _ X](_ : _ = (@powR R)^~ r \o normr \o f)//. - by apply: measurableT_comp => //; apply: measurableT_comp. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. + exact: measurableT_comp. apply: (@lty_poweRy _ _ r^-1). by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[f])%E. @@ -382,11 +382,6 @@ Qed. Local Open Scope ereal_scope. -Lemma measure_is_zero : mu [set: T] = 0%E -> mu = mzero. -Proof. -move=> mu0. -Admitted. - Lemma Lspace_inclusion (p q : \bar R) : forall (p1 : 1 <= p) (q1 : 1 <= q), mu [set: T] < +oo -> p < q -> @@ -397,8 +392,17 @@ rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. rewrite /finite_norm unlock /Lnorm. move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. move=> r r1. - rewrite measure_is_zero// integral_measure_zero. - by rewrite poweR0r ?ltry// gt_eqF// invr_gt0 (lt_le_trans ltr01). + under eq_integral. + move=> x _. + have -> : (`|f x| `^ r)%:E = `| (`|f x| `^ r) |%:E. + by rewrite ger0_norm// powR_ge0. + over. + rewrite /=. + rewrite (@integral_abs_eq0 _ _ _ _ setT setT (fun x => (`|f x| `^ r)%:E))//. + by rewrite poweR0r// invr_neq0// gt_eqF// -lte_fin (lt_le_trans _ r1). + apply/measurable_EFinP. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. + exact: measurableT_comp. move: p q. case=> //[p|]; case=> //[q|] p1 q1; last first. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). @@ -406,8 +410,7 @@ case=> //[p|]; case=> //[q|] p1 q1; last first. rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. rewrite poweR_lty// integral_fune_lt_pinfty => //. apply: measurable_bounded_integrable => //. - rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. - apply: measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. exact: measurableT_comp. rewrite boundedE. near=> A=> x/= _. @@ -424,9 +427,8 @@ have := (@hoelder _ _ _ mu (fun x => `|f x| `^ p) (cst 1)%R r r')%R. rewrite (_ : (_ \* cst 1)%R = (fun x : T => `|f x| `^ p))%R -?fctM ?mulr1//. rewrite Lnorm_cst1 unlock /Lnorm invr1. have mfp : measurable_fun [set: T] (fun x : T => (`|f x| `^ p)%R). - rewrite (_ : (fun x : T => `|f x| `^ p) = (@powR R)^~ p \o normr \o f)%R//. - apply: measurableT_comp => //=. - exact: measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. + exact: measurableT_comp. have m1 : measurable_fun [set: T] (@cst _ R 1%R). exact: measurable_cst. have r0 : (0 < r)%R by rewrite/r divr_gt0. From bcc22aae76a4d74dc81fbbf8ee9c6b668e68cc47 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 2 Mar 2025 19:33:21 +0900 Subject: [PATCH 14/73] only one admit left in lspace.v --- theories/hoelder.v | 2 +- theories/lspace.v | 23 +++++++++++++++-------- theories/measurable_realfun.v | 14 +++++++++++++- 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 27065241bf..0986e8087c 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -186,7 +186,7 @@ rewrite -lte_fin. move=> mf mg p0 q0 pq f0; rewrite f0 mul0e Lnorm1 [leLHS](_ : _ = 0)//. rewrite (ae_eq_integral (cst 0)) => [|//||//|]; first by rewrite integral0. - by do 2 apply: measurableT_comp => //; exact: measurable_funM. -- apply: filterS (Lnorm_eq0_eq0 mf p0 f0) => x /(_ I)[] + _. +- apply: filterS (Lnorm_eq0_eq0 mf p0 f0) => x /(_ I) + _. by rewrite normrM => ->; rewrite normr0 mul0r. Qed. diff --git a/theories/lspace.v b/theories/lspace.v index 1425b4c914..b9957e402d 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -117,6 +117,7 @@ by under eq_integral => i _ do rewrite powRr1//. Qed. Let le12 : (1 <= 2%:E :> \bar R)%E. +Proof. rewrite lee_fin. rewrite (ler_nat _ 1 2). by []. @@ -353,7 +354,7 @@ HB.instance Definition _ := nm ler_Lnorm_add Lnorm_natmul LnormN. *) -(* todo: add equivalent of mx_normZ and HB instance *) +(* TODO: add equivalent of mx_normZ and HB instance *) Lemma nm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. Proof. @@ -408,14 +409,20 @@ case=> //[p|]; case=> //[q|] p1 q1; last first. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). move=> muoo _ f. rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. - rewrite poweR_lty// integral_fune_lt_pinfty => //. - apply: measurable_bounded_integrable => //. + rewrite poweR_lty//. + have : measurable_fun setT (normr \o f) by exact/measurableT_comp. + move/ess_sup_bounded => /(_ _ supf_lty)[M fM]. + rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. + by rewrite integral_cst// lte_mul_pinfty// lee_fin powR_ge0. + apply: ae_ge0_le_integral => //. + - by move=> x _; rewrite lee_fin powR_ge0. + apply/measurable_EFinP. apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. exact: measurableT_comp. - rewrite boundedE. - near=> A=> x/= _. - rewrite norm_powR// normr_id normr1 mulr1. - admit. + - by move=> x _; rewrite lee_fin powR_ge0. + apply: filterS fM => t/= ftM _. + rewrite lee_fin ge0_ler_powR//; first exact: ltW. + by rewrite nnegrE (le_trans _ ftM). move=> mu_fin pleq f ffin. have:= ffin; rewrite /finite_norm. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). @@ -451,6 +458,6 @@ rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?ltNyr// ?poweR_lty. rewrite poweR_lty// (lty_poweRy qinv0)//. by have:= ffin; rewrite /finite_norm unlock /Lnorm. -Admitted. +Qed. End Lspace_inclusion. diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index e6ee226a36..c733e2fd6e 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -304,7 +304,7 @@ HB.instance Definition _ := (ereal_isMeasurable (R.-ocitv.-measurable)). (* NB: Until we dropped support for Coq 8.12, we were using HB.instance (\bar (Real.sort R)) (ereal_isMeasurable (@measurable (@itvs_semiRingOfSets R))). -This was producing a warning but the alternative was failing with Coq 8.12 with +This was producing as warning but the alternative was failing with Coq 8.12 with the following message (according to the CI): # [redundant-canonical-projection,typechecker] # forall (T : measurableType) (f : T -> R), measurable_fun setT f @@ -1656,6 +1656,18 @@ Variable mu : {measure set T -> \bar R}. Implicit Types f : T -> R. Local Open Scope ereal_scope. +Lemma ess_sup_bounded f : measurable_fun setT f -> ess_sup mu f < +oo -> + exists M, \forall x \ae mu, (f x <= M)%R. +Proof. +move=> mf /ereal_inf_lt[_ /= [r fr0] <-] _. +exists r, (f @^-1` `]r, +oo[); split => //. + rewrite (_ : _ @^-1` _ = [set t | r%:E < (f t)%:E]); last first. + by apply/seteqP; split => [x|x]/=; rewrite in_itv/= andbT. + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. +by move=> t/= ftr; rewrite in_itv/= andbT ltNge; exact/negP. +Qed. + Lemma ess_sup_max f : measurable_fun setT f -> ess_sup mu (normr \o f) != -oo -> mu [set r | ess_sup mu (normr \o f) < `|f r|%:E] = 0. From 106dcf9a892a083dc30036e3a3c395c8e16e5327 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 2 Mar 2025 19:38:10 +0900 Subject: [PATCH 15/73] typo --- theories/measurable_realfun.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index c733e2fd6e..8d78e16ec1 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -304,7 +304,7 @@ HB.instance Definition _ := (ereal_isMeasurable (R.-ocitv.-measurable)). (* NB: Until we dropped support for Coq 8.12, we were using HB.instance (\bar (Real.sort R)) (ereal_isMeasurable (@measurable (@itvs_semiRingOfSets R))). -This was producing as warning but the alternative was failing with Coq 8.12 with +This was producing a warning but the alternative was failing with Coq 8.12 with the following message (according to the CI): # [redundant-canonical-projection,typechecker] # forall (T : measurableType) (f : T -> R), measurable_fun setT f From fc5dad2a7fc7b6684c655138e4e386cd27a4550a Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 3 Mar 2025 13:13:14 +0900 Subject: [PATCH 16/73] ess_supD --- theories/measurable_realfun.v | 72 ++++++++++++++++++++++++++++++++++- 1 file changed, 71 insertions(+), 1 deletion(-) diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 8d78e16ec1..8a350cbd2a 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -1653,7 +1653,7 @@ End ereal_supZ. Section essential_supremum. Context d {T : measurableType d} {R : realType}. Variable mu : {measure set T -> \bar R}. -Implicit Types f : T -> R. +Implicit Types f g : T -> R. Local Open Scope ereal_scope. Lemma ess_sup_bounded f : measurable_fun setT f -> ess_sup mu f < +oo -> @@ -1765,6 +1765,76 @@ congr ereal_inf; apply/seteqP; split => [_ [s /= M <-]|_ [s /= M <-]]/=. by rewrite rf mulrAC divff ?mul1r// gt_eqF. Qed. +Lemma ess_sup_ub f : measurable_fun setT f -> ess_sup mu (normr \o f) != -oo -> + {ae mu, forall x, `|f x|%:E <= ess_sup mu (normr \o f)}. +Proof. +move=> mf fNy. +have [->|] := eqVneq (ess_sup mu (normr \o f)) +oo. + by apply/nearW => ?; rewrite leey. +rewrite -ltey => fy. +exists [set r | ess_sup mu (normr \o f) < `|f r|%:E]. +split. +- rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + by apply/measurable_EFinP; exact/measurableT_comp. +- exact: ess_sup_max. +- by move=> t/= /negP; rewrite -ltNge. +Qed. + +Lemma ess_supD f g : + measurable_fun setT f -> measurable_fun setT g -> + ess_sup mu (normr \o f) != -oo -> ess_sup mu (normr \o g) != -oo -> + ess_sup mu (normr \o (f \+ g)) <= + ess_sup mu (normr \o f) + ess_sup mu (normr \o g). +Proof. +move=> mf mg fNy gNy. +have [->|] := eqVneq (ess_sup mu (normr \o f)) +oo. + by rewrite addye// leey. +rewrite -ltey => fy. +have [->|] := eqVneq (ess_sup mu (normr \o g)) +oo. + by rewrite addey// leey. +rewrite -ltey => gy. +pose a := ess_sup mu (normr \o f); pose b := ess_sup mu (normr \o g). +have a_fin_num : a \is a fin_num by rewrite fin_real// fy andbT ltNye. +have b_fin_num : b \is a fin_num by rewrite fin_real// gy andbT ltNye. +have fa : {ae mu, forall x, `|f x|%:E <= a}. + exact: ess_sup_ub. +have gb : {ae mu, forall x, `|g x|%:E <= b}. + exact: ess_sup_ub. +have {fa gb}fg : + {ae mu, forall x, (((normr \o f) \+ (normr \o g)) x)%:E <= a + b}. + case: fa => A [mA A0 Af]. + case: gb => B [mB B0 Bg]. + exists (A `|` B); split; first exact: measurableU. + by rewrite measureU0. + move=> t/= /negP; rewrite -ltNge => abfg. + have [At|At] := pselect (A t); [by left|right]. + apply: Bg => //=. + apply: contra_not At => gb. + apply: Af => /= fa. + have : (`|f t|%R + `|g t|%R)%E%:E <= a + b. + by rewrite EFinD leeD. + by rewrite leNgt abfg. +apply: ereal_inf_lbound => /=. +exists (fine a + fine b). + case: fg => N [mN N0 fgN]. + apply/eqP; rewrite eq_le measure_ge0 andbT -N0. + rewrite le_measure ?inE//. + rewrite -[X in measurable X]setTI. + have : measurable_fun setT (normr \o (f \+ g)). + apply: measurableT_comp => //. + exact: measurable_funD. + exact. + apply: subset_trans fgN => t/=. + rewrite in_itv/= andbT => abfg. + apply/negP; rewrite -ltNge. + rewrite -lte_fin in abfg. + (* TODO: we don't have lee_absD? *) + rewrite (@lt_le_trans _ _ `|(f t + g t)|%:E)%R//. + by move: abfg; rewrite EFinD !fineK. + exact: ler_normD. +by rewrite EFinD !fineK. +Qed. + End essential_supremum. Section egorov. From fba96b15ca83d2a3a8fcca884b5aa3c8de0bafbd Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Mon, 3 Mar 2025 14:28:52 +0900 Subject: [PATCH 17/73] wip (#26) * minkowskie --- theories/hoelder.v | 28 ++++++++++++++++++++++++++++ theories/lspace.v | 12 ++---------- 2 files changed, 30 insertions(+), 10 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 0986e8087c..c86620e027 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -548,4 +548,32 @@ apply: minkowski => //. apply: measurableT_comp => //. Qed. +Lemma le_ess_sup (f g : T -> R) : + measurable_fun setT f -> measurable_fun setT g -> + (forall x, f x <= g x)%R -> ess_sup mu f <= ess_sup mu g. +Proof. +rewrite /ess_sup => mf mg h. +apply: le_ereal_inf => x [r]/= mu0 rx. +exists r => //. +move: mu0. +apply: subset_measure0. +- by rewrite -[X in _ X]setTI; exact: mf. +- by rewrite -[X in _ X]setTI; exact: mg. +move=> t/=. +rewrite !in_itv !andbT/= => fgtt. +by rewrite (lt_le_trans fgtt)//. +Qed. + +Lemma minkowskie (f g : T -> R) (p : \bar R) : + measurable_fun setT f -> measurable_fun setT g -> 1 <= p -> + 'N_p[(f \+ g)%R] <= 'N_p[f] + 'N_p[g]. +Proof. +case: p => //[r|]; first exact: minkowski. +move=> mf mg _. +rewrite unlock /Lnorm. +case: ifPn => mugt0; last by rewrite adde0 lexx. +apply: ess_supD => //. +all: by rewrite gt_eqF// (lt_le_trans ltNy0)// ess_sup_ger// => x/=; rewrite lee_fin normr_ge0. +Qed. + End minkowski. diff --git a/theories/lspace.v b/theories/lspace.v index b9957e402d..d33e016899 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -193,15 +193,6 @@ Lemma sub_lfun_mfun : {subset lfun <= mfun}. Proof. by move=> x /andP[]. Qed. Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. Proof. by move=> x /andP[]. Qed. End lfun_pred. -Lemma minkowskie [d : measure_display] [T : measurableType d] [R : realType] - (mu : measure T R) [f g : T -> R] [p : \bar R] : - measurable_fun [set: T] f -> - measurable_fun [set: T] g -> - (1 <= p)%E -> ('N[mu]_p[(f \+ g)%R] <= 'N[mu]_p[f] + 'N[mu]_p[g])%E. -Proof. -(* TODO: Jairo is working on this *) -Admitted. - Section lfun. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). @@ -296,7 +287,8 @@ move: (lfun_Sub _) (lfun_Sub _) => {fP} f {gP} g. rewrite !inE rpredD ?rpredZ ?mfunP//=. apply: mem_set => /=. rewrite /finite_norm. -apply: (le_lt_trans (minkowskie _ _ _ _)) => //=. +apply: le_lt_trans. + apply: minkowskie => //. suff: a *: (g : T -> R) \in mfun by exact: set_mem. by rewrite rpredZ//; exact: mfunP. rewrite lte_add_pinfty//; last exact: lfuny. From d23b79c9154d563f6c4d0b175a8548c12ed07076 Mon Sep 17 00:00:00 2001 From: Cyril Cohen Date: Sun, 9 Mar 2025 17:50:27 +0100 Subject: [PATCH 18/73] refactor essential_supremum / infimum theory --- _CoqProject | 3 +- classical/mathcomp_extra.v | 124 ++++++++++++ theories/Make | 1 + theories/all_analysis.v | 1 + theories/ess_sup_inf.v | 344 ++++++++++++++++++++++++++++++++++ theories/hoelder.v | 85 ++++----- theories/lspace.v | 39 ++-- theories/measurable_realfun.v | 315 +++++++++---------------------- theories/measure.v | 72 +++---- theories/sequences.v | 3 + 10 files changed, 634 insertions(+), 353 deletions(-) create mode 100644 theories/ess_sup_inf.v diff --git a/_CoqProject b/_CoqProject index 75c7be01ba..a187020c5e 100644 --- a/_CoqProject +++ b/_CoqProject @@ -69,6 +69,7 @@ theories/homotopy_theory/homotopy.v theories/homotopy_theory/wedge_sigT.v theories/homotopy_theory/continuous_path.v +theories/ess_sup_inf.v theories/function_spaces.v theories/ereal.v theories/cantor.v @@ -119,6 +120,6 @@ theories/kernel.v theories/pi_irrational.v theories/gauss_integral.v theories/showcase/summability.v +theories/lspace.v analysis_stdlib/Rstruct_topology.v analysis_stdlib/showcase/uniform_bigO.v -theories/lspace.v diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index 6245db399c..de14df7011 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -470,3 +470,127 @@ Proof. by move=> ? ? []. Qed. Lemma inl_inj {A B} : injective (@inl A B). Proof. by move=> ? ? []. Qed. + +Section bijection_forall. + +Lemma bij_forall A B (f : A -> B) (P : B -> Prop) : + bijective f -> (forall y, P y) <-> (forall x, P (f x)). +Proof. +by case; rewrite /cancel => g _ cangf; split => // => ? y; rewrite -(cangf y). +Qed. + +End bijection_forall. + +Lemma and_prop_in (T : Type) (p : mem_pred T) (P Q : T -> Prop) : + {in p, forall x, P x /\ Q x} <-> + {in p, forall x, P x} /\ {in p, forall x, Q x}. +Proof. +split=> [cnd|[cnd1 cnd2] x xin]; first by split=> x xin; case: (cnd x xin). +by split; [apply: cnd1 | apply: cnd2]. +Qed. + +Lemma mem_inc_segment d (T : porderType d) (a b : T) (f : T -> T) : + {in `[a, b] &, {mono f : x y / (x <= y)%O}} -> + {homo f : x / x \in `[a, b] >-> x \in `[f a, f b]}. +Proof. +move=> fle x xab; have leab : (a <= b)%O by rewrite (itvP xab). +by rewrite in_itv/= !fle ?(itvP xab). +Qed. + +Lemma mem_dec_segment d (T : porderType d) (a b : T) (f : T -> T) : + {in `[a, b] &, {mono f : x y /~ (x <= y)%O}} -> + {homo f : x / x \in `[a, b] >-> x \in `[f b, f a]}. +Proof. +move=> fge x xab; have leab : (a <= b)%O by rewrite (itvP xab). +by rewrite in_itv/= !fge ?(itvP xab). +Qed. + +Definition sigT_fun {I : Type} {X : I -> Type} {T : Type} + (f : forall i, X i -> T) (x : {i & X i}) : T := + (f (projT1 x) (projT2 x)). + +(* PR 114 to finmap in progress *) +Section FsetPartitions. +Variables T I : choiceType. +Implicit Types (x y z : T) (A B D X : {fset T}) (P Q : {fset {fset T}}). +Implicit Types (J : pred I) (F : I -> {fset T}). + +Variables (R : Type) (idx : R) (op : Monoid.com_law idx). +Let rhs_cond P K E := + (\big[op/idx]_(A <- P) \big[op/idx]_(x <- A | K x) E x)%fset. +Let rhs P E := (\big[op/idx]_(A <- P) \big[op/idx]_(x <- A) E x)%fset. + +Lemma partition_disjoint_bigfcup (f : T -> R) (F : I -> {fset T}) + (K : {fset I}) : + (forall i j, i \in K -> j \in K -> i != j -> [disjoint F i & F j])%fset -> + \big[op/idx]_(i <- \big[fsetU/fset0]_(x <- K) (F x)) f i = + \big[op/idx]_(k <- K) (\big[op/idx]_(i <- F k) f i). +Proof. +move=> disjF; pose P := [fset F i | i in K & F i != fset0]%fset. +have trivP : trivIfset P. + apply/trivIfsetP => _ _ /imfsetP[i iK ->] /imfsetP[j jK ->] neqFij. + move: iK; rewrite !inE/= => /andP[iK Fi0]. + move: jK; rewrite !inE/= => /andP[jK Fj0]. + by apply: (disjF _ _ iK jK); apply: contraNneq neqFij => ->. +have -> : (\bigcup_(i <- K) F i)%fset = fcover P. + apply/esym; rewrite /P fcover_imfset big_mkcond /=; apply eq_bigr => i _. + by case: ifPn => // /negPn/eqP. +rewrite big_trivIfset // /rhs big_imfset => [|i j iK /andP[jK notFj0] eqFij] /=. + rewrite big_filter big_mkcond; apply eq_bigr => i _. + by case: ifPn => // /negPn /eqP ->; rewrite big_seq_fset0. +move: iK; rewrite !inE/= => /andP[iK Fi0]. +by apply: contraNeq (disjF _ _ iK jK) _; rewrite -fsetI_eq0 eqFij fsetIid. +Qed. + +End FsetPartitions. + +(* TODO: move to ssrnum *) +Lemma prodr_ile1 {R : realDomainType} (s : seq R) : + (forall x, x \in s -> 0 <= x <= 1)%R -> (\prod_(j <- s) j <= 1)%R. +Proof. +elim: s => [_ | y s ih xs01]; rewrite ?big_nil// big_cons. +have /andP[y0 y1] : (0 <= y <= 1)%R by rewrite xs01// mem_head. +rewrite mulr_ile1 ?andbT//. + rewrite big_seq prodr_ge0// => x xs. + by have := xs01 x; rewrite inE xs orbT => /(_ _)/andP[]. +by rewrite ih// => e xs; rewrite xs01// in_cons xs orbT. +Qed. + +(* TODO: move to ssrnum *) + +Lemma size_filter_gt0 T P (r : seq T) : (size (filter P r) > 0)%N = (has P r). +Proof. by elim: r => //= x r; case: ifP. Qed. + +Lemma ltr_sum [R : numDomainType] [I : Type] (r : seq I) + [P : pred I] [F G : I -> R] : + has P r -> + (forall i : I, P i -> F i < G i) -> + \sum_(i <- r | P i) F i < \sum_(i <- r | P i) G i. +Proof. +rewrite -big_filter -[ltRHS]big_filter -size_filter_gt0. +case: filter (filter_all P r) => //= x {}r /andP[Px Pr] _ ltFG. +rewrite !big_cons ltr_leD// ?ltFG// -(all_filterP Pr) !big_filter. +by rewrite ler_sum => // i Pi; rewrite ltW ?ltFG. +Qed. + +Lemma ltr_sum_nat [R : numDomainType] [m n : nat] [F G : nat -> R] : + (m < n)%N -> (forall i : nat, (m <= i < n)%N -> F i < G i) -> + \sum_(m <= i < n) F i < \sum_(m <= i < n) G i. +Proof. +move=> lt_mn i; rewrite big_nat [ltRHS]big_nat ltr_sum//. +by apply/hasP; exists m; rewrite ?mem_index_iota leqnn lt_mn. +Qed. + +Lemma eq_exists2l (A : Type) (P P' Q : A -> Prop) : + (forall x, P x <-> P' x) -> + (exists2 x, P x & Q x) <-> (exists2 x, P' x & Q x). +Proof. +by move=> eqQ; split=> -[x p q]; exists x; move: p q; rewrite ?eqQ. +Qed. + +Lemma eq_exists2r (A : Type) (P Q Q' : A -> Prop) : + (forall x, Q x <-> Q' x) -> + (exists2 x, P x & Q x) <-> (exists2 x, P x & Q' x). +Proof. +by move=> eqP; split=> -[x p q]; exists x; move: p q; rewrite ?eqP. +Qed. diff --git a/theories/Make b/theories/Make index 31a7ae13f1..0f0d82304b 100644 --- a/theories/Make +++ b/theories/Make @@ -9,6 +9,7 @@ ereal.v landau.v +ess_sup_inf.v topology_theory/topology.v topology_theory/bool_topology.v topology_theory/compact.v diff --git a/theories/all_analysis.v b/theories/all_analysis.v index b567c76901..2a745ee6ac 100644 --- a/theories/all_analysis.v +++ b/theories/all_analysis.v @@ -25,3 +25,4 @@ From mathcomp Require Export charge. From mathcomp Require Export kernel. From mathcomp Require Export pi_irrational. From mathcomp Require Export gauss_integral. +From mathcomp Require Export ess_sup_inf. diff --git a/theories/ess_sup_inf.v b/theories/ess_sup_inf.v new file mode 100644 index 0000000000..71ad495f55 --- /dev/null +++ b/theories/ess_sup_inf.v @@ -0,0 +1,344 @@ +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra archimedean finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop reals interval_inference ereal. +From mathcomp Require Import topology normedtype sequences esum numfun. +From mathcomp Require Import measure lebesgue_measure. + +(**md**************************************************************************) +(* ``` *) +(* ess_sup f == essential supremum of the function f : T -> R where T is a *) +(* semiRingOfSetsType and R is a realType *) +(* ess_inf f == essential infimum *) +(* ``` *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. +Local Open Scope ereal_scope. + +Section essential_supremum. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types (f g : T -> \bar R) (h k : T -> R). + +(* TODO: move *) +Lemma measure0_ae (P : set T) : mu [set: T] = 0 -> \forall x \ae mu, P x. +Proof. by move=> x; exists setT; split. Qed. + +Definition ess_sup f := ereal_inf [set y | \forall x \ae mu, f x <= y]. + +Lemma ess_supEae (f : T -> \bar R) : + ess_sup f = ereal_inf [set y | \forall x \ae mu, f x <= y]. +Proof. by []. Qed. + +Lemma ae_le_measureP f y : measurable_fun setT f -> + (\forall x \ae mu, f x <= y) <-> (mu (f @^-1` `]y, +oo[) = 0). +Proof. +move=> f_meas; have fVroo_meas : d.-measurable (f @^-1` `]y, +oo[). + by rewrite -[_ @^-1` _]setTI; apply/f_meas=> //; exact/emeasurable_itv. +have setCfVroo : (f @^-1` `]y, +oo[) = ~` [set x | f x <= y]. + by apply: setC_inj; rewrite preimage_setC setCitv/= set_itvxx setU0 setCK. +split. + move=> [N [dN muN0 inN]]; rewrite (subset_measure0 _ dN)// => x. + by rewrite setCfVroo; apply: inN. +set N := (X in mu X) => muN0; exists N; rewrite -setCfVroo. +by split => //; exact: fVroo_meas. +Qed. + +Lemma ess_supEmu0 (f : T -> \bar R) : measurable_fun setT f -> + ess_sup f = ereal_inf [set y | mu (f @^-1` `]y, +oo[) = 0]. +Proof. +by move=> ?; congr (ereal_inf _); apply/predeqP => r; exact: ae_le_measureP. +Qed. + +Lemma ess_sup_ge f : \forall x \ae mu, f x <= ess_sup f. +Proof. +rewrite ess_supEae//; set I := (X in ereal_inf X). +have [->|IN0] := eqVneq I set0. + by rewrite ereal_inf0; apply: nearW => ?; rewrite leey. +have [u uI uinf] := ereal_inf_seq IN0. +rewrite -(cvg_lim _ uinf)//; near=> x. +rewrite lime_ge//; first by apply/cvgP: uinf. +by apply: nearW; near: x; apply/ae_foralln => n; apply: uI. +Unshelve. all: by end_near. Qed. + +Lemma ess_supP f a : reflect (\forall x \ae mu, f x <= a) (ess_sup f <= a). +Proof. +apply: (iffP (ereal_inf_leP _)) => /=; last 2 first. +- by move=> [y fy ya]; near do apply: le_trans ya. +- by move=> fa; exists a. +by rewrite -ess_supEae//; exact: ess_sup_ge. +Unshelve. all: by end_near. Qed. + +Lemma le_ess_sup f g : (\forall x \ae mu, f x <= g x) -> ess_sup f <= ess_sup g. +Proof. +move=> fg; apply/ess_supP => //. +near do rewrite (le_trans (near fg _ _))//=. +exact: ess_sup_ge. +Unshelve. all: by end_near. Qed. + +Lemma eq_ess_sup f g : (\forall x \ae mu, f x = g x) -> ess_sup f = ess_sup g. +Proof. +move=> fg; apply/eqP; rewrite eq_le !le_ess_sup//=; + by apply: filterS fg => x ->. +Qed. + +Lemma ess_sup_cst r : 0 < mu [set: T] -> ess_sup (cst r) = r. +Proof. +move=> muT_gt0; apply/eqP; rewrite eq_le; apply/andP; split. + by apply/ess_supP => //; apply: nearW. +have ae_proper := ae_properfilter_algebraOfSetsType muT_gt0. +by near (almost_everywhere mu) => x; near: x; apply: ess_sup_ge. +Unshelve. all: by end_near. Qed. + +Lemma ess_sup_ae_cst f r : 0 < mu [set: T] -> + (\forall x \ae mu, f x = r) -> ess_sup f = r. +Proof. by move=> muT_gt0 /= /eq_ess_sup->; rewrite ess_sup_cst. Qed. + +Lemma ess_sup_gee f y : 0 < mu [set: T] -> + (\forall x \ae mu, y <= f x)%E -> y <= ess_sup f. +Proof. by move=> *; rewrite -(ess_sup_cst y)//; apply: le_ess_sup. Qed. + +Lemma abs_sup_eq0_ae_eq f : ess_sup (abse \o f) = 0 -> f = \0 %[ae mu]. +Proof. +move=> ess_sup_f_eq0; near=> x => _ /=; apply/eqP. +rewrite -abse_eq0 eq_le abse_ge0 andbT; near: x. +by apply/ess_supP; rewrite ess_sup_f_eq0. +Unshelve. all: by end_near. Qed. + +Lemma abs_ess_sup_eq0 f : mu [set: T] > 0 -> + f = \0 %[ae mu] -> ess_sup (abse \o f) = 0. +Proof. +move=> muT_gt0 f0; apply/eqP; rewrite eq_le; apply/andP; split. + by apply/ess_supP => /=; near do rewrite (near f0 _ _)//= normr0//. +by rewrite -[0]ess_sup_cst// le_ess_sup//=; near=> x; rewrite abse_ge0. +Unshelve. all: by end_near. Qed. + +Lemma ess_sup_pZl f (a : R) : (0 < a)%R -> + (ess_sup (cst a%:E \* f) = a%:E * ess_sup f). +Proof. +move=> /[dup] /ltW a_ge0 a_gt0. +gen have esc_le : a f a_ge0 a_gt0 / + (ess_sup (cst a%:E \* f) <= a%:E * ess_sup f)%E. + by apply/ess_supP; near do rewrite /cst/= lee_pmul2l//; apply/ess_supP. +apply/eqP; rewrite eq_le esc_le// -lee_pdivlMl//=. +apply: le_trans (esc_le _ _ _ _); rewrite ?invr_gt0 ?invr_ge0//. +by under eq_fun do rewrite muleA -EFinM mulVf ?mul1e ?gt_eqF//. +Unshelve. all: by end_near. Qed. + +Lemma ess_supZl f (a : R) : mu [set: T] > 0 -> (0 <= a)%R -> + (ess_sup (cst a%:E \* f) = a%:E * ess_sup f). +Proof. + +move=> muTN0; case: ltgtP => // [a_gt0|<-] _; first exact: ess_sup_pZl. +by under eq_fun do rewrite mul0e; rewrite mul0e ess_sup_cst. +Qed. + +Lemma ess_sup_eqNyP f : ess_sup f = -oo <-> \forall x \ae mu, f x = -oo. +Proof. +rewrite (rwP eqP) -leeNy_eq (eq_near (fun=> rwP eqP)). +by under eq_near do rewrite -leeNy_eq; apply/(rwP2 idP (ess_supP _ _)). +Qed. + +Lemma ess_supD f g : ess_sup (f \+ g) <= ess_sup f + ess_sup g. +Proof. +by apply/ess_supP; near do rewrite lee_add//; apply/ess_supP. +Unshelve. all: by end_near. Qed. + +Lemma ess_sup_absD f g : + ess_sup (abse \o (f \+ g)) <= ess_sup (abse \o f) + ess_sup (abse \o g). +Proof. +rewrite (le_trans _ (ess_supD _ _))// le_ess_sup//. +by apply/nearW => x; apply/lee_abs_add. +Qed. + +End essential_supremum. +Arguments ess_sup_ae_cst {d T R mu f}. +Arguments ess_supP {d T R mu f a}. + +Section real_essential_supremum. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types f : T -> R. + +Notation ess_supr f := (ess_sup mu (EFin \o f)). + +Lemma ess_supr_bounded f : ess_supr f < +oo -> + exists M, \forall x \ae mu, (f x <= M)%R. +Proof. +set g := EFin \o f => ltfy; have [|supfNy] := eqVneq (ess_sup mu g) -oo. + by move=> /ess_sup_eqNyP fNy; exists 0%:R; apply: filterS fNy. +have supf_fin : ess_supr f \is a fin_num by case: ess_sup ltfy supfNy. +by exists (fine (ess_supr f)); near do rewrite -lee_fin fineK//; apply/ess_supP. +Unshelve. all: by end_near. Qed. + +Lemma ess_sup_eqr0_ae_eq f : ess_supr (normr \o f) = 0 -> f = 0%R %[ae mu]. +Proof. +under [X in ess_sup _ X]eq_fun do rewrite /= -abse_EFin. +move=> /abs_sup_eq0_ae_eq; apply: filterS => x /= /(_ _)/eqP. +by rewrite eqe => /(_ _)/eqP. +Qed. + +Lemma ess_suprZl f (y : R) : mu setT > 0 -> (0 <= y)%R -> + ess_supr (cst y \* f)%R = y%:E * ess_supr f. +Proof. by move=> muT_gt0 r_ge0; rewrite -ess_supZl. Qed. + +Lemma ess_sup_ger f x : 0 < mu [set: T] -> (forall t, x <= (f t)%:E) -> + x <= ess_supr f. +Proof. by move=> muT f0; apply/ess_sup_gee => //=; apply: nearW. Qed. + +Lemma ess_sup_ler f y : (forall t, (f t)%:E <= y) -> ess_supr f <= y. +Proof. by move=> ?; apply/ess_supP; apply: nearW. Qed. + +Lemma ess_sup_cstr y : (0 < mu setT)%E -> (ess_supr (cst y) = y%:E)%E. +Proof. by move=> muN0; rewrite (ess_sup_ae_cst y%:E)//=; apply: nearW. Qed. + +Lemma ess_suprD f g : ess_supr (f \+ g) <= ess_supr f + ess_supr g. +Proof. by rewrite (le_trans _ (ess_supD _ _ _)). Qed. + +Lemma ess_sup_normD f g : + ess_supr (normr \o (f \+ g)) <= ess_supr (normr \o f) + ess_supr (normr \o g). +Proof. +rewrite (le_trans _ (ess_suprD _ _))// le_ess_sup//. +by apply/nearW => x; apply/ler_normD. +Qed. + +End real_essential_supremum. +Notation ess_supr mu f := (ess_sup mu (EFin \o f)). + +Section essential_infimum. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types f : T -> \bar R. + +Definition ess_inf f := ereal_sup [set y | \forall x \ae mu, y <= f x]. +Notation ess_sup := (ess_sup mu). + +Lemma ess_infEae (f : T -> \bar R) : + ess_inf f = ereal_sup [set y | \forall x \ae mu, y <= f x]. +Proof. by []. Qed. + +Lemma ess_infEN (f : T -> \bar R) : ess_inf f = - ess_sup (\- f). +Proof. +rewrite ess_supEae ess_infEae ereal_infEN oppeK; congr (ereal_sup _). +apply/seteqP; split=> [y /= y_le|_ [/= y y_ge <-]]. + by exists (- y); rewrite ?oppeK//=; apply: filterS y_le => x; rewrite leeN2. +by apply: filterS y_ge => x; rewrite leeNl. +Qed. + +Lemma ess_supEN (f : T -> \bar R) : ess_sup f = - ess_inf (\- f). +Proof. +by rewrite ess_infEN oppeK; apply/eq_ess_sup/nearW => ?; rewrite oppeK. +Qed. + +Lemma ess_infN (f : T -> \bar R) : ess_inf (\- f) = - ess_sup f. +Proof. by rewrite ess_supEN oppeK. Qed. + +Lemma ess_supN (f : T -> \bar R) : ess_sup (\- f) = - ess_inf f. +Proof. by rewrite ess_infEN oppeK. Qed. + +Lemma ess_infP f a : reflect (\forall x \ae mu, a <= f x) (a <= ess_inf f). +Proof. +by rewrite ess_infEN leeNr; apply: (iffP ess_supP); + apply: filterS => x; rewrite leeN2. +Qed. + +Lemma ess_inf_le f : \forall x \ae mu, ess_inf f <= f x. +Proof. exact/ess_infP. Qed. + +Lemma le_ess_inf f g : (\forall x \ae mu, f x <= g x) -> ess_inf f <= ess_inf g. +Proof. +move=> fg; apply/ess_infP => //. +near do rewrite (le_trans _ (near fg _ _))//=. +exact: ess_inf_le. +Unshelve. all: by end_near. Qed. + +Lemma eq_ess_inf f g : (\forall x \ae mu, f x = g x) -> ess_inf f = ess_inf g. +Proof. +move=> fg; apply/eqP; rewrite eq_le !le_ess_inf//=; + by apply: filterS fg => x ->. +Qed. + +Lemma ess_inf_cst r : 0 < mu [set: T] -> ess_inf (cst r) = r. +Proof. +by move=> ?; rewrite ess_infEN (ess_sup_ae_cst (- r)) ?oppeK//=; apply: nearW. +Qed. + +Lemma ess_inf_ae_cst f r : 0 < mu [set: T] -> + (\forall x \ae mu, f x = r) -> ess_inf f = r. +Proof. by move=> muT_gt0 /= /eq_ess_inf->; rewrite ess_inf_cst. Qed. + +Lemma ess_inf_gee f y : 0 < mu [set: T] -> + (\forall x \ae mu, y <= f x)%E -> y <= ess_inf f. +Proof. by move=> *; rewrite -(ess_inf_cst y)//; apply: le_ess_inf. Qed. + +Lemma ess_inf_pZl f (a : R) : (0 < a)%R -> + (ess_inf (cst a%:E \* f) = a%:E * ess_inf f). +Proof. +move=> a_gt0; rewrite !ess_infEN muleN; congr (- _)%E. +by under eq_fun do rewrite -muleN; rewrite ess_sup_pZl. +Qed. + +Lemma ess_infZl f (a : R) : mu [set: T] > 0 -> (0 <= a)%R -> + (ess_inf (cst a%:E \* f) = a%:E * ess_inf f). +Proof. +move=> muTN0; case: ltgtP => // [a_gt0|<-] _; first exact: ess_inf_pZl. +by under eq_fun do rewrite mul0e; rewrite mul0e ess_inf_cst. +Qed. + +Lemma ess_inf_eqyP f : ess_inf f = +oo <-> \forall x \ae mu, f x = +oo. +Proof. +rewrite (rwP eqP) -leye_eq (eq_near (fun=> rwP eqP)). +by under eq_near do rewrite -leye_eq; apply/(rwP2 idP (ess_infP _ _)). +Qed. + +Lemma ess_infD f g : ess_inf (f \+ g) >= ess_inf f + ess_inf g. +Proof. +by apply/ess_infP; near do rewrite lee_add//; apply/ess_infP. +Unshelve. all: by end_near. Qed. + +End essential_infimum. +Arguments ess_inf_ae_cst {d T R mu f}. +Arguments ess_infP {d T R mu f a}. + +Section real_essential_infimum. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types f : T -> R. + +Notation ess_infr f := (ess_inf mu (EFin \o f)). + +Lemma ess_infr_bounded f : ess_infr f > -oo -> + exists M, \forall x \ae mu, (f x >= M)%R. +Proof. +set g := EFin \o f => ltfy; have [|inffNy] := eqVneq (ess_inf mu g) +oo. + by move=> /ess_inf_eqyP fNy; exists 0%:R; apply: filterS fNy. +have inff_fin : ess_infr f \is a fin_num by case: ess_inf ltfy inffNy. +by exists (fine (ess_infr f)); near do rewrite -lee_fin fineK//; apply/ess_infP. +Unshelve. all: by end_near. Qed. + +Lemma ess_infrZl f (y : R) : mu setT > 0 -> (0 <= y)%R -> + ess_infr (cst y \* f)%R = y%:E * ess_infr f. +Proof. by move=> muT_gt0 r_ge0; rewrite -ess_infZl. Qed. + +Lemma ess_inf_ger f x : 0 < mu [set: T] -> (forall t, x <= (f t)%:E) -> + x <= ess_infr f. +Proof. by move=> muT f0; apply/ess_inf_gee => //=; apply: nearW. Qed. + +Lemma ess_inf_ler f y : (forall t, y <= (f t)%:E) -> y <= ess_infr f. +Proof. by move=> ?; apply/ess_infP; apply: nearW. Qed. + +Lemma ess_inf_cstr y : (0 < mu setT)%E -> (ess_infr (cst y) = y%:E)%E. +Proof. by move=> muN0; rewrite (ess_inf_ae_cst y%:E)//=; apply: nearW. Qed. + +End real_essential_infimum. +Notation ess_infr mu f := (ess_inf mu (EFin \o f)). diff --git a/theories/hoelder.v b/theories/hoelder.v index c86620e027..308e69b7e4 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -1,11 +1,11 @@ (* mathcomp analysis (c) 2017 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 mathcomp_extra unstable boolp classical_sets. -From mathcomp Require Import functions cardinality fsbigop reals ereal. -From mathcomp Require Import topology normedtype sequences real_interval. -From mathcomp Require Import esum measure lebesgue_measure lebesgue_integral. -From mathcomp Require Import numfun exp convex interval_inference. +From mathcomp Require Import mathcomp_extra unstable boolp interval_inference. +From mathcomp Require Import classical_sets functions cardinality fsbigop reals. +From mathcomp Require Import ereal topology normedtype sequences real_interval. +From mathcomp Require Import esum measure ess_sup_inf lebesgue_measure. +From mathcomp Require Import lebesgue_integral numfun exp convex. (**md**************************************************************************) (* # Hoelder's Inequality *) @@ -38,12 +38,12 @@ Declare Scope Lnorm_scope. Local Open Scope ereal_scope. HB.lock Definition Lnorm {d} {T : measurableType d} {R : realType} - (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := + (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> \bar R) := match p with - | p%:E => (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1 + | p%:E => (\int[mu]_x `|f x| `^ p) `^ p^-1 (* (mu (f @^-1` (setT `\ 0%R))) when p = 0? *) - | +oo%E => if mu [set: T] > 0 then ess_sup mu (normr \o f) else 0 - | -oo%E => if mu [set: T] > 0 then ess_inf mu (normr \o f) else 0 + | +oo%E => if mu [set: T] > 0 then ess_sup mu (abse \o f) else 0 + | -oo%E => if mu [set: T] > 0 then ess_inf mu (abse \o f) else 0 end. Canonical locked_Lnorm := Unlockable Lnorm.unlock. Arguments Lnorm {d T R} mu p f. @@ -55,7 +55,7 @@ Variable mu : {measure set T -> \bar R}. Local Open Scope ereal_scope. Implicit Types (p : \bar R) (f g : T -> R) (r : R). -Local Notation "'N_ p [ f ]" := (Lnorm mu p f). +Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). Lemma Lnorm0 p : 1 <= p -> 'N_p[cst 0%R] = 0. Proof. @@ -65,27 +65,25 @@ case: p => [r||//]. have r0 : r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). under eq_integral => x _ do rewrite /= normr0 powR0//. by rewrite integral0 poweR0r// invr_neq0. -case: ifPn => //mu0 _. -rewrite (_ : normr \o _ = 0%R); last by apply: funext => x/=; rewrite normr0. -exact: ess_sup_cst. +case: ifPn => //mu0 _; rewrite (ess_sup_ae_cst 0)//. +by apply: nearW => x; rewrite /= normr0. Qed. Lemma Lnorm1 f : 'N_1[f] = \int[mu]_x `|f x|%:E. Proof. -rewrite unlock invr1// poweRe1//. - by apply: eq_integral => t _; rewrite powRr1. -by apply: integral_ge0 => t _; rewrite powRr1. +rewrite unlock invr1// poweRe1//; under eq_integral do [rewrite poweRe1//=] => //. +exact: integral_ge0. Qed. Lemma Lnorm_ge0 p f : 0 <= 'N_p[f]. Proof. rewrite unlock; move: p => [r/=|/=|//]; first exact: poweR_ge0. - by case: ifPn => // /ess_sup_ger; apply => t/=. -- by case: ifPn => // muT0; apply: ess_inf_ge0 => //=. +- by case: ifPn => // muT0; apply/ess_infP/nearW => x /=. Qed. Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. -Proof. by move=> fg; congr Lnorm; exact/funext. Qed. +Proof. by move=> fg; congr Lnorm; apply/eq_fun => ?; rewrite /= fg. Qed. Lemma Lnorm_eq0_eq0 (f : T -> R) p : measurable_fun setT f -> (0 < p)%E -> 'N_p[f] = 0 -> f = 0%R %[ae mu]. @@ -103,7 +101,9 @@ case: p => [r||//]. move/(ae_eq_integral_abs _ measurableT mp). apply: filterS => x/= /[apply]. by case=> /powR_eq0_eq0 /eqP; rewrite normr_eq0 => /eqP. -- case: ifPn => [mu0 _|]; first exact: ess_sup_eq0_ae. +- case: ifPn => [mu0 _|]. + move=> /abs_sup_eq0_ae_eq/=. + by apply: filterS => x/= /(_ I) /eqP + _; rewrite eqe => /eqP. rewrite ltNge => /negbNE mu0 _ _. suffices mueq0: mu setT = 0 by exact: ae_eq0. by apply/eqP; rewrite eq_le mu0/=. @@ -118,19 +118,16 @@ Qed. Lemma oppr_Lnorm f p : 'N_p[\- f]%R = 'N_p[f]. Proof. -rewrite unlock /Lnorm; case: p => /= [r||//]. -- by under eq_integral => x _ do rewrite normrN. -- rewrite compA (_ : normr \o -%R = normr)//. - by apply: funext => x/=; exact: normrN. -- rewrite compA (_ : normr \o -%R = normr)//. - by apply: funext => x/=; exact: normrN. +have NfE : abse \o (EFin \o (\- f)%R) = abse \o EFin \o f. + by apply/funext => x /=; rewrite normrN. +rewrite unlock /Lnorm NfE; case: p => /= [r|//|//]. +by under eq_integral => x _ do rewrite normrN. Qed. Lemma Lnorm_cst1 r : ('N_r%:E[cst 1%R] = (mu setT)`^(r^-1)). Proof. -rewrite unlock /Lnorm. -under eq_integral => x _ do rewrite normr1 powR1 (_ : 1 = cst 1 x)%R// -indicT. -by rewrite integral_indic// setTI. +rewrite unlock /Lnorm; under eq_integral do rewrite /= normr1 powR1. +by rewrite integral_cst// mul1e. Qed. End Lnorm_properties. @@ -145,11 +142,13 @@ Section lnorm. (* l-norm is just L-norm applied to counting *) Context d {T : measurableType d} {R : realType}. Local Open Scope ereal_scope. -Local Notation "'N_ p [ f ]" := (Lnorm counting p f). +Local Notation "'N_ p [ f ]" := (Lnorm counting p (EFin \o f)). Lemma Lnorm_counting p (f : R^nat) : (0 < p)%R -> 'N_p%:E [f] = (\sum_(k p0; rewrite unlock ge0_integral_count. Qed. +Proof. +by move=> p0; rewrite unlock ge0_integral_count// => k; rewrite poweR_ge0. +Qed. End lnorm. @@ -163,7 +162,7 @@ Let measurableT_comp_powR f p : measurable_fun [set: T] f -> measurable_fun setT (fun x => f x `^ p)%R. Proof. exact: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)). Qed. -Local Notation "'N_ p [ f ]" := (Lnorm mu p f). +Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). Let integrable_powR f p : (0 < p)%R -> measurable_fun [set: T] f -> 'N_p%:E[f] != +oo -> @@ -394,7 +393,7 @@ Let measurableT_comp_powR f p : measurable_fun setT f -> measurable_fun setT (fun x => f x `^ p)%R. Proof. exact: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)). Qed. -Local Notation "'N_ p [ f ]" := (Lnorm mu p f). +Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). Local Open Scope ereal_scope. Let minkowski1 f g p : measurable_fun setT f -> measurable_fun setT g -> @@ -548,32 +547,14 @@ apply: minkowski => //. apply: measurableT_comp => //. Qed. -Lemma le_ess_sup (f g : T -> R) : - measurable_fun setT f -> measurable_fun setT g -> - (forall x, f x <= g x)%R -> ess_sup mu f <= ess_sup mu g. -Proof. -rewrite /ess_sup => mf mg h. -apply: le_ereal_inf => x [r]/= mu0 rx. -exists r => //. -move: mu0. -apply: subset_measure0. -- by rewrite -[X in _ X]setTI; exact: mf. -- by rewrite -[X in _ X]setTI; exact: mg. -move=> t/=. -rewrite !in_itv !andbT/= => fgtt. -by rewrite (lt_le_trans fgtt)//. -Qed. - Lemma minkowskie (f g : T -> R) (p : \bar R) : measurable_fun setT f -> measurable_fun setT g -> 1 <= p -> 'N_p[(f \+ g)%R] <= 'N_p[f] + 'N_p[g]. Proof. case: p => //[r|]; first exact: minkowski. -move=> mf mg _. -rewrite unlock /Lnorm. +move=> mf mg _; rewrite unlock /Lnorm. case: ifPn => mugt0; last by rewrite adde0 lexx. -apply: ess_supD => //. -all: by rewrite gt_eqF// (lt_le_trans ltNy0)// ess_sup_ger// => x/=; rewrite lee_fin normr_ge0. +exact: ess_sup_normD. Qed. End minkowski. diff --git a/theories/lspace.v b/theories/lspace.v index d33e016899..42c2f07225 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -5,7 +5,7 @@ From mathcomp Require Import ssralg ssrnum ssrint interval finmap. From mathcomp Require Import boolp classical_sets interval_inference reals. From mathcomp Require Import functions cardinality topology normedtype ereal. From mathcomp Require Import sequences esum exp measure numfun lebesgue_measure. -From mathcomp Require Import lebesgue_integral hoelder. +From mathcomp Require Import lebesgue_integral hoelder ess_sup_inf. (******************************************************************************) (* *) @@ -30,7 +30,7 @@ Local Open Scope ring_scope. Definition finite_norm d (T : measurableType d) (R : realType) (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := - ('N[ mu ]_p [ f ] < +oo)%E. + ('N[ mu ]_p [ EFin \o f ] < +oo)%E. HB.mixin Record isLfun d (T : measurableType d) (R : realType) (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) (f : T -> R) @@ -113,7 +113,7 @@ apply/integrableP; split; first exact/measurable_EFinP. have := lfuny _ f. rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. by apply integral_ge0 => x _; rewrite lee_fin powRr1. -by under eq_integral => i _ do rewrite powRr1//. +by under eq_integral => i _ do rewrite poweRe1//. Qed. Let le12 : (1 <= 2%:E :> \bar R)%E. @@ -138,6 +138,7 @@ rewrite gt0_ler_poweR//. - rewrite ge0_le_integral//. + apply: measurableT_comp => //; apply/measurable_EFinP. exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). + + by move=> x _; rewrite poweR_ge0. + apply/measurable_EFinP. apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. exact/measurableT_comp. @@ -253,7 +254,7 @@ HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. Lemma LnormZ (f : LfunType mu p1) a : - ('N[mu]_p[a \*: f] = `|a|%:E * 'N[mu]_p[f])%E. + ('N[mu]_p[EFin \o (a \*: f)] = `|a|%:E * 'N[mu]_p[EFin \o f])%E. Proof. rewrite unlock /Lnorm. case: p p1 f => //[r r1 f|]. @@ -265,16 +266,15 @@ case: p p1 f => //[r r1 f|]. exact: measurableT_comp. apply: (@lty_poweRy _ _ r^-1). by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). - have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[f])%E. + have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[EFin \o f])%E. rewrite unlock /Lnorm. by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. exact: (lfuny r1 f). rewrite poweRM ?integral_ge0=> //; rewrite ?lee_fin ?powR_ge0//. by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. - move=> p0 f; case: ifP => mu0; last by rewrite mule0. - rewrite (_ : normr \o a \*: f = `|a| \*: (normr \o f)); last first. - by apply: funext => x/=; rewrite normrZ. - by rewrite ess_supMl. + rewrite -ess_supZl//; apply/eq_ess_sup/nearW => x /=. + by rewrite normrZ EFinM. Qed. Lemma lfun_submod_closed : submod_closed (lfun). @@ -310,9 +310,9 @@ Variable (p : \bar R) (p1 : (1 <= p)%E). (* 0 - + should come with proofs that they are in LfunType mu p *) Notation ty := (LfunType mu p1). -Definition nm f := fine ('N[mu]_p[f]). +Definition nm f := fine ('N[mu]_p[EFin \o f]). -Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[f]. +Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]. Proof. rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. exact: lfuny. @@ -385,12 +385,7 @@ rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. rewrite /finite_norm unlock /Lnorm. move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. move=> r r1. - under eq_integral. - move=> x _. - have -> : (`|f x| `^ r)%:E = `| (`|f x| `^ r) |%:E. - by rewrite ger0_norm// powR_ge0. - over. - rewrite /=. + under eq_integral do rewrite /= -[(_ `^ _)%R]ger0_norm ?powR_ge0//=. rewrite (@integral_abs_eq0 _ _ _ _ setT setT (fun x => (`|f x| `^ r)%:E))//. by rewrite poweR0r// invr_neq0// gt_eqF// -lte_fin (lt_le_trans _ r1). apply/measurable_EFinP. @@ -401,9 +396,7 @@ case=> //[p|]; case=> //[q|] p1 q1; last first. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). move=> muoo _ f. rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. - rewrite poweR_lty//. - have : measurable_fun setT (normr \o f) by exact/measurableT_comp. - move/ess_sup_bounded => /(_ _ supf_lty)[M fM]. + rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. by rewrite integral_cst// lte_mul_pinfty// lee_fin powR_ge0. apply: ae_ge0_le_integral => //. @@ -418,6 +411,7 @@ case=> //[p|]; case=> //[q|] p1 q1; last first. move=> mu_fin pleq f ffin. have:= ffin; rewrite /finite_norm. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). +have pN0 : p != 0%R by rewrite gt_eqF. have q0 : (0 < q)%R by rewrite ?(lt_le_trans ltr01). have qinv0 : q^-1 != 0%R by rewrite invr_neq0// gt_eqF. pose r := q/p. @@ -437,10 +431,9 @@ have r'0 : (0 < r')%R. have rr'1 : r^-1 + r'^-1 = 1%R. by rewrite /r' /r invf_div invrK addrCA subrr addr0. move=> /(_ mfp m1 r0 r'0 rr'1). -under [X in X `^ 1 <= _] eq_integral => x _ do - rewrite powRr1// norm_powR// normrE. -under [X in X`^ r^-1 * mu _ `^_]eq_integral => x _ do - rewrite /r norm_powR normrE ?powR_ge0// -powRrM mulrCA mulfV ?mulr1// ?gt_eqF//. +under [in leLHS] eq_integral do rewrite /= powRr1// norm_powR// normrE. +under [in leRHS] eq_integral do + rewrite /= norm_powR// normr_id -powRrM mulrCA divff// mulr1. rewrite [X in X <= _]poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. move=> h1 /lty_poweRy h2. diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 8a350cbd2a..08ab5c7de8 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -1529,6 +1529,50 @@ Qed. End emeasurable_fun. Arguments emeasurable_fun_cvg {d T R D} f_. +Section ereal_inf_sup_seq. +Context {R : realType}. +Implicit Types (S : set (\bar R)). +Local Open Scope ereal_scope. + +Lemma ereal_inf_seq S : S != set0 -> + {u : nat -> \bar R | forall i, S (u i) & u @ \oo --> ereal_inf S}. +Proof. +move=> SN0; apply/cid2; have [|Ninfy] := eqVneq (ereal_inf S) +oo. + move=> /[dup]/ereal_inf_pinfty/subset_set1/orW[/eqP/negPn/[!SN0]//|->] ->. + by exists (fun=> +oo) => //; apply: cvg_cst. +suff: exists2 v : (\bar R)^nat, v @ \oo --> ereal_inf S & + forall n, exists2 x : \bar R, x \in S & x < v n. + move=> [v vcvg] /(_ _)/sig2W-/all_sig/= [u /all_and2[/(_ _)/set_mem Su u_lt]]. + exists u => //; move: vcvg. + have: cst (ereal_inf S) @ \oo --> ereal_inf S by exact: cvg_cst. + apply: squeeze_cvge; apply: nearW => n; rewrite /cst/=. + by rewrite ereal_inf_le /= 1?ltW; last by exists (u n). +have [infNy|NinfNy] := eqVneq (ereal_inf S) -oo. + exists [sequence - (n%:R%:E)]_n => /=; last first. + by move=> n; setoid_rewrite set_mem_set; apply: lb_ereal_infNy_adherent. + rewrite infNy; apply/cvgNey; under eq_cvg do rewrite EFinN oppeK. + by apply/cvgeryP/cvgr_idn. +have inf_fin : ereal_inf S \is a fin_num by case: ereal_inf Ninfy NinfNy. +exists [sequence ereal_inf S + n.+1%:R^-1%:E]_n => /=; last first. + by move=> n; setoid_rewrite set_mem_set; apply: lb_ereal_inf_adherent. + apply/sube_cvg0 => //=; apply/cvg_abse0P. + rewrite (@eq_cvg _ _ _ _ (fun n => n.+1%:R^-1%:E)). + exact: cvge_harmonic. +by move=> n /=; rewrite /= addrAC subee// add0e gee0_abs//. +Unshelve. all: by end_near. Qed. + +Lemma ereal_sup_seq S : S != set0 -> + {u : nat -> \bar R | forall i, S (u i) & u @ \oo --> ereal_sup S}. +Proof. +move=> SN0; have NSN0 : [set - x | x in S] != set0. + by have /set0P[x Sx] := SN0; apply/set0P; exists (- x), x. +have [u /= Nxu] := ereal_inf_seq NSN0. +rewrite ereal_infN => /cvgeN; rewrite oppeK => Nu_to_sup. +by exists (fun n => - u n) => // i; have [? ? <-] := Nxu i; rewrite oppeK. +Qed. + +End ereal_inf_sup_seq. + Section open_itv_cover. Context {R : realType}. Implicit Types (A : set R). @@ -1598,244 +1642,63 @@ Qed. End open_itv_cover. + Section ereal_supZ. Context {R : realType}. -Implicit Types (r s : R) (A : set R). +Implicit Types (r s : R) (A : set R) (X : set (\bar R)). Local Open Scope ereal_scope. -Lemma ereal_supZl A r : (0 < r)%R -> - ereal_sup [set r%:E * x%:E | x in A] = r%:E * ereal_sup (EFin @` A). +Lemma set_cst I T (x : T) (A : set I) : + [set x | _ in A] = if A == set0 then set0 else [set x]. Proof. -move=> r0. -apply/eqP; rewrite eq_le; apply/andP; split. - (*TODO: should be ereal_sup_le and the current ereal_sup_le should be named something else*) - apply: ub_ereal_sup => /= _ [s As <-]. - rewrite -lee_pdivlMl// muleA -EFinM mulVf ?gt_eqF// mul1e. - by apply: ereal_sup_le; exists s%:E => //=; exists s. -rewrite -lee_pdivlMl//. -apply: ub_ereal_sup => /= _ [s As <-]. -rewrite lee_pdivlMl//. -apply: ereal_sup_le; exists (r * s)%:E => //=. -by exists s => //; rewrite EFinM. -Qed. - -Let ereal_infZl' A r : (0 < r)%R -> - ereal_sup [set - x | x in [set r%:E * x%:E | x in A]] = - r%:E * ereal_sup [set - x | x in [set x%:E | x in A]]. -Proof. -move=> r0. -apply/eqP; rewrite eq_le; apply/andP; split. - apply: ub_ereal_sup => /= _ [_ [s As <-]] <-. - rewrite -muleN -lee_pdivlMl// muleA -EFinM mulVf ?gt_eqF// mul1e. - apply: ereal_sup_le; exists (- s%:E) => //=. - exists s%:E. - by exists s. - by rewrite EFinN. -rewrite -lee_pdivlMl//. -apply: ub_ereal_sup => /= _ [_ [s As <-]] <-. -rewrite lee_pdivlMl//. -apply: ereal_sup_le; exists (- (r * s)%:E) => //=. - exists (r * s)%:E. - by exists s => //; rewrite EFinM. - by rewrite EFinN. -by rewrite EFinN muleN -EFinM EFinN. +apply/seteqP; split=> y /=. + by case=> i Ai ->; case: ifP => //= /eqP A0; rewrite A0 in Ai. +by case: ifPn => //= /set0P[i Ai ->]; exists i. Qed. -Lemma ereal_infZl A r : (0 < r)%R -> - ereal_inf [set r%:E * x%:E | x in A] = r%:E * ereal_inf (EFin @` A). +Lemma ereal_sup_cst T x (A : set T) : A != set0 -> + ereal_sup [set x | _ in A] = x :> \bar R. +Proof. by move=> AN0; rewrite set_cst ifN// ereal_sup1. Qed. + +Lemma ereal_inf_cst T x (A : set T) : A != set0 -> + ereal_inf [set x | _ in A] = x :> \bar R. +Proof. by move=> AN0; rewrite set_cst ifN// ereal_inf1. Qed. + +Lemma ereal_sup_pZl X r : (0 < r)%R -> + ereal_sup [set r%:E * x | x in X] = r%:E * ereal_sup X. Proof. -move=> r0; rewrite /ereal_inf muleN; congr -%E. -exact: ereal_infZl'. +move=> /[dup] r_gt0; rewrite lt0r => /andP[r_neq0 r_ge0]. + gen have gen : r r_gt0 {r_ge0 r_neq0} X / + ereal_sup [set r%:E * x | x in X] <= r%:E * ereal_sup X. + apply/ereal_supP => y/= [x Ax <-]; rewrite lee_pmul2l//=. + by apply/ereal_supP => //=; exists x. +apply/eqP; rewrite eq_le gen//= -lee_pdivlMl//. +rewrite (le_trans _ (gen _ _ _)) ?invr_gt0 ?image_comp//=. +by under eq_imagel do rewrite /= muleA -EFinM mulVf ?mul1e//=; rewrite image_id. Qed. -End ereal_supZ. - -Section essential_supremum. -Context d {T : measurableType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Implicit Types f g : T -> R. -Local Open Scope ereal_scope. +Lemma ereal_supZl X r : X != set0 -> (0 <= r)%R -> + ereal_sup [set r%:E * x | x in X] = r%:E * ereal_sup X. +Proof. +move=> AN0; have [r_gt0|//|<-] := ltgtP => _; first by rewrite ereal_sup_pZl. +by rewrite mul0e; under eq_imagel do rewrite mul0e/=; rewrite ereal_sup_cst. +Qed. + +Lemma ereal_inf_pZl X r : (0 < r)%R -> + ereal_inf [set r%:E * x | x in X] = r%:E * ereal_inf X. +Proof. +move=> r_gt0; rewrite !ereal_infEN muleN image_comp/=; congr (- _). +by under eq_imagel do rewrite /= -muleN; rewrite -image_comp ereal_sup_pZl. +Qed. -Lemma ess_sup_bounded f : measurable_fun setT f -> ess_sup mu f < +oo -> - exists M, \forall x \ae mu, (f x <= M)%R. -Proof. -move=> mf /ereal_inf_lt[_ /= [r fr0] <-] _. -exists r, (f @^-1` `]r, +oo[); split => //. - rewrite (_ : _ @^-1` _ = [set t | r%:E < (f t)%:E]); last first. - by apply/seteqP; split => [x|x]/=; rewrite in_itv/= andbT. - rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. -by move=> t/= ftr; rewrite in_itv/= andbT ltNge; exact/negP. -Qed. - -Lemma ess_sup_max f : measurable_fun setT f -> - ess_sup mu (normr \o f) != -oo -> - mu [set r | ess_sup mu (normr \o f) < `|f r|%:E] = 0. -Proof. -move=> mf fNy. -move hm : (ess_sup mu (normr \o f)) => m. -case: m hm => [m| |] hm. -- pose x_ n := m%:E + n.+1%:R^-1%:E. - have -> : [set r | m%:E < `|f r|%:E] = \bigcup_n [set r | x_ n < `|f r|%:E]. - apply/seteqP; split => [r /= mfr|r/=]. - near \oo => n. - suff : x_ n < `|f r|%:E by move=> ?; exists n. - rewrite /x_ -EFinD lte_fin -ltrBrDl. - rewrite invf_plt ?posrE//; last by rewrite subr_gt0 -lte_fin. - by rewrite -natr1 -ltrBlDr; near: n; exact: nbhs_infty_gtr. - by move=> [n _/=]; apply: le_lt_trans;rewrite /x_ -EFinD lee_fin lerDl. - have H n : mu [set r | x_ n < `|f r|%:E] = 0%R. - have : ess_sup mu (normr \o f) \is a fin_num by rewrite hm. - move/lb_ereal_inf_adherent => /(_ n.+1%:R^-1). - rewrite invr_gt0// ltr0n => /(_ erefl)[_ /= [r/= mufr0] <-]. - rewrite -/(ess_sup mu _) hm /x_ => rmn. - apply/eqP; rewrite eq_le measure_ge0 andbT. - rewrite -mufr0 le_measure// ?inE//. - + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. - + rewrite (_ : _ @^-1` _ = [set t | r%:E < `|f t|%:E]); last first. - by apply/seteqP; split => [x|x]/=; rewrite in_itv/= andbT. - rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. - + move=> x/=; rewrite in_itv/= andbT. - rewrite -EFinD lte_fin; apply/le_lt_trans. - by move: rmn; rewrite -EFinD lte_fin => /ltW. - apply/eqP; rewrite eq_le measure_ge0 andbT. - have <- : \sum_(0 <= i [i|]. - + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. - + apply: bigcup_measurable => i _. - rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. -- rewrite (_ : [set r | +oo < `|f r|%:E] = set0)// -subset0 => x/=. - by rewrite ltNge leey. -- by rewrite hm in fNy. -Unshelve. all: by end_near. Qed. +Lemma ereal_infZl X r : X != set0 -> (0 < r)%R -> + ereal_sup [set r%:E * x | x in X] = r%:E * ereal_sup X. +Proof. +move=> XN0 r_gt0; rewrite !ereal_supEN muleN image_comp/=; congr (- _). +by under eq_imagel do rewrite /= -muleN; rewrite -image_comp ereal_inf_pZl. +Qed. -Lemma ess_sup_eq0 f : measurable_fun setT f -> - f = 0%R %[ae mu] <-> mu [set r | (0%R < `|f r|)%R] = 0. -Proof. -move=> mf; split=> [|f0]. -- case => N [mN N0 fN]. - apply/eqP; rewrite eq_le measure_ge0 andbT -N0. - rewrite le_measure ?inE//. - rewrite [X in measurable X](_ : _ = [set t | 0 < `|f t|%:E]); last first. - by apply/seteqP; split => [x|x]/=; rewrite lte_fin. - rewrite -[X in measurable X]setTI. - apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. - apply: subset_trans fN => t/= ft0. - apply/not_implyP; split => //. - apply/eqP. - by rewrite -normr_eq0 gt_eqF. -- exists [set r | (0 < `|f r|)%R]; split => //. - rewrite [X in measurable X](_ : _ = [set t | 0 < `|f t|%:E]); last first. - by apply/seteqP; split => [x|x]/=; rewrite lte_fin. - rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. - move=> t/= /not_implyP[_ /eqP]; rewrite -normr_eq0 => ft0. - by rewrite lt_neqAle eq_sym ft0/=. -Qed. - -Lemma ess_sup_eq0_ae f : measurable_fun setT f -> - ess_sup mu (normr \o f) = 0 -> f = 0%R %[ae mu]. -Proof. -move=> mf f0; apply/ess_sup_eq0 => //. -rewrite [X in mu X](_ : _ = [set r | (0 < `|f r|%:E)%E]); last first. - by apply/seteqP; split => [x|x]/=; rewrite lte_fin. -by rewrite -f0 ess_sup_max// f0. -Qed. - -Lemma ess_supMl f (r : R) : mu setT > 0 -> (0 <= r)%R -> - ess_sup mu (cst r \* f)%R = r%:E * ess_sup mu f. -Proof. -move=> muT0; rewrite le_eqVlt => /predU1P[<-|r0]. - rewrite mul0e (_ : _ \* f = cst 0)%R; first by rewrite ess_sup_cst. - by apply/funext => ?; rewrite /= mul0r. -rewrite -ereal_infZl//. -have rf s : (cst r \* f)%R @^-1` `]s, +oo[ = f%R @^-1` `]s / r, +oo[. - by apply/seteqP; split => [y|y]/=; rewrite !in_itv/= !andbT; - rewrite ltr_pdivrMr// mulrC. -congr ereal_inf; apply/seteqP; split => [_ [s /= M <-]|_ [s /= M <-]]/=. -- exists (s / r)%R; first by rewrite -rf. - by rewrite EFinM muleCA -EFinM divff ?mulr1// gt_eqF. -- exists (r * s)%R; last by rewrite EFinM. - by rewrite rf mulrAC divff ?mul1r// gt_eqF. -Qed. - -Lemma ess_sup_ub f : measurable_fun setT f -> ess_sup mu (normr \o f) != -oo -> - {ae mu, forall x, `|f x|%:E <= ess_sup mu (normr \o f)}. -Proof. -move=> mf fNy. -have [->|] := eqVneq (ess_sup mu (normr \o f)) +oo. - by apply/nearW => ?; rewrite leey. -rewrite -ltey => fy. -exists [set r | ess_sup mu (normr \o f) < `|f r|%:E]. -split. -- rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. - by apply/measurable_EFinP; exact/measurableT_comp. -- exact: ess_sup_max. -- by move=> t/= /negP; rewrite -ltNge. -Qed. - -Lemma ess_supD f g : - measurable_fun setT f -> measurable_fun setT g -> - ess_sup mu (normr \o f) != -oo -> ess_sup mu (normr \o g) != -oo -> - ess_sup mu (normr \o (f \+ g)) <= - ess_sup mu (normr \o f) + ess_sup mu (normr \o g). -Proof. -move=> mf mg fNy gNy. -have [->|] := eqVneq (ess_sup mu (normr \o f)) +oo. - by rewrite addye// leey. -rewrite -ltey => fy. -have [->|] := eqVneq (ess_sup mu (normr \o g)) +oo. - by rewrite addey// leey. -rewrite -ltey => gy. -pose a := ess_sup mu (normr \o f); pose b := ess_sup mu (normr \o g). -have a_fin_num : a \is a fin_num by rewrite fin_real// fy andbT ltNye. -have b_fin_num : b \is a fin_num by rewrite fin_real// gy andbT ltNye. -have fa : {ae mu, forall x, `|f x|%:E <= a}. - exact: ess_sup_ub. -have gb : {ae mu, forall x, `|g x|%:E <= b}. - exact: ess_sup_ub. -have {fa gb}fg : - {ae mu, forall x, (((normr \o f) \+ (normr \o g)) x)%:E <= a + b}. - case: fa => A [mA A0 Af]. - case: gb => B [mB B0 Bg]. - exists (A `|` B); split; first exact: measurableU. - by rewrite measureU0. - move=> t/= /negP; rewrite -ltNge => abfg. - have [At|At] := pselect (A t); [by left|right]. - apply: Bg => //=. - apply: contra_not At => gb. - apply: Af => /= fa. - have : (`|f t|%R + `|g t|%R)%E%:E <= a + b. - by rewrite EFinD leeD. - by rewrite leNgt abfg. -apply: ereal_inf_lbound => /=. -exists (fine a + fine b). - case: fg => N [mN N0 fgN]. - apply/eqP; rewrite eq_le measure_ge0 andbT -N0. - rewrite le_measure ?inE//. - rewrite -[X in measurable X]setTI. - have : measurable_fun setT (normr \o (f \+ g)). - apply: measurableT_comp => //. - exact: measurable_funD. - exact. - apply: subset_trans fgN => t/=. - rewrite in_itv/= andbT => abfg. - apply/negP; rewrite -ltNge. - rewrite -lte_fin in abfg. - (* TODO: we don't have lee_absD? *) - rewrite (@lt_le_trans _ _ `|(f t + g t)|%:E)%R//. - by move: abfg; rewrite EFinD !fineK. - exact: ler_normD. -by rewrite EFinD !fineK. -Qed. - -End essential_supremum. +End ereal_supZ. Section egorov. Context d {R : realType} {T : measurableType d}. diff --git a/theories/measure.v b/theories/measure.v index 3fddb6f858..a49d705b5b 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -273,9 +273,6 @@ From mathcomp Require Import sequences esum numfun. (* ## 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 *) -(* ess_inf f == essential infimum *) (* ``` *) (* *) (******************************************************************************) @@ -1307,6 +1304,10 @@ 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. @@ -1999,6 +2000,10 @@ 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. @@ -4252,6 +4257,19 @@ 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//. + rewrite eseries0// => i _ _. + rewrite (@subset_measure0 _ _ _ _ _ (A i))//=. + exact: subset_seqDU. +- by move=> x /=; rewrite -existsNP => -[n NPnx]; exists n => //; apply: NPA. +Qed. + End ae_eq. Section ae_eq_lemmas. @@ -5404,51 +5422,3 @@ Proof. by move=> mE m21 [A [mA A0 ?]]; exists A; split => //; exact: m21. Qed. End absolute_continuity_lemmas. -Section essential_supremum. -Context d {T : semiRingOfSetsType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Implicit Types f : T -> R. - -Definition ess_sup f := - ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). - -Lemma ess_sup_ger f x : 0 < mu [set: T] -> (forall t, x <= (f t)%:E) -> - x <= ess_sup f. -Proof. -move=> muT f0; apply: lb_ereal_inf => _ /= [r /eqP fr0 <-]; rewrite leNgt. -apply/negP => rx; apply/negP : fr0; rewrite gt_eqF// (_ : _ @^-1` _ = setT)//. -apply/seteqP; split => // t _ /=; rewrite in_itv/= andbT. -by rewrite -lte_fin (lt_le_trans _ (f0 t)). -Qed. - -Lemma ess_sup_ler f r : (forall t, (f t)%:E <= r) -> ess_sup f <= r. -Proof. -case: r => [r| |] fr; last 2 first. - by rewrite leey. - by have := fr point; rewrite leNgt ltNye. -apply: ereal_inf_le; apply/exists2P. -exists r%:E => /=; split => //; apply/exists2P; exists r; split => //. -rewrite preimage_itvoy [X in mu X](_ : _ = set0)// -subset0 => x //=. -rewrite lt_neqAle => /andP[+ rlefx]. -by apply/negP/negPn; rewrite eq_le rlefx/= -lee_fin. -Qed. - -Lemma ess_sup_cst r : (0 < mu setT)%E -> (ess_sup (cst r) = r%:E)%E. -Proof. -move => mu0. -by apply/eqP; rewrite eq_le; apply/andP; split; - [exact: ess_sup_ler|exact: ess_sup_ger]. -Qed. - -Definition ess_inf f := - ereal_sup (EFin @` [set r | mu (f @^-1` `]-oo, r[) = 0]). - -Lemma ess_inf_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> - 0 <= ess_inf f. -Proof. -move=> muT f0; apply: ereal_sup_le; exists 0 => //=; exists 0%R => //=. -rewrite [X in mu X](_ : _ = set0)// -subset0 => x/=. -by rewrite in_itv/= ltNge => /negP; exact. -Qed. - -End essential_supremum. diff --git a/theories/sequences.v b/theories/sequences.v index c32d939ad9..510e52329d 100644 --- a/theories/sequences.v +++ b/theories/sequences.v @@ -282,6 +282,9 @@ apply/funext => n; rewrite -setIDA; apply/seteqP; split; last first. by rewrite /seqDU -setIDA bigcup_mkord -big_distrr/= setDIr setIUr setDIK set0U. Qed. +Lemma subset_seqDU (A : (set T)^nat) (i : nat) : seqDU A i `<=` A i. +Proof. by move=> ?; apply: subDsetl. Qed. + End seqDU. Arguments trivIset_seqDU {T} F. #[global] Hint Resolve trivIset_seqDU : core. From 56a5fee2180404dfd451ce2274d53c089aeca34b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 14 Mar 2025 23:55:04 +0900 Subject: [PATCH 19/73] fix CI --- experimental_reals/discrete.v | 2 +- reals/reals.v | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 412877a07b..63ca0e73b8 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -4,7 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -From Coq Require Setoid. +From Corelib Require Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. diff --git a/reals/reals.v b/reals/reals.v index 90bb30d878..601ad4fe7c 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -38,7 +38,7 @@ (* *) (******************************************************************************) -From Coq Require Import Setoid. +From Corelib Require Import Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import boolp classical_sets set_interval. From b7e731802033900527de4cbf5c2eeb5beae5c0c9 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 15 Mar 2025 00:42:00 +0900 Subject: [PATCH 20/73] changelog --- CHANGELOG_UNRELEASED.md | 207 ++++++++++++++++++++++++++++++++++++++++ theories/ess_sup_inf.v | 5 +- 2 files changed, 209 insertions(+), 3 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 0a229bd6bc..3564f44f6f 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -70,6 +70,145 @@ - in `pi_irrational`: + definition `rational` +- new directory `lebesgue_integral_theory` with new files: + + `simple_functions.v` + + `lebesgue_integral_definition.v` + + `lebesgue_integral_approximation.v` + + `lebesgue_integral_monotone_convergence.v` + + `lebesgue_integral_nonneg.v` + + `lebesgue_integrable.v` + + `lebesgue_integral_dominated_convergence.v` + + `lebesgue_integral_under.v` + + `lebesgue_Rintegral.v` + + `lebesgue_integral_fubini.v` + + `lebesgue_integral_differentiation.v` + + `lebesgue_integral.v` +- in `boolp.v`: + + lemmas `orW`, `or3W`, `or4W` + +- in `classical_sets.v`: + + lemma `image_nonempty` + +- in `mathcomp_extra.v`: + + lemmas `eq_exists2l`, `eq_exists2r` + +- in `ereal.v`: + + lemmas `ereal_infEN`, `ereal_supN`, `ereal_infN`, `ereal_supEN` + + lemmas `ereal_supP`, `ereal_infP`, `ereal_sup_gtP`, `ereal_inf_ltP`, + `ereal_inf_leP`, `ereal_sup_geP`, `lb_ereal_infNy_adherent`, + `ereal_sup_real`, `ereal_inf_real` + +- in `charge.v`: + + lemma `ae_eq_mul2l` + +- in `hoelder.v` + + lemmas `Lnorm0`, `oppr_Lnorm`, `Lnorm_cst1` + + lemmas `minkowski'`, `minkowskie` + +- in `lebesgue_integral.v`: + + lemma `mfunMn` + +- in `measurable_realfun.v`: + + lemmas `ereal_inf_seq`, `ereal_sup_seq`, `set_cst`, + `ereal_sup_cst`, `ereal_inf_cst`, `ereal_sup_pZl`, + `ereal_supZl`, `ereal_inf_pZl`, `ereal_infZl` + +- in `measure.v`: + + lemmas `seqDU_measurable`, `measure_gt0` + + notation `\forall x \ae mu , P` + + notations `f = g %[ae mu in D ]`, `f = g %[ae mu ]` + + module `ProperNotations` with notations `++>`, `==>`, `~~>` + + instances `comp_ae_eq`, `comp_ae_eq2`, `comp_ae_eq2'`, `sub_ae_eq2` + + lemmas `ae_eq_comp2`, `ae_foralln` + +- new file `ess_sup_inf.v`: + + lemma `measure0_ae` + + definition `ess_esup` + + lemmas `ess_supEae`, `ae_le_measureP`, `ess_supEmu0`, `ess_sup_ge`, + `ess_supP`, `le_ess_sup`, `eq_ess_sup`, `ess_sup_cst`, `ess_sup_ae_cst`, + `ess_sup_gee`, `abs_sup_eq0_ae_eq`, `abs_ess_sup_eq0`, `ess_sup_pZl`, + `ess_supZl`, `ess_sup_eqNyP`, `ess_supD`, `ess_sup_absD` + + notation `ess_supr` + + lemmas `ess_supr_bounded`, `ess_sup_eqr0_ae_eq`, `ess_suprZl`, + `ess_sup_ger`, `ess_sup_ler`, `ess_sup_cstr`, `ess_suprD`, `ess_sup_normD` + + definition `ess_inf` + + lemmas `ess_infEae`, `ess_infEN`, `ess_supEN`, `ess_infN`, `ess_supN`, + `ess_infP`, `ess_inf_le`, `le_ess_inf`, `eq_ess_inf`, `ess_inf_cst`, + `ess_inf_ae_cst`, `ess_inf_gee`, `ess_inf_pZl`, `ess_infZl`, `ess_inf_eqyP`, + `ess_infD` + + notation `ess_infr` + + lemmas `ess_infr_bounded`, `ess_infrZl`, `ess_inf_ger`, `ess_inf_ler`, + `ess_inf_cstr` + +- new file `lspace.v`: + + definition `finite_norm` + + mixin `isLfun` with field `lfuny` + + structure `Lfun` + + notation `LfunType` + + definition `Lequiv` + + canonical `Lequiv_canonical` + + definition `LspaceType` + + canonicals `LspaceType_quotType`, `LspaceType_eqType`, `LspaceType_choiceType`, + `LspaceType_eqQuotType` + + lemma `LequivP` + + record `LType` + + coercion `LfunType_of_LType` + + definition `Lspace` with notation `mu.-Lspace p` + + lemma `LType1_integrable`, `LType2_integrable_sqr` + + definition `conjugate` + + lemma `conjugateE` + + definitions `finlfun`, `lfun`, `lfun_key` + + canonical `lfun_keyed` + + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` + + definition `lfun_Sub` + + lemmas `lfun_rect`, `lfun_valP`, `lfuneqP`, `lfuny0`, `mfunP`, `lfunP`, + `mfun_scaler_closed` + + lemmas `LnormZ`, `lfun_submod_closed` + + definition `nm` + + lemmas `finite_norm_fine`, `ler_Lnorm_add`, `natmulfctE`, + `LnormN`, `enatmul_ninfty`, `Lnorm_natmul`, `nm_eq0` + + lemma `mul_lte_pinfty` + + lemma `Lspace_inclusion` + +- in `nat_topology.v`: + + lemma `nbhs_infty_gtr` + +### Changed + +- file `nsatz_realtype.v` moved from `reals` to `reals-stdlib` package +- moved from `gauss_integral` to `trigo.v`: + + `oneDsqr`, `oneDsqr_ge1`, `oneDsqr_inum`, `oneDsqrV_le1`, + `continuous_oneDsqr`, `continuous_oneDsqr` +- moved, generalized, and renamed from `gauss_integral` to `trigo.v`: + + `integral01_oneDsqr` -> `integral0_oneDsqr` + +- in `interval_inference.v`: + + definition `IntItv.exprn_le1_bound` + + lemmas `Instances.nat_spec_succ`, `Instances.num_spec_natmul`, + `Instances.num_spec_intmul`, `Instances.num_itv_bound_exprn_le1` + + canonical instance `Instances.succn_inum` + +- in `lebesgue_integral_properties.v` + (new file with contents moved from `lebesgue_integral.v`) + + `le_normr_integral` renamed to `le_normr_Rintegral` + +- moved to `lebesgue_measure.v` (from old `lebesgue_integral.v`) + + `compact_finite_measure` + +- moved from `ftc.v` to `lebesgue_integral_under.v` (new file) + + notation `'d1`, definition `partial1of2`, lemmas `partial1of2E`, + `cvg_differentiation_under_integral`, `differentiation_under_integral`, + `derivable_under_integral` +- in `hoelder.v`: + + lemmas `Lnorm_eq0_eq0` + +- in `lebesgue_integral.v`: + + lemmas `ae_eq_integral_abs`, `ge0_ae_eq_integral`, `ae_eq_integral` + +- in `measurable.v` + + from instance to definitions: `ae_filter_ringOfSetsType`, `ae_properfilter_algebraOfSetsType` + + definiton `ae_eq` + + definition `ess_sup` moved to `ess_sup_inf.v` ### Renamed @@ -100,6 +239,33 @@ - in `measurable_realfun.v` + lemma `measurable_ln` +- in `ereal.v`: + + lemmas `ereal_infEN`, `ereal_supN`, `ereal_infN`, `ereal_supEN` + + lemmas `ereal_supP`, `ereal_infP`, `ereal_sup_gtP`, `ereal_inf_ltP`, + `ereal_inf_leP`, `ereal_sup_geP`, `lb_ereal_infNy_adherent`, + `ereal_sup_real`, `ereal_inf_real` +- in `boolp.v`: + + `eq_fun2` -> `eq2_fun` + + `eq_fun3` -> `eq3_fun` + + `eq_forall2` -> `eq2_forall` + + `eq_forall3` -> `eq3_forall` +- in `ereal.v`: + + `ereal_sup_le` -> `ereal_sup_ge` + +### Generalized + +- in `constructive_ereal.v`: + + lemma `EFin_natmul` + +- in `lebesgue_integral.v` + + lemmas `measurable_funP`, `ge0_integral_pushforward`, + `integrable_pushforward`, `integral_pushforward` + +- in `real_interval.v`: + + lemmas `bigcup_itvT`, `itv_bndy_bigcup_BRight`, `itv_bndy_bigcup_BLeft_shift` +- in `hoelder.v`: + + definition `Lnorm` generalized to functions with codomain `\bar R` + (this impacts the notation `'N_p[f]`) ### Deprecated @@ -107,6 +273,47 @@ - in `functions.v`: + definitions `fct_ringMixin`, `fct_ringMixin` (was only used in an `HB.instance`) +- file `mathcomp_extra.v` + + lemma `Pos_to_natE` (moved to `Rstruct.v`) + + lemma `deg_le2_ge0` (available as `deg_le2_poly_ge0` in `ssrnum.v` + since MathComp 2.1.0) + + definitions `monotonous`, `boxed`, `onem`, `inv_fun`, + `bound_side`, `swap`, `prodA`, `prodAr`, `map_pair`, `sigT_fun` + (moved to new file `unstable.v` that shouldn't be used outside of + Analysis) + + notations `` `1 - r ``, `f \^-1` (moved to new file `unstable.v` + that shouldn't be used outside of Analysis) + + lemmas `dependent_choice_Type`, `maxr_absE`, `minr_absE`, + `le_bigmax_seq`, `bigmax_sup_seq`, `leq_ltn_expn`, `last_filterP`, + `path_lt_filter0`, `path_lt_filterT`, `path_lt_head`, + `path_lt_last_filter`, `path_lt_le_last`, `sumr_le0`, + `fset_nat_maximum`, `image_nat_maximum`, `card_fset_sum1`, + `onem0`, `onem1`, `onemK`, `add_onemK`, `onem_gt0`, `onem_ge0`, + `onem_le1`, `onem_lt1`, `onemX_ge0`, `onemX_lt1`, `onemD`, + `onemMr`, `onemM`, `onemV`, `lez_abs2`, `ler_gtP`, `ler_ltP`, + `real_ltr_distlC`, `prodAK`, `prodArK`, `swapK`, `lt_min_lt`, + `intrD1`, `intr1D`, `floor_lt_int`, `floor_ge0`, `floor_le0`, + `floor_lt0`, `floor_eq`, `floor_neq0`, `ceil_gt_int`, `ceil_ge0`, + `ceil_gt0`, `ceil_le0`, `abs_ceil_ge`, `nat_int`, `bij_forall`, + `and_prop_in`, `mem_inc_segment`, `mem_dec_segment`, + `partition_disjoint_bigfcup`, `partition_disjoint_bigfcup`, + `prodr_ile1`, `size_filter_gt0`, `ltr_sum`, `ltr_sum_nat` (moved + to new file `unstable.v` that shouldn't be used outside of + Analysis) + +- in `reals.v`: + + lemmas `floor_le`, `le_floor` (deprecated since 1.3.0) + +- file `lebesgue_integral.v` (split in several files in the directory + `lebesgue_integral_theory`) + +- in `classical_sets.v`: + + notations `setvI`, `setIv`, `bigcup_set`, `bigcup_set_cond`, `bigcap_set`, + `bigcap_set_cond` + +- in `measure.v`: + + definition `almost_everywhere_notation` + + lemma `ess_sup_ge0` - in `measurable_realfun.v`: + notation `measurable_fun_ln` (deprecated since 0.6.3) diff --git a/theories/ess_sup_inf.v b/theories/ess_sup_inf.v index 71ad495f55..2312636ef0 100644 --- a/theories/ess_sup_inf.v +++ b/theories/ess_sup_inf.v @@ -124,7 +124,7 @@ by rewrite -[0]ess_sup_cst// le_ess_sup//=; near=> x; rewrite abse_ge0. Unshelve. all: by end_near. Qed. Lemma ess_sup_pZl f (a : R) : (0 < a)%R -> - (ess_sup (cst a%:E \* f) = a%:E * ess_sup f). + ess_sup (cst a%:E \* f) = a%:E * ess_sup f. Proof. move=> /[dup] /ltW a_ge0 a_gt0. gen have esc_le : a f a_ge0 a_gt0 / @@ -136,9 +136,8 @@ by under eq_fun do rewrite muleA -EFinM mulVf ?mul1e ?gt_eqF//. Unshelve. all: by end_near. Qed. Lemma ess_supZl f (a : R) : mu [set: T] > 0 -> (0 <= a)%R -> - (ess_sup (cst a%:E \* f) = a%:E * ess_sup f). + ess_sup (cst a%:E \* f) = a%:E * ess_sup f. Proof. - move=> muTN0; case: ltgtP => // [a_gt0|<-] _; first exact: ess_sup_pZl. by under eq_fun do rewrite mul0e; rewrite mul0e ess_sup_cst. Qed. From 474f2db3c326ff25bc915e09f5164ccd58d6155d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 15 Mar 2025 15:47:28 +0900 Subject: [PATCH 21/73] doc, renamings, minor fixes --- CHANGELOG_UNRELEASED.md | 23 +-- classical/functions.v | 4 + experimental_reals/discrete.v | 1 - theories/hoelder.v | 91 +++++++++--- .../lebesgue_integral_nonneg.v | 13 +- .../simple_functions.v | 3 + theories/lspace.v | 136 ++++++------------ theories/measurable_realfun.v | 15 +- 8 files changed, 149 insertions(+), 137 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 3564f44f6f..402c9588f0 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -103,13 +103,18 @@ - in `hoelder.v` + lemmas `Lnorm0`, `oppr_Lnorm`, `Lnorm_cst1` - + lemmas `minkowski'`, `minkowskie` + + definition `conjugate` + + lemma `conjugateE` + + lemmas `lerB_DLnorm`, `lerB_LnormD`, `eminkowski` - in `lebesgue_integral.v`: + lemma `mfunMn` +- in `classical_sets.v`: + + lemma `set_cst` + - in `measurable_realfun.v`: - + lemmas `ereal_inf_seq`, `ereal_sup_seq`, `set_cst`, + + lemmas `ereal_inf_seq`, `ereal_sup_seq`, `ereal_sup_cst`, `ereal_inf_cst`, `ereal_sup_pZl`, `ereal_supZl`, `ereal_inf_pZl`, `ereal_infZl` @@ -121,6 +126,9 @@ + instances `comp_ae_eq`, `comp_ae_eq2`, `comp_ae_eq2'`, `sub_ae_eq2` + lemmas `ae_eq_comp2`, `ae_foralln` +- in `functions.v`: + + lemma `natmulfctE` + - new file `ess_sup_inf.v`: + lemma `measure0_ae` + definition `ess_esup` @@ -155,8 +163,6 @@ + coercion `LfunType_of_LType` + definition `Lspace` with notation `mu.-Lspace p` + lemma `LType1_integrable`, `LType2_integrable_sqr` - + definition `conjugate` - + lemma `conjugateE` + definitions `finlfun`, `lfun`, `lfun_key` + canonical `lfun_keyed` + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` @@ -164,10 +170,8 @@ + lemmas `lfun_rect`, `lfun_valP`, `lfuneqP`, `lfuny0`, `mfunP`, `lfunP`, `mfun_scaler_closed` + lemmas `LnormZ`, `lfun_submod_closed` - + definition `nm` - + lemmas `finite_norm_fine`, `ler_Lnorm_add`, `natmulfctE`, - `LnormN`, `enatmul_ninfty`, `Lnorm_natmul`, `nm_eq0` - + lemma `mul_lte_pinfty` + + lemmas `finite_norm_fine`, `ler_LnormD`, + `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` + lemma `Lspace_inclusion` - in `nat_topology.v`: @@ -252,6 +256,9 @@ - in `ereal.v`: + `ereal_sup_le` -> `ereal_sup_ge` +- in `hoelder.v`: + + `minkowski` -> `minkowski_EFin` + ### Generalized - in `constructive_ereal.v`: diff --git a/classical/functions.v b/classical/functions.v index 1af52e51fe..e1fa4cb293 100644 --- a/classical/functions.v +++ b/classical/functions.v @@ -2702,6 +2702,10 @@ Proof. by []. Qed. Definition fctE := (cstE, compE, opprfctE, addrfctE, mulrfctE, scalrfctE, exprfctE). +Lemma natmulfctE (U : pointedType) (K : ringType) (f : U -> K) n : + f *+ n = (fun x => f x *+ n). +Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. + End function_space_lemmas. Lemma inv_funK T (R : unitRingType) (f : T -> R) : f\^-1\^-1%R = f. diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 63ca0e73b8..9681124ea2 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -21,7 +21,6 @@ Local Open Scope ring_scope. Local Open Scope real_scope. Section ProofIrrelevantChoice. - Context {T : choiceType}. Lemma existsTP (P : T -> Prop) : { x : T | P x } + (forall x, ~ P x). diff --git a/theories/hoelder.v b/theories/hoelder.v index 308e69b7e4..cef31f34fd 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -10,10 +10,15 @@ From mathcomp Require Import lebesgue_integral numfun exp convex. (**md**************************************************************************) (* # Hoelder's Inequality *) (* *) -(* This file provides Hoelder's inequality and its consequences, most notably *) -(* Minkowski's inequality and the convexity of the power function. *) +(* This file provides the Lp-norm, Hoelder's inequality and its consequences, *) +(* most notably Minkowski's inequality and the convexity of the power *) +(* function. *) +(* *) (* ``` *) -(* 'N[mu]_p[f] == the p-norm of f with measure mu *) +(* 'N[mu]_p[f] == the Lp-norm of f with measure mu *) +(* conjugate p == a real number q such that p^-1 + q^-1 = 1 when *) +(* p is real, otherwise conjugate +oo = 1 and *) +(* conjugate -oo = 0 *) (* ``` *) (* *) (******************************************************************************) @@ -139,9 +144,9 @@ Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnorm_ge0] : core. Notation "'N[ mu ]_ p [ f ]" := (Lnorm mu p f). Section lnorm. -(* l-norm is just L-norm applied to counting *) Context d {T : measurableType d} {R : realType}. Local Open Scope ereal_scope. +(** lp-norm is just Lp-norm applied to counting *) Local Notation "'N_ p [ f ]" := (Lnorm counting p (EFin \o f)). Lemma Lnorm_counting p (f : R^nat) : (0 < p)%R -> @@ -152,6 +157,39 @@ Qed. End lnorm. +Section conjugate. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R). +Hypothesis (p1 : (1 <= p)%E). + +Local Open Scope classical_set_scope. +Local Open Scope ereal_scope. + +Definition conjugate := + match p with + | r%:E => [get q : R | r^-1 + q^-1 = 1]%:E + | +oo => 1 + | -oo => 0 + end. + +Lemma conjugateE : + conjugate = if p is r%:E then (r * (r-1)^-1)%:E + else if p == +oo then 1 else 0. +Proof. +rewrite /conjugate. +case: p p1 => [r|//=|//]. +rewrite lee_fin => r1. +have r0 : r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). +congr EFin; apply: get_unique. + by rewrite invf_div mulrBl divff// mul1r addrCA subrr addr0. +move=> /= y ry1. +suff -> : y = (1 - r^-1)^-1. + by rewrite -(mul1r r^-1) -{1}(divff r0) -mulrBl invf_div. +by rewrite -ry1 -addrAC subrr add0r invrK. +Qed. + +End conjugate. + Section hoelder. Context d {T : measurableType d} {R : realType}. Variable mu : {measure set T -> \bar R}. @@ -385,7 +423,7 @@ move=> p1; rewrite (@le_trans _ _ ((2^-1 * `| f x | + 2^-1 * `| g x |) `^ p))//. rewrite ge0_ler_powR ?nnegrE ?(le_trans _ p1)//. by rewrite (le_trans (ler_normD _ _))// 2!normrM ger0_norm. rewrite {1 3}(_ : 2^-1 = 1 - 2^-1); last by rewrite {2}(splitr 1) div1r addrK. -rewrite (@convex_powR _ _ p1 (Itv01 _ _))// ?inE/= ?in_itv/= ?normr_ge0 ?invr_ge0//. +rewrite (@convex_powR _ _ _ (Itv01 _ _))// ?inE/= ?in_itv/= ?normr_ge0 ?invr_ge0//. by rewrite invf_le1 ?ler1n. Qed. @@ -396,7 +434,7 @@ Proof. exact: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)). Qed. Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). Local Open Scope ereal_scope. -Let minkowski1 f g p : measurable_fun setT f -> measurable_fun setT g -> +Let minkowski1 f g p : measurable_fun [set: T] f -> measurable_fun [set: T] g -> 'N_1[(f \+ g)%R] <= 'N_1[f] + 'N_1[g]. Proof. move=> mf mg. @@ -409,7 +447,7 @@ rewrite ge0_le_integral//. Qed. Let minkowski_lty f g p : - measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R -> + measurable_fun [set: T] f -> measurable_fun [set: T] g -> (1 <= p)%R -> 'N_p%:E[f] < +oo -> 'N_p%:E[g] < +oo -> 'N_p%:E[(f \+ g)%R] < +oo. Proof. move=> mf mg p1 Nfoo Ngoo. @@ -441,8 +479,8 @@ rewrite ge0_integralD//; last 2 first. by rewrite lte_add_pinfty// -powR_Lnorm ?(gt_eqF (lt_trans _ p1))// poweR_lty. Qed. -Lemma minkowski f g p : - measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R -> +Lemma minkowski_EFin f g p : + measurable_fun [set: T] f -> measurable_fun [set: T] g -> (1 <= p)%R -> 'N_p%:E[(f \+ g)%R] <= 'N_p%:E[f] + 'N_p%:E[g]. Proof. move=> mf mg; rewrite le_eqVlt => /predU1P[<-|p1]; first exact: minkowski1. @@ -531,30 +569,43 @@ congr (_ * _); rewrite poweRN. - by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. Qed. -Lemma minkowski' f g p : - measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R -> +Lemma lerB_DLnorm f g p : + measurable_fun [set: T] f -> measurable_fun [set: T] g -> (1 <= p)%R -> 'N_p%:E[f] <= 'N_p%:E[f \+ g] + 'N_p%:E[g]. Proof. move=> mf mg p1. rewrite (_ : f = ((f \+ g) \+ (-%R \o g))%R); last first. by apply: funext => x /=; rewrite -addrA subrr addr0. -rewrite [X in _ <= 'N__[X] + _](_ : ((f \+ g \- g) \+ g)%R = (f \+ g)%R); last first. +rewrite [X in _ <= 'N__[X] + _](_ : _ = (f \+ g)%R); last first. by apply: funext => x /=; rewrite -addrA [X in _ + _ + X]addrC subrr addr0. -rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last first. - by rewrite oppr_Lnorm. -apply: minkowski => //. - apply: measurable_funD => //. -apply: measurableT_comp => //. +rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last by rewrite oppr_Lnorm. +by apply: minkowski_EFin => //; + [exact: measurable_funD|exact: measurableT_comp]. +Qed. + +Lemma lerB_LnormD f g p : + measurable_fun [set: T] f -> measurable_fun [set: T] g -> (1 <= p)%R -> + 'N_p%:E[f] - 'N_p%:E[g] <= 'N_p%:E[f \+ g]. +Proof. +move=> mf mg p1. +set rhs := (leRHS); have [?|] := boolP (rhs \is a fin_num). + by rewrite lee_subel_addr//; exact: lerB_DLnorm. +rewrite fin_numEn => /orP[|/eqP ->]; last by rewrite leey. +by rewrite gt_eqF// (lt_le_trans _ (Lnorm_ge0 _ _ _)). Qed. -Lemma minkowskie (f g : T -> R) (p : \bar R) : - measurable_fun setT f -> measurable_fun setT g -> 1 <= p -> +(* TODO: rename to minkowski after version 1.12.0 *) +Lemma eminkowski f g (p : \bar R) : + measurable_fun [set: T] f -> measurable_fun [set: T] g -> 1 <= p -> 'N_p[(f \+ g)%R] <= 'N_p[f] + 'N_p[g]. Proof. -case: p => //[r|]; first exact: minkowski. +case: p => //[r|]; first exact: minkowski_EFin. move=> mf mg _; rewrite unlock /Lnorm. case: ifPn => mugt0; last by rewrite adde0 lexx. exact: ess_sup_normD. Qed. End minkowski. +#[deprecated(since="mathcomp-analysis 1.10.0", + note="use `minkowski_EFin` or `eminkowski` instead")] +Notation minkowski := minkowski_EFin (only parsing). diff --git a/theories/lebesgue_integral_theory/lebesgue_integral_nonneg.v b/theories/lebesgue_integral_theory/lebesgue_integral_nonneg.v index e43c47f1a6..9fd183d219 100644 --- a/theories/lebesgue_integral_theory/lebesgue_integral_nonneg.v +++ b/theories/lebesgue_integral_theory/lebesgue_integral_nonneg.v @@ -1219,11 +1219,9 @@ Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (mu : {measure set T -> \bar R}). -Local Notation ae_eq := (ae_eq mu). - Let ae_eq_integral_abs_bounded (D : set T) (mD : measurable D) (f : T -> \bar R) M : measurable_fun D f -> (forall x, D x -> `|f x| <= M%:E) -> - ae_eq D f (cst 0) -> \int[mu]_(x in D) `|f x|%E = 0. + (\forall x \ae mu, D x -> f x = 0) -> \int[mu]_(x in D) `|f x|%E = 0. Proof. move=> mf fM [N [mA mN0 Df0N]]. pose Df_neq0 := D `&` [set x | f x != 0]. @@ -1249,7 +1247,8 @@ by rewrite mule0 -eq_le => /eqP. Qed. Lemma ae_eq_integral_abs (D : set T) (mD : measurable D) (f : T -> \bar R) : - measurable_fun D f -> \int[mu]_(x in D) `|f x| = 0 <-> ae_eq D f (cst 0). + measurable_fun D f -> + \int[mu]_(x in D) `|f x| = 0 <-> (\forall x \ae mu, D x -> f x = 0). Proof. move=> mf; split=> [iDf0|Df0]. exists (D `&` [set x | f x != 0]); split; @@ -1300,7 +1299,7 @@ transitivity (limn (fun n => \int[mu]_(x in D) (f_ n x) )). have [ftm|ftm] := leP `|f t|%E m%:R%:E. by rewrite lexx /= (le_trans ftm)// lee_fin ler_nat. by rewrite (ltW ftm) /= lee_fin ler_nat. -have ae_eq_f_ n : ae_eq D (f_ n) (cst 0). +have ae_eq_f_ n : (f_ n) = (cst 0) %[ae mu in D]. case: Df0 => N [mN muN0 DfN]. exists N; split => // t /= /not_implyP[Dt fnt0]. apply: DfN => /=; apply/not_implyP; split => //. @@ -1355,7 +1354,7 @@ Qed. Lemma ge0_ae_eq_integral (D : set T) (f g : T -> \bar R) : measurable D -> measurable_fun D f -> measurable_fun D g -> (forall x, D x -> 0 <= f x) -> (forall x, D x -> 0 <= g x) -> - ae_eq D f g -> \int[mu]_(x in D) (f x) = \int[mu]_(x in D) (g x). + f = g %[ae mu in D] -> \int[mu]_(x in D) (f x) = \int[mu]_(x in D) (g x). Proof. move=> mD mf mg f0 g0 [N [mN N0 subN]]. rewrite integralEpatch// [RHS]integralEpatch//. @@ -1373,7 +1372,7 @@ Qed. Lemma ae_eq_integral (D : set T) (g f : T -> \bar R) : measurable D -> measurable_fun D f -> measurable_fun D g -> - ae_eq D f g -> \int[mu]_(x in D) f x = \int[mu]_(x in D) g x. + f = g %[ae mu in D] -> \int[mu]_(x in D) f x = \int[mu]_(x in D) g x. Proof. move=> mD mf mg /ae_eq_funeposneg[Dfgp Dfgn]. rewrite integralE// [in RHS]integralE//; congr (_ - _). diff --git a/theories/lebesgue_integral_theory/simple_functions.v b/theories/lebesgue_integral_theory/simple_functions.v index 14cd93f104..06f6c5db0f 100644 --- a/theories/lebesgue_integral_theory/simple_functions.v +++ b/theories/lebesgue_integral_theory/simple_functions.v @@ -31,6 +31,7 @@ From mathcomp Require Import function_spaces. (* ```` *) (* {mfun aT >-> rT} == type of measurable functions *) (* aT and rT are sigmaRingType's. *) +(* f \in mfun == holds for f : {mfun _ >-> _} *) (* {sfun T >-> R} == type of simple functions *) (* {nnsfun T >-> R} == type of non-negative simple functions *) (* mindic mD := \1_D where mD is a proof that D is measurable *) @@ -218,6 +219,8 @@ Lemma mfunN f : - f = \- f :> (_ -> _). Proof. by []. Qed. Lemma mfunD f g : f + g = f \+ g :> (_ -> _). Proof. by []. Qed. Lemma mfunB f g : f - g = f \- g :> (_ -> _). Proof. by []. Qed. Lemma mfunM f g : f * g = f \* g :> (_ -> _). Proof. by []. Qed. +Lemma mfunMn f n : (f *+ n) = (fun x => f x *+ n) :> (_ -> _). +Proof. by apply/funext=> x; elim: n => //= n; rewrite !mulrS !mfunD /= => ->. Qed. Lemma mfun_sum I r (P : {pred I}) (f : I -> {mfun aT >-> rT}) (x : aT) : (\sum_(i <- r | P i) f i) x = \sum_(i <- r | P i) f i x. Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. diff --git a/theories/lspace.v b/theories/lspace.v index 42c2f07225..76ef9a9768 100644 --- a/theories/lspace.v +++ b/theories/lspace.v @@ -7,12 +7,27 @@ From mathcomp Require Import functions cardinality topology normedtype ereal. From mathcomp Require Import sequences esum exp measure numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral hoelder ess_sup_inf. -(******************************************************************************) +(**md**************************************************************************) +(* # Lp-spaces *) +(* *) +(* Definition of L-spaces and properties of the L-norm. *) (* *) -(* LfunType mu p == type of measurable functions f such that the *) -(* integral of |f| ^ p is finite *) -(* LType mu p == type of the elements of the Lp space *) -(* mu.-Lspace p == Lp space *) +(* ``` *) +(* finite_norm mu p f := the L-norm of real-valued function f is finite *) +(* The parameter p is an extended real. *) +(* LfunType mu p1 == type of measurable functions f with a finite *) +(* L-norm *) +(* p1 is a proof that the extended real number p is *) +(* greater or equal to 1. *) +(* The HB class is Lfun. *) +(* f \in lfun == holds for f : LfunType mu p1 *) +(* Lequiv f g == f is equal to g almost everywhere *) +(* The functions f and g have type LfunType mu p1. *) +(* Lequiv is made a canonical equivalence relation. *) +(* LspaceType mu p1 == type of the elements of the Lp space for the *) +(* measure mu *) +(* mu.-Lspace p == Lp space as a set *) +(* ``` *) (* *) (******************************************************************************) @@ -45,8 +60,7 @@ HB.structure Definition Lfun d (T : measurableType d) (R : realType) Arguments lfuny {d} {T} {R} {mu} {p} _. #[global] Hint Resolve lfuny : core. -#[global] Hint Extern 0 (@LfunType _ _ _ _ _) => - solve [apply: lfuny] : core. +#[global] Hint Extern 0 (@LfunType _ _ _ _ _) => solve [apply: lfuny] : core. Section Lfun_canonical. Context d (T : measurableType d) (R : realType). @@ -148,40 +162,6 @@ Qed. End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. -(* TODO: move to hoelder.v *) -Section conjugate. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R). -Hypothesis (p1 : (1 <= p)%E). - -Local Open Scope classical_set_scope. -Local Open Scope ereal_scope. - -Definition conjugate := - match p with - | r%:E => [get q : R | r^-1 + q^-1 = 1]%:E - | +oo => 1 - | -oo => 0 - end. - -Lemma conjugateE : - conjugate = if p is r%:E then (r * (r-1)^-1)%:E - else if p == +oo then 1 else 0. -Proof. -rewrite /conjugate. -case: p p1 => [r|//=|//]. -rewrite lee_fin => r1. -have r0 : r != 0%R by rewrite gt_eqF// (lt_le_trans _ r1). -congr EFin; apply: get_unique. - by rewrite invf_div mulrBl divff// mul1r addrCA subrr addr0. -move=> /= y ry1. -suff -> : y = (1 - r^-1)^-1. - by rewrite -(mul1r r^-1) -{1}(divff r0) -mulrBl invf_div. -by rewrite -ry1 -addrAC subrr add0r invrK. -Qed. - -End conjugate. - Section lfun_pred. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). @@ -190,8 +170,11 @@ Definition finlfun : {pred _ -> _} := mem [set f | finite_norm mu p f]. Definition lfun : {pred _ -> _} := [predI @mfun _ _ T R & finlfun]. Definition lfun_key : pred_key lfun. Proof. exact. Qed. Canonical lfun_keyed := KeyedPred lfun_key. -Lemma sub_lfun_mfun : {subset lfun <= mfun}. Proof. by move=> x /andP[]. Qed. -Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. Proof. by move=> x /andP[]. Qed. +Lemma sub_lfun_mfun : {subset lfun <= mfun}. +Proof. by move=> x /andP[]. Qed. +Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. +Proof. by move=> x /andP[]. Qed. + End lfun_pred. Section lfun. @@ -226,7 +209,8 @@ Qed. Lemma lfun_valP f (Pf : f \in lfun) : lfun_Sub Pf = f :> (_ -> _). Proof. by []. Qed. -HB.instance Definition _ := isSub.Build _ _ (LfunType mu p1) lfun_rect lfun_valP. +HB.instance Definition _ := + isSub.Build _ _ (LfunType mu p1) lfun_rect lfun_valP. Lemma lfuneqP (f g : LfunType mu p1) : f = g <-> f =1 g. Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. @@ -257,10 +241,10 @@ Lemma LnormZ (f : LfunType mu p1) a : ('N[mu]_p[EFin \o (a \*: f)] = `|a|%:E * 'N[mu]_p[EFin \o f])%E. Proof. rewrite unlock /Lnorm. -case: p p1 f => //[r r1 f|]. -- under eq_integral => x _/= do rewrite -mulr_algl scaler1 normrM powRM ?EFinM//. +case: p p1 f => //[r r1 f|? f]. +- under eq_integral do rewrite /= -mulr_algl scaler1 normrM powRM ?EFinM//. rewrite integralZl//; last first. - apply /integrableP; split. + apply/integrableP; split. apply: measurableT_comp => //. apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. exact: measurableT_comp. @@ -272,28 +256,24 @@ case: p p1 f => //[r r1 f|]. exact: (lfuny r1 f). rewrite poweRM ?integral_ge0=> //; rewrite ?lee_fin ?powR_ge0//. by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. -- move=> p0 f; case: ifP => mu0; last by rewrite mule0. - rewrite -ess_supZl//; apply/eq_ess_sup/nearW => x /=. +- case: ifPn => mu0; last by rewrite mule0. + rewrite -ess_supZl//; apply/eq_ess_sup/nearW => t /=. by rewrite normrZ EFinM. Qed. -Lemma lfun_submod_closed : submod_closed (lfun). +Lemma lfun_submod_closed : submod_closed lfun. Proof. split. - rewrite -[0]/(cst 0). exact: lfunP. + by rewrite -[0]/(cst 0); exact: lfunP. move=> a/= f g fP gP. rewrite -[f]lfun_valP -[g]lfun_valP. move: (lfun_Sub _) (lfun_Sub _) => {fP} f {gP} g. rewrite !inE rpredD ?rpredZ ?mfunP//=. -apply: mem_set => /=. -rewrite /finite_norm. -apply: le_lt_trans. - apply: minkowskie => //. - suff: a *: (g : T -> R) \in mfun by exact: set_mem. +apply: mem_set => /=; apply: (le_lt_trans (eminkowski _ _ _ _)) => //. +- suff: a *: (g : T -> R) \in mfun by exact: set_mem. by rewrite rpredZ//; exact: mfunP. -rewrite lte_add_pinfty//; last exact: lfuny. -rewrite LnormZ lte_mul_pinfty// ?lee_fin//. -exact: lfuny. +- rewrite lte_add_pinfty//; last exact: lfuny. + by rewrite LnormZ lte_mul_pinfty// ?lee_fin//; exact: lfuny. Qed. HB.instance Definition _ := GRing.isSubmodClosed.Build _ _ lfun @@ -305,12 +285,12 @@ End lfun. Section Lspace_norm. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. -Variable (p : \bar R) (p1 : (1 <= p)%E). +Variables (p : \bar R) (p1 : (1 <= p)%E). -(* 0 - + should come with proofs that they are in LfunType mu p *) +(* TODO: 0 - + should come with proofs that they are in LfunType mu p *) Notation ty := (LfunType mu p1). -Definition nm f := fine ('N[mu]_p[EFin \o f]). +Let nm f := fine ('N[mu]_p[EFin \o f]). Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]. Proof. @@ -318,21 +298,12 @@ rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. exact: lfuny. Qed. -Lemma ler_Lnorm_add (f g : ty) : - nm (f + g) <= nm f + nm g. -Proof. by rewrite -lee_fin EFinD !finite_norm_fine minkowskie. Qed. - -Lemma natmulfctE (U : pointedType) (K : ringType) (f : U -> K) n : - f *+ n = (fun x => f x *+ n). -Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. +Lemma ler_LnormD (f g : ty) : nm (f + g) <= nm f + nm g. +Proof. by rewrite -lee_fin EFinD !finite_norm_fine eminkowski. Qed. Lemma LnormN (f : ty) : nm (\-f) = nm f. Proof. by rewrite /nm oppr_Lnorm. Qed. -Lemma enatmul_ninfty (n : nat) : - (-oo *+ n.+1 = -oo :> \bar R)%E \/ (-oo *+ n.+1 = +oo :> \bar R)%E. -Proof. by elim: n => //=[|n []->]; rewrite ?addNye; left. Qed. - Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. Proof. apply/EFin_inj; rewrite finite_norm_fine -scaler_nat LnormZ normr_nat. @@ -348,9 +319,10 @@ HB.instance Definition _ := (* TODO: add equivalent of mx_normZ and HB instance *) -Lemma nm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. +Lemma fine_Lnorm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. Proof. -rewrite /nm=> /eqP; rewrite -eqe=> /eqP; rewrite finite_norm_fine=> /Lnorm_eq0_eq0. +move=> /eqP; rewrite -eqe => /eqP. +rewrite finite_norm_fine => /Lnorm_eq0_eq0. by apply; rewrite ?(lt_le_trans _ p1). Qed. @@ -359,20 +331,6 @@ End Lspace_norm. Section Lspace_inclusion. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. - -(* the following lemma is not needed, but looks useful, should we include it anyways? *) -Lemma mul_lte_pinfty (x y : \bar R) : - (x \is a fin_num -> 0 < x -> x * y < +oo -> y < +oo)%E. -Proof. -rewrite fin_numE => /andP[/eqP xNoo /eqP xoo]. -move: x xNoo xoo. -case => // r _ _; rewrite lte_fin => r0. -rewrite /mule. -case: y => //[s|]. - by rewrite !ltry. -by rewrite eqe gt_eqF// lte_fin r0. -Qed. - Local Open Scope ereal_scope. Lemma Lspace_inclusion (p q : \bar R) : diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 08ab5c7de8..1aad9e228d 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -1642,20 +1642,11 @@ Qed. End open_itv_cover. - Section ereal_supZ. Context {R : realType}. Implicit Types (r s : R) (A : set R) (X : set (\bar R)). Local Open Scope ereal_scope. -Lemma set_cst I T (x : T) (A : set I) : - [set x | _ in A] = if A == set0 then set0 else [set x]. -Proof. -apply/seteqP; split=> y /=. - by case=> i Ai ->; case: ifP => //= /eqP A0; rewrite A0 in Ai. -by case: ifPn => //= /set0P[i Ai ->]; exists i. -Qed. - Lemma ereal_sup_cst T x (A : set T) : A != set0 -> ereal_sup [set x | _ in A] = x :> \bar R. Proof. by move=> AN0; rewrite set_cst ifN// ereal_sup1. Qed. @@ -1663,12 +1654,12 @@ Proof. by move=> AN0; rewrite set_cst ifN// ereal_sup1. Qed. Lemma ereal_inf_cst T x (A : set T) : A != set0 -> ereal_inf [set x | _ in A] = x :> \bar R. Proof. by move=> AN0; rewrite set_cst ifN// ereal_inf1. Qed. - + Lemma ereal_sup_pZl X r : (0 < r)%R -> ereal_sup [set r%:E * x | x in X] = r%:E * ereal_sup X. Proof. move=> /[dup] r_gt0; rewrite lt0r => /andP[r_neq0 r_ge0]. - gen have gen : r r_gt0 {r_ge0 r_neq0} X / +gen have gen : r r_gt0 {r_ge0 r_neq0} X / ereal_sup [set r%:E * x | x in X] <= r%:E * ereal_sup X. apply/ereal_supP => y/= [x Ax <-]; rewrite lee_pmul2l//=. by apply/ereal_supP => //=; exists x. @@ -1683,7 +1674,7 @@ Proof. move=> AN0; have [r_gt0|//|<-] := ltgtP => _; first by rewrite ereal_sup_pZl. by rewrite mul0e; under eq_imagel do rewrite mul0e/=; rewrite ereal_sup_cst. Qed. - + Lemma ereal_inf_pZl X r : (0 < r)%R -> ereal_inf [set r%:E * x | x in X] = r%:E * ereal_inf X. Proof. From 1b6574d7c68c95003d13eb0a433c17453d9d908c Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 17 Mar 2025 00:48:57 +0900 Subject: [PATCH 22/73] move Module ProperNotations --- classical/mathcomp_extra.v | 21 +++++++++++++++++++++ theories/measure.v | 36 +++++++++--------------------------- 2 files changed, 30 insertions(+), 27 deletions(-) diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index de14df7011..9d55d5c1cf 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -594,3 +594,24 @@ Lemma eq_exists2r (A : Type) (P Q Q' : A -> Prop) : Proof. by move=> eqP; split=> -[x p q]; exists x; move: p q; rewrite ?eqP. Qed. + +Declare Scope signature_scope. +Delimit Scope signature_scope with signature. + +Import -(notations) Morphisms. +Arguments Proper {A}%_type R%_signature m. +Arguments respectful {A B}%_type (R R')%_signature _ _. + +Module ProperNotations. + +Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) + (right associativity, at level 55) : signature_scope. + +Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature)) + (right associativity, at level 55) : signature_scope. + +Notation " R ~~> R' " := (@respectful _ _ (Program.Basics.flip (R%signature)) (R'%signature)) + (right associativity, at level 55) : signature_scope. + +Export -(notations) Morphisms. +End ProperNotations. diff --git a/theories/measure.v b/theories/measure.v index a49d705b5b..dddb4f030e 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -280,6 +280,7 @@ From mathcomp Require Import sequences esum numfun. 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). @@ -4165,29 +4166,8 @@ move=> aP; have -> : P = setT by rewrite predeqE => t; split. by apply/negligibleP; [rewrite setCT|rewrite setCT measure0]. Qed. -Require Import -(notations) Setoid. - -Declare Scope signature_scope. -Delimit Scope signature_scope with signature. -Import -(notations) Morphisms. -Module ProperNotations. - - Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) - (right associativity, at level 55) : signature_scope. - - Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature)) - (right associativity, at level 55) : signature_scope. - - Notation " R ~~> R' " := (@respectful _ _ (Program.Basics.flip (R%signature)) (R'%signature)) - (right associativity, at level 55) : signature_scope. - -End ProperNotations. -Import ProperNotations. - -Arguments Proper {A}%_type R%_signature m. -Arguments respectful {A B}%_type (R R')%_signature _ _. - -Instance ae_eq_equiv d (T : ringOfSetsType d) R mu V D: Equivalence (@ae_eq d T R mu V D). +Instance ae_eq_equiv d (T : ringOfSetsType d) R mu V D : + Equivalence (@ae_eq d T R mu V D). Proof. split. - by move=> f; near=> x. @@ -4205,13 +4185,16 @@ 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)). +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)). +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)). +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). @@ -5421,4 +5404,3 @@ Lemma measure_dominates_ae_eq m1 m2 f g E : measurable E -> Proof. by move=> mE m21 [A [mA A0 ?]]; exists A; split => //; exact: m21. Qed. End absolute_continuity_lemmas. - From 1972a23fc9a82626543113b1bc2f029bdbb4040c Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Tue, 18 Mar 2025 15:36:14 +0900 Subject: [PATCH 23/73] removed `lspace.v` and moved its theory to `hoelder.v` (#30) --- CHANGELOG_UNRELEASED.md | 50 +++-- theories/hoelder.v | 386 +++++++++++++++++++++++++++++++++++++- theories/lspace.v | 406 ---------------------------------------- 3 files changed, 408 insertions(+), 434 deletions(-) delete mode 100644 theories/lspace.v diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 402c9588f0..350a079f4f 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -106,6 +106,30 @@ + definition `conjugate` + lemma `conjugateE` + lemmas `lerB_DLnorm`, `lerB_LnormD`, `eminkowski` + + definition `finite_norm` + + mixin `isLfun` with field `lfuny` + + structure `Lfun` + + notation `LfunType` + + definition `Lequiv` + + canonical `Lequiv_canonical` + + definition `LspaceType` + + canonicals `LspaceType_quotType`, `LspaceType_eqType`, `LspaceType_choiceType`, + `LspaceType_eqQuotType` + + lemma `LequivP` + + record `LType` + + coercion `LfunType_of_LType` + + definition `Lspace` with notation `mu.-Lspace p` + + lemma `LType1_integrable`, `LType2_integrable_sqr` + + definitions `finlfun`, `lfun`, `lfun_key` + + canonical `lfun_keyed` + + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` + + definition `lfun_Sub` + + lemmas `lfun_rect`, `lfun_valP`, `lfuneqP`, `lfuny0`, `mfunP`, `lfunP`, + `mfun_scaler_closed` + + lemmas `LnormZ`, `lfun_submod_closed` + + lemmas `finite_norm_fine`, `ler_LnormD`, + `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` + + lemma `Lspace_inclusion` - in `lebesgue_integral.v`: + lemma `mfunMn` @@ -148,32 +172,6 @@ + lemmas `ess_infr_bounded`, `ess_infrZl`, `ess_inf_ger`, `ess_inf_ler`, `ess_inf_cstr` -- new file `lspace.v`: - + definition `finite_norm` - + mixin `isLfun` with field `lfuny` - + structure `Lfun` - + notation `LfunType` - + definition `Lequiv` - + canonical `Lequiv_canonical` - + definition `LspaceType` - + canonicals `LspaceType_quotType`, `LspaceType_eqType`, `LspaceType_choiceType`, - `LspaceType_eqQuotType` - + lemma `LequivP` - + record `LType` - + coercion `LfunType_of_LType` - + definition `Lspace` with notation `mu.-Lspace p` - + lemma `LType1_integrable`, `LType2_integrable_sqr` - + definitions `finlfun`, `lfun`, `lfun_key` - + canonical `lfun_keyed` - + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` - + definition `lfun_Sub` - + lemmas `lfun_rect`, `lfun_valP`, `lfuneqP`, `lfuny0`, `mfunP`, `lfunP`, - `mfun_scaler_closed` - + lemmas `LnormZ`, `lfun_submod_closed` - + lemmas `finite_norm_fine`, `ler_LnormD`, - `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` - + lemma `Lspace_inclusion` - - in `nat_topology.v`: + lemma `nbhs_infty_gtr` diff --git a/theories/hoelder.v b/theories/hoelder.v index cef31f34fd..0f6c3d1ff0 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -11,8 +11,8 @@ From mathcomp Require Import lebesgue_integral numfun exp convex. (* # Hoelder's Inequality *) (* *) (* This file provides the Lp-norm, Hoelder's inequality and its consequences, *) -(* most notably Minkowski's inequality and the convexity of the power *) -(* function. *) +(* most notably Minkowski's inequality, the convexity of the power function, *) +(* and a definition of Lp-spaces. *) (* *) (* ``` *) (* 'N[mu]_p[f] == the Lp-norm of f with measure mu *) @@ -21,6 +21,25 @@ From mathcomp Require Import lebesgue_integral numfun exp convex. (* conjugate -oo = 0 *) (* ``` *) (* *) +(* Lp-spaces and properties of Lp-norms *) +(* *) +(* ``` *) +(* finite_norm mu p f := the L-norm of real-valued function f is finite *) +(* The parameter p is an extended real. *) +(* LfunType mu p1 == type of measurable functions f with a finite *) +(* L-norm *) +(* p1 is a proof that the extended real number p is *) +(* greater or equal to 1. *) +(* The HB class is Lfun. *) +(* f \in lfun == holds for f : LfunType mu p1 *) +(* Lequiv f g == f is equal to g almost everywhere *) +(* The functions f and g have type LfunType mu p1. *) +(* Lequiv is made a canonical equivalence relation. *) +(* LspaceType mu p1 == type of the elements of the Lp space for the *) +(* measure mu *) +(* mu.-Lspace p == Lp space as a set *) +(* ``` *) +(* *) (******************************************************************************) Set Implicit Arguments. @@ -38,6 +57,7 @@ Reserved Notation "'N[ mu ]_ p [ F ]" (* for use as a local notation when the measure is in context: *) Reserved Notation "'N_ p [ F ]" (at level 5, F at level 36, format "'[' ''N_' p '/ ' [ F ] ']'"). +Reserved Notation "mu .-Lspace p" (at level 4, format "mu .-Lspace p"). Declare Scope Lnorm_scope. @@ -609,3 +629,365 @@ End minkowski. #[deprecated(since="mathcomp-analysis 1.10.0", note="use `minkowski_EFin` or `eminkowski` instead")] Notation minkowski := minkowski_EFin (only parsing). + + +Definition finite_norm d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := + ('N[ mu ]_p [ EFin \o f ] < +oo)%E. + +HB.mixin Record isLfun d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) (f : T -> R) + of @MeasurableFun d _ T R f := { + lfuny : finite_norm mu p f +}. + +#[short(type=LfunType)] +HB.structure Definition Lfun d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) := + {f of @MeasurableFun d _ T R f & isLfun d T R mu p p1 f}. + +Arguments lfuny {d} {T} {R} {mu} {p} _. +#[global] Hint Resolve lfuny : core. +#[global] Hint Extern 0 (@LfunType _ _ _ _ _) => solve [apply: lfuny] : core. + +Section Lfun_canonical. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). + +HB.instance Definition _ := gen_eqMixin (LfunType mu p1). +HB.instance Definition _ := gen_choiceMixin (LfunType mu p1). + +End Lfun_canonical. + +Section Lequiv. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). + +Definition Lequiv (f g : LfunType mu p1) := `[< f = g %[ae mu] >]. + +Let Lequiv_refl : reflexive Lequiv. +Proof. +by move=> f; exact/asboolP/(filterS _ (ae_eq_refl mu setT (EFin \o f))). +Qed. + +Let Lequiv_sym : symmetric Lequiv. +Proof. +by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP/ae_eq_sym. +Qed. + +Let Lequiv_trans : transitive Lequiv. +Proof. +by move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(ae_eq_trans gf fh). +Qed. + +Canonical Lequiv_canonical := + EquivRel Lequiv Lequiv_refl Lequiv_sym Lequiv_trans. + +Local Open Scope quotient_scope. + +Definition LspaceType := {eq_quot Lequiv}. +Canonical LspaceType_quotType := [the quotType _ of LspaceType]. +Canonical LspaceType_eqType := [the eqType of LspaceType]. +Canonical LspaceType_choiceType := [the choiceType of LspaceType]. +Canonical LspaceType_eqQuotType := [the eqQuotType Lequiv of LspaceType]. + +Lemma LequivP (f g : LfunType mu p1) : + reflect (f = g %[ae mu]) (f == g %[mod LspaceType]). +Proof. by apply/(iffP idP); rewrite eqmodE// => /asboolP. Qed. + +Record LType := MemLType { Lfun_class : LspaceType }. +Coercion LfunType_of_LType (f : LType) : LfunType mu p1 := + repr (Lfun_class f). + +End Lequiv. + +Section Lspace. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. + +Definition Lspace p (p1 : (1 <= p)%E) := [set: LType mu p1]. +Arguments Lspace : clear implicits. + +Lemma LType1_integrable (f : LType mu (@lexx _ _ 1%E)) : + mu.-integrable setT (EFin \o f). +Proof. +apply/integrableP; split; first exact/measurable_EFinP. +have := lfuny _ f. +rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. + by apply integral_ge0 => x _; rewrite lee_fin powRr1. +by under eq_integral => i _ do rewrite poweRe1//. +Qed. + +Let le12 : (1 <= 2%:E :> \bar R)%E. +Proof. +rewrite lee_fin. +rewrite (ler_nat _ 1 2). +by []. +Qed. + +Lemma LType2_integrable_sqr (f : LType mu le12) : + mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). +Proof. +apply/integrableP; split. + apply/measurable_EFinP. + exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). +rewrite (@lty_poweRy _ _ 2^-1)//. +rewrite (le_lt_trans _ (lfuny _ f))//. +rewrite unlock. +rewrite gt0_ler_poweR//. +- by rewrite in_itv/= leey integral_ge0. +- by rewrite in_itv/= leey integral_ge0. +- rewrite ge0_le_integral//. + + apply: measurableT_comp => //; apply/measurable_EFinP. + exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). + + by move=> x _; rewrite lee_fin powR_ge0. + + apply/measurable_EFinP. + apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. + exact/measurableT_comp. + + by move=> t _/=; rewrite lee_fin normrX powR_mulrn. +Qed. + +End Lspace. +Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. + +Section lfun_pred. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R). + +Definition finlfun : {pred _ -> _} := mem [set f | finite_norm mu p f]. +Definition lfun : {pred _ -> _} := [predI @mfun _ _ T R & finlfun]. +Definition lfun_key : pred_key lfun. Proof. exact. Qed. +Canonical lfun_keyed := KeyedPred lfun_key. +Lemma sub_lfun_mfun : {subset lfun <= mfun}. +Proof. by move=> x /andP[]. Qed. +Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. +Proof. by move=> x /andP[]. Qed. + +End lfun_pred. + +Section lfun. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). + +Notation lfun := (@lfun _ T R mu p). +Section Sub. +Context (f : T -> R) (fP : f \in lfun). +Definition lfun_Sub1_subproof := + @isMeasurableFun.Build d _ T R f (set_mem (sub_lfun_mfun fP)). +#[local] HB.instance Definition _ := lfun_Sub1_subproof. +Definition lfun_Sub2_subproof := + @isLfun.Build d T R mu p p1 f (set_mem (sub_lfun_finlfun fP)). + +Import HBSimple. + +#[local] HB.instance Definition _ := lfun_Sub2_subproof. +Definition lfun_Sub : LfunType mu p1 := f. +End Sub. + +Lemma lfun_rect (K : LfunType mu p1 -> Type) : + (forall f (Pf : f \in lfun), K (lfun_Sub Pf)) -> forall u, K u. +Proof. +move=> Ksub [f [[Pf1] [Pf2]]]. +have Pf : f \in lfun by apply/andP; rewrite ?inE. +have -> : Pf1 = set_mem (sub_lfun_mfun Pf) by []. +have -> : Pf2 = set_mem (sub_lfun_finlfun Pf) by []. +exact: Ksub. +Qed. + +Lemma lfun_valP f (Pf : f \in lfun) : lfun_Sub Pf = f :> (_ -> _). +Proof. by []. Qed. + +HB.instance Definition _ := + isSub.Build _ _ (LfunType mu p1) lfun_rect lfun_valP. + +Lemma lfuneqP (f g : LfunType mu p1) : f = g <-> f =1 g. +Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. + +HB.instance Definition _ := [Choice of LfunType mu p1 by <:]. + +Import numFieldNormedType.Exports. + +Lemma lfuny0 : finite_norm mu p (cst 0). +Proof. by rewrite /finite_norm Lnorm0// ltry. Qed. + +HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. + +Lemma mfunP (f : {mfun T >-> R}) : (f : T -> R) \in mfun. +Proof. exact: valP. Qed. + +Lemma lfunP (f : LfunType mu p1) : (f : T -> R) \in lfun. +Proof. exact: valP. Qed. + +Lemma mfun_scaler_closed : scaler_closed (@mfun _ _ T R). +Proof. move=> a/= f; rewrite !inE; exact: measurable_funM. Qed. + +HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) + mfun_scaler_closed. +HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. + +Lemma LnormZ (f : LfunType mu p1) a : + ('N[mu]_p[EFin \o (a \*: f)] = `|a|%:E * 'N[mu]_p[EFin \o f])%E. +Proof. +rewrite unlock /Lnorm. +case: p p1 f => //[r r1 f|? f]. +- under eq_integral do rewrite /= -mulr_algl scaler1 normrM powRM ?EFinM//. + rewrite integralZl//; last first. + apply/integrableP; split. + apply: measurableT_comp => //. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. + exact: measurableT_comp. + apply: (@lty_poweRy _ _ r^-1). + by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). + rewrite [ltLHS](_ : _ = 'N[mu]_r%:E[EFin \o f]); first exact: (lfuny r1 f). + rewrite unlock /Lnorm. + by under eq_integral do rewrite gee0_abs ?lee_fin ?powR_ge0//. + rewrite poweRM ?integral_ge0//. + by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. +- case: ifPn => mu0; last by rewrite mule0. + rewrite -ess_supZl//; apply/eq_ess_sup/nearW => t /=. + by rewrite normrZ EFinM. +Qed. + +Lemma lfun_submod_closed : submod_closed lfun. +Proof. +split. + by rewrite -[0]/(cst 0); exact: lfunP. +move=> a/= f g fP gP. +rewrite -[f]lfun_valP -[g]lfun_valP. +move: (lfun_Sub _) (lfun_Sub _) => {fP} f {gP} g. +rewrite !inE rpredD ?rpredZ ?mfunP//=. +apply: mem_set => /=; apply: (le_lt_trans (eminkowski _ _ _ _)) => //. +- suff: a *: (g : T -> R) \in mfun by exact: set_mem. + by rewrite rpredZ//; exact: mfunP. +- rewrite lte_add_pinfty//; last exact: lfuny. + by rewrite LnormZ lte_mul_pinfty// ?lee_fin//; exact: lfuny. +Qed. + +HB.instance Definition _ := GRing.isSubmodClosed.Build _ _ lfun + lfun_submod_closed. +HB.instance Definition _ := [SubChoice_isSubLmodule of LfunType mu p1 by <:]. + +End lfun. + +Section Lspace_norm. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Variables (p : \bar R) (p1 : (1 <= p)%E). + +(* TODO: 0 - + should come with proofs that they are in LfunType mu p *) + +Notation ty := (LfunType mu p1). +Let nm f := fine ('N[mu]_p[EFin \o f]). + +Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]. +Proof. +rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. +exact: lfuny. +Qed. + +Lemma ler_LnormD (f g : ty) : nm (f + g) <= nm f + nm g. +Proof. by rewrite -lee_fin EFinD !finite_norm_fine eminkowski. Qed. + +Lemma LnormN (f : ty) : nm (\-f) = nm f. +Proof. by rewrite /nm oppr_Lnorm. Qed. + +Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. +Proof. +apply/EFin_inj; rewrite finite_norm_fine -scaler_nat LnormZ normr_nat. +by rewrite -[in RHS]mulr_natl EFinM finite_norm_fine. +Qed. + +(* TODO : fix the definition *) +(* waiting for MathComp 2.4.0 +HB.instance Definition _ := + @Num.Zmodule_isSemiNormed.Build R (LfunType mu p1) + nm ler_Lnorm_add Lnorm_natmul LnormN. +*) + +(* TODO: add equivalent of mx_normZ and HB instance *) + +Lemma fine_Lnorm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. +Proof. +move=> /eqP; rewrite -eqe => /eqP. +rewrite finite_norm_fine => /Lnorm_eq0_eq0. +by apply; rewrite ?(lt_le_trans _ p1). +Qed. + +End Lspace_norm. + +Section Lspace_inclusion. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. + +Lemma Lspace_inclusion (p q : \bar R) : + forall (p1 : 1 <= p) (q1 : 1 <= q), + mu [set: T] < +oo -> p < q -> + forall f : {mfun T >-> R}, finite_norm mu q f -> finite_norm mu p f. +Proof. +have := measure_ge0 mu [set: T]. +rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. + rewrite /finite_norm unlock /Lnorm. + move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. + move=> r r1. + under eq_integral do rewrite /= -[(_ `^ _)%R]ger0_norm ?powR_ge0//=. + rewrite (@integral_abs_eq0 _ _ _ _ setT setT (fun x => (`|f x| `^ r)%:E))//. + by rewrite poweR0r// invr_neq0// gt_eqF// -lte_fin (lt_le_trans _ r1). + apply/measurable_EFinP. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. + exact: measurableT_comp. +move: p q. +case=> //[p|]; case=> //[q|] p1 q1; last first. + have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). + move=> muoo _ f. + rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. + rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. + rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. + by rewrite integral_cst// lte_mul_pinfty// lee_fin powR_ge0. + apply: ae_ge0_le_integral => //. + - by move=> x _; rewrite lee_fin powR_ge0. + apply/measurable_EFinP. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. + exact: measurableT_comp. + - by move=> x _; rewrite lee_fin powR_ge0. + apply: filterS fM => t/= ftM _. + rewrite lee_fin ge0_ler_powR//; first exact: ltW. + by rewrite nnegrE (le_trans _ ftM). +move=> mu_fin pleq f ffin. +have:= ffin; rewrite /finite_norm. +have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). +have pN0 : p != 0%R by rewrite gt_eqF. +have q0 : (0 < q)%R by rewrite ?(lt_le_trans ltr01). +have qinv0 : q^-1 != 0%R by rewrite invr_neq0// gt_eqF. +pose r := q/p. +pose r' := (1 - r^-1)^-1. +have := (@hoelder _ _ _ mu (fun x => `|f x| `^ p) (cst 1)%R r r')%R. +rewrite (_ : (_ \* cst 1)%R = (fun x : T => `|f x| `^ p))%R -?fctM ?mulr1//. +rewrite Lnorm_cst1 unlock /Lnorm invr1. +have mfp : measurable_fun [set: T] (fun x : T => (`|f x| `^ p)%R). + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. + exact: measurableT_comp. +have m1 : measurable_fun [set: T] (@cst _ R 1%R). + exact: measurable_cst. +have r0 : (0 < r)%R by rewrite/r divr_gt0. +have r'0 : (0 < r')%R. + by rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; + rewrite /r ltr_pdivlMr// mul1r. +have rr'1 : r^-1 + r'^-1 = 1%R. + by rewrite /r' /r invf_div invrK addrCA subrr addr0. +move=> /(_ mfp m1 r0 r'0 rr'1). +under [in leLHS] eq_integral do rewrite /= powRr1// norm_powR// normrE. +under [in leRHS] eq_integral do + rewrite /= norm_powR// normr_id -powRrM mulrCA divff// mulr1. +rewrite [X in X <= _]poweRe1; last + by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. +move=> h1 /lty_poweRy h2. +apply: poweR_lty. +apply: (le_lt_trans h1). +rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. + by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?ltNyr// ?poweR_lty. +rewrite poweR_lty// (lty_poweRy qinv0)//. +by have:= ffin; rewrite /finite_norm unlock /Lnorm. +Qed. + +End Lspace_inclusion. diff --git a/theories/lspace.v b/theories/lspace.v deleted file mode 100644 index 76ef9a9768..0000000000 --- a/theories/lspace.v +++ /dev/null @@ -1,406 +0,0 @@ -(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) -From HB Require Import structures. -From mathcomp Require Import all_ssreflect. -From mathcomp Require Import ssralg ssrnum ssrint interval finmap. -From mathcomp Require Import boolp classical_sets interval_inference reals. -From mathcomp Require Import functions cardinality topology normedtype ereal. -From mathcomp Require Import sequences esum exp measure numfun lebesgue_measure. -From mathcomp Require Import lebesgue_integral hoelder ess_sup_inf. - -(**md**************************************************************************) -(* # Lp-spaces *) -(* *) -(* Definition of L-spaces and properties of the L-norm. *) -(* *) -(* ``` *) -(* finite_norm mu p f := the L-norm of real-valued function f is finite *) -(* The parameter p is an extended real. *) -(* LfunType mu p1 == type of measurable functions f with a finite *) -(* L-norm *) -(* p1 is a proof that the extended real number p is *) -(* greater or equal to 1. *) -(* The HB class is Lfun. *) -(* f \in lfun == holds for f : LfunType mu p1 *) -(* Lequiv f g == f is equal to g almost everywhere *) -(* The functions f and g have type LfunType mu p1. *) -(* Lequiv is made a canonical equivalence relation. *) -(* LspaceType mu p1 == type of the elements of the Lp space for the *) -(* measure mu *) -(* mu.-Lspace p == Lp space as a set *) -(* ``` *) -(* *) -(******************************************************************************) - -Reserved Notation "mu .-Lspace p" (at level 4, format "mu .-Lspace p"). - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Import numFieldTopology.Exports. - -Local Open Scope classical_set_scope. -Local Open Scope ring_scope. - -Definition finite_norm d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := - ('N[ mu ]_p [ EFin \o f ] < +oo)%E. - -HB.mixin Record isLfun d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) (f : T -> R) - of @MeasurableFun d _ T R f := { - lfuny : finite_norm mu p f -}. - -#[short(type=LfunType)] -HB.structure Definition Lfun d (T : measurableType d) (R : realType) - (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E) := - {f of @MeasurableFun d _ T R f & isLfun d T R mu p p1 f}. - -Arguments lfuny {d} {T} {R} {mu} {p} _. -#[global] Hint Resolve lfuny : core. -#[global] Hint Extern 0 (@LfunType _ _ _ _ _) => solve [apply: lfuny] : core. - -Section Lfun_canonical. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). - -HB.instance Definition _ := gen_eqMixin (LfunType mu p1). -HB.instance Definition _ := gen_choiceMixin (LfunType mu p1). - -End Lfun_canonical. - -Section Lequiv. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). - -Definition Lequiv (f g : LfunType mu p1) := `[< f = g %[ae mu] >]. - -Let Lequiv_refl : reflexive Lequiv. -Proof. -by move=> f; exact/asboolP/(filterS _ (ae_eq_refl mu setT (EFin \o f))). -Qed. - -Let Lequiv_sym : symmetric Lequiv. -Proof. -by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP/ae_eq_sym. -Qed. - -Let Lequiv_trans : transitive Lequiv. -Proof. -by move=> f g h /asboolP gf /asboolP fh; apply/asboolP/(ae_eq_trans gf fh). -Qed. - -Canonical Lequiv_canonical := - EquivRel Lequiv Lequiv_refl Lequiv_sym Lequiv_trans. - -Local Open Scope quotient_scope. - -Definition LspaceType := {eq_quot Lequiv}. -Canonical LspaceType_quotType := [the quotType _ of LspaceType]. -Canonical LspaceType_eqType := [the eqType of LspaceType]. -Canonical LspaceType_choiceType := [the choiceType of LspaceType]. -Canonical LspaceType_eqQuotType := [the eqQuotType Lequiv of LspaceType]. - -Lemma LequivP (f g : LfunType mu p1) : - reflect (f = g %[ae mu]) (f == g %[mod LspaceType]). -Proof. by apply/(iffP idP); rewrite eqmodE// => /asboolP. Qed. - -Record LType := MemLType { Lfun_class : LspaceType }. -Coercion LfunType_of_LType (f : LType) : LfunType mu p1 := - repr (Lfun_class f). - -End Lequiv. - -Section Lspace. -Context d (T : measurableType d) (R : realType). -Variable mu : {measure set T -> \bar R}. - -Definition Lspace p (p1 : (1 <= p)%E) := [set: LType mu p1]. -Arguments Lspace : clear implicits. - -Lemma LType1_integrable (f : LType mu (@lexx _ _ 1%E)) : - mu.-integrable setT (EFin \o f). -Proof. -apply/integrableP; split; first exact/measurable_EFinP. -have := lfuny _ f. -rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. - by apply integral_ge0 => x _; rewrite lee_fin powRr1. -by under eq_integral => i _ do rewrite poweRe1//. -Qed. - -Let le12 : (1 <= 2%:E :> \bar R)%E. -Proof. -rewrite lee_fin. -rewrite (ler_nat _ 1 2). -by []. -Qed. - -Lemma LType2_integrable_sqr (f : LType mu le12) : - mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). -Proof. -apply/integrableP; split. - apply/measurable_EFinP. - exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). -rewrite (@lty_poweRy _ _ 2^-1)//. -rewrite (le_lt_trans _ (lfuny _ f))//. -rewrite unlock. -rewrite gt0_ler_poweR//. -- by rewrite in_itv/= leey integral_ge0. -- by rewrite in_itv/= leey integral_ge0. -- rewrite ge0_le_integral//. - + apply: measurableT_comp => //; apply/measurable_EFinP. - exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). - + by move=> x _; rewrite poweR_ge0. - + apply/measurable_EFinP. - apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. - exact/measurableT_comp. - + by move=> t _/=; rewrite lee_fin normrX powR_mulrn. -Qed. - -End Lspace. -Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. - -Section lfun_pred. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R). - -Definition finlfun : {pred _ -> _} := mem [set f | finite_norm mu p f]. -Definition lfun : {pred _ -> _} := [predI @mfun _ _ T R & finlfun]. -Definition lfun_key : pred_key lfun. Proof. exact. Qed. -Canonical lfun_keyed := KeyedPred lfun_key. -Lemma sub_lfun_mfun : {subset lfun <= mfun}. -Proof. by move=> x /andP[]. Qed. -Lemma sub_lfun_finlfun : {subset lfun <= finlfun}. -Proof. by move=> x /andP[]. Qed. - -End lfun_pred. - -Section lfun. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). - -Notation lfun := (@lfun _ T R mu p). -Section Sub. -Context (f : T -> R) (fP : f \in lfun). -Definition lfun_Sub1_subproof := - @isMeasurableFun.Build d _ T R f (set_mem (sub_lfun_mfun fP)). -#[local] HB.instance Definition _ := lfun_Sub1_subproof. -Definition lfun_Sub2_subproof := - @isLfun.Build d T R mu p p1 f (set_mem (sub_lfun_finlfun fP)). - -Import HBSimple. - -#[local] HB.instance Definition _ := lfun_Sub2_subproof. -Definition lfun_Sub : LfunType mu p1 := f. -End Sub. - -Lemma lfun_rect (K : LfunType mu p1 -> Type) : - (forall f (Pf : f \in lfun), K (lfun_Sub Pf)) -> forall u, K u. -Proof. -move=> Ksub [f [[Pf1] [Pf2]]]. -have Pf : f \in lfun by apply/andP; rewrite ?inE. -have -> : Pf1 = set_mem (sub_lfun_mfun Pf) by []. -have -> : Pf2 = set_mem (sub_lfun_finlfun Pf) by []. -exact: Ksub. -Qed. - -Lemma lfun_valP f (Pf : f \in lfun) : lfun_Sub Pf = f :> (_ -> _). -Proof. by []. Qed. - -HB.instance Definition _ := - isSub.Build _ _ (LfunType mu p1) lfun_rect lfun_valP. - -Lemma lfuneqP (f g : LfunType mu p1) : f = g <-> f =1 g. -Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. - -HB.instance Definition _ := [Choice of LfunType mu p1 by <:]. - -Import numFieldNormedType.Exports. - -Lemma lfuny0 : finite_norm mu p (cst 0). -Proof. by rewrite /finite_norm Lnorm0// ltry. Qed. - -HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. - -Lemma mfunP (f : {mfun T >-> R}) : (f : T -> R) \in mfun. -Proof. exact: valP. Qed. - -Lemma lfunP (f : LfunType mu p1) : (f : T -> R) \in lfun. -Proof. exact: valP. Qed. - -Lemma mfun_scaler_closed : scaler_closed (@mfun _ _ T R). -Proof. move=> a/= f; rewrite !inE; exact: measurable_funM. Qed. - -HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) - mfun_scaler_closed. -HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. - -Lemma LnormZ (f : LfunType mu p1) a : - ('N[mu]_p[EFin \o (a \*: f)] = `|a|%:E * 'N[mu]_p[EFin \o f])%E. -Proof. -rewrite unlock /Lnorm. -case: p p1 f => //[r r1 f|? f]. -- under eq_integral do rewrite /= -mulr_algl scaler1 normrM powRM ?EFinM//. - rewrite integralZl//; last first. - apply/integrableP; split. - apply: measurableT_comp => //. - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. - exact: measurableT_comp. - apply: (@lty_poweRy _ _ r^-1). - by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). - have -> : ((\int[mu]_x `|(`|f x| `^ r)%:E|) `^ r^-1 = 'N[mu]_r%:E[EFin \o f])%E. - rewrite unlock /Lnorm. - by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. - exact: (lfuny r1 f). - rewrite poweRM ?integral_ge0=> //; rewrite ?lee_fin ?powR_ge0//. - by rewrite poweR_EFin -powRrM mulfV ?gt_eqF ?(lt_le_trans ltr01)// powRr1. -- case: ifPn => mu0; last by rewrite mule0. - rewrite -ess_supZl//; apply/eq_ess_sup/nearW => t /=. - by rewrite normrZ EFinM. -Qed. - -Lemma lfun_submod_closed : submod_closed lfun. -Proof. -split. - by rewrite -[0]/(cst 0); exact: lfunP. -move=> a/= f g fP gP. -rewrite -[f]lfun_valP -[g]lfun_valP. -move: (lfun_Sub _) (lfun_Sub _) => {fP} f {gP} g. -rewrite !inE rpredD ?rpredZ ?mfunP//=. -apply: mem_set => /=; apply: (le_lt_trans (eminkowski _ _ _ _)) => //. -- suff: a *: (g : T -> R) \in mfun by exact: set_mem. - by rewrite rpredZ//; exact: mfunP. -- rewrite lte_add_pinfty//; last exact: lfuny. - by rewrite LnormZ lte_mul_pinfty// ?lee_fin//; exact: lfuny. -Qed. - -HB.instance Definition _ := GRing.isSubmodClosed.Build _ _ lfun - lfun_submod_closed. -HB.instance Definition _ := [SubChoice_isSubLmodule of LfunType mu p1 by <:]. - -End lfun. - -Section Lspace_norm. -Context d (T : measurableType d) (R : realType). -Variable mu : {measure set T -> \bar R}. -Variables (p : \bar R) (p1 : (1 <= p)%E). - -(* TODO: 0 - + should come with proofs that they are in LfunType mu p *) - -Notation ty := (LfunType mu p1). -Let nm f := fine ('N[mu]_p[EFin \o f]). - -Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]. -Proof. -rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. -exact: lfuny. -Qed. - -Lemma ler_LnormD (f g : ty) : nm (f + g) <= nm f + nm g. -Proof. by rewrite -lee_fin EFinD !finite_norm_fine eminkowski. Qed. - -Lemma LnormN (f : ty) : nm (\-f) = nm f. -Proof. by rewrite /nm oppr_Lnorm. Qed. - -Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. -Proof. -apply/EFin_inj; rewrite finite_norm_fine -scaler_nat LnormZ normr_nat. -by rewrite -[in RHS]mulr_natl EFinM finite_norm_fine. -Qed. - -(* TODO : fix the definition *) -(* waiting for MathComp 2.4.0 -HB.instance Definition _ := - @Num.Zmodule_isSemiNormed.Build R (LfunType mu p1) - nm ler_Lnorm_add Lnorm_natmul LnormN. -*) - -(* TODO: add equivalent of mx_normZ and HB instance *) - -Lemma fine_Lnorm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. -Proof. -move=> /eqP; rewrite -eqe => /eqP. -rewrite finite_norm_fine => /Lnorm_eq0_eq0. -by apply; rewrite ?(lt_le_trans _ p1). -Qed. - -End Lspace_norm. - -Section Lspace_inclusion. -Context d (T : measurableType d) (R : realType). -Variable mu : {measure set T -> \bar R}. -Local Open Scope ereal_scope. - -Lemma Lspace_inclusion (p q : \bar R) : - forall (p1 : 1 <= p) (q1 : 1 <= q), - mu [set: T] < +oo -> p < q -> - forall f : {mfun T >-> R}, finite_norm mu q f -> finite_norm mu p f. -Proof. -have := measure_ge0 mu [set: T]. -rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. - rewrite /finite_norm unlock /Lnorm. - move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. - move=> r r1. - under eq_integral do rewrite /= -[(_ `^ _)%R]ger0_norm ?powR_ge0//=. - rewrite (@integral_abs_eq0 _ _ _ _ setT setT (fun x => (`|f x| `^ r)%:E))//. - by rewrite poweR0r// invr_neq0// gt_eqF// -lte_fin (lt_le_trans _ r1). - apply/measurable_EFinP. - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. - exact: measurableT_comp. -move: p q. -case=> //[p|]; case=> //[q|] p1 q1; last first. - have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). - move=> muoo _ f. - rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. - rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. - rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. - by rewrite integral_cst// lte_mul_pinfty// lee_fin powR_ge0. - apply: ae_ge0_le_integral => //. - - by move=> x _; rewrite lee_fin powR_ge0. - apply/measurable_EFinP. - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. - exact: measurableT_comp. - - by move=> x _; rewrite lee_fin powR_ge0. - apply: filterS fM => t/= ftM _. - rewrite lee_fin ge0_ler_powR//; first exact: ltW. - by rewrite nnegrE (le_trans _ ftM). -move=> mu_fin pleq f ffin. -have:= ffin; rewrite /finite_norm. -have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). -have pN0 : p != 0%R by rewrite gt_eqF. -have q0 : (0 < q)%R by rewrite ?(lt_le_trans ltr01). -have qinv0 : q^-1 != 0%R by rewrite invr_neq0// gt_eqF. -pose r := q/p. -pose r' := (1 - r^-1)^-1. -have := (@hoelder _ _ _ mu (fun x => `|f x| `^ p) (cst 1)%R r r')%R. -rewrite (_ : (_ \* cst 1)%R = (fun x : T => `|f x| `^ p))%R -?fctM ?mulr1//. -rewrite Lnorm_cst1 unlock /Lnorm invr1. -have mfp : measurable_fun [set: T] (fun x : T => (`|f x| `^ p)%R). - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. - exact: measurableT_comp. -have m1 : measurable_fun [set: T] (@cst _ R 1%R). - exact: measurable_cst. -have r0 : (0 < r)%R by rewrite/r divr_gt0. -have r'0 : (0 < r')%R. - by rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; - rewrite /r ltr_pdivlMr// mul1r. -have rr'1 : r^-1 + r'^-1 = 1%R. - by rewrite /r' /r invf_div invrK addrCA subrr addr0. -move=> /(_ mfp m1 r0 r'0 rr'1). -under [in leLHS] eq_integral do rewrite /= powRr1// norm_powR// normrE. -under [in leRHS] eq_integral do - rewrite /= norm_powR// normr_id -powRrM mulrCA divff// mulr1. -rewrite [X in X <= _]poweRe1; last - by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. -move=> h1 /lty_poweRy h2. -apply: poweR_lty. -apply: (le_lt_trans h1). -rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. - by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?ltNyr// ?poweR_lty. -rewrite poweR_lty// (lty_poweRy qinv0)//. -by have:= ffin; rewrite /finite_norm unlock /Lnorm. -Qed. - -End Lspace_inclusion. From cb2eefd46bd638333d983ac1e2a5d190308f3537 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 18 Mar 2025 16:56:10 +0900 Subject: [PATCH 24/73] renaming to distinguish real-valued functions --- CHANGELOG_UNRELEASED.md | 8 ++- theories/hoelder.v | 152 +++++++++++++++++++++++----------------- 2 files changed, 93 insertions(+), 67 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 350a079f4f..4d75d4555a 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -128,7 +128,7 @@ `mfun_scaler_closed` + lemmas `LnormZ`, `lfun_submod_closed` + lemmas `finite_norm_fine`, `ler_LnormD`, - `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` + `LnormrN`, `Lnormr_natmul`, `fine_Lnormr_eq0` + lemma `Lspace_inclusion` - in `lebesgue_integral.v`: @@ -175,6 +175,9 @@ - in `nat_topology.v`: + lemma `nbhs_infty_gtr` +- in `hoelder.v`: + + lemmas `poweR_Lnorm`, `oppe_Lnorm` + ### Changed - file `nsatz_realtype.v` moved from `reals` to `reals-stdlib` package @@ -256,6 +259,8 @@ - in `hoelder.v`: + `minkowski` -> `minkowski_EFin` + + `Lnorm_ge0` -> `Lnormr_ge0` + + `Lnorm_eq0_eq0` -> `Lnormr_eq0_eq0` ### Generalized @@ -271,6 +276,7 @@ - in `hoelder.v`: + definition `Lnorm` generalized to functions with codomain `\bar R` (this impacts the notation `'N_p[f]`) + + lemmas `Lnorm1`, `eq_Lnorm` (from `f : _ -> R` to `f : _ -> \bar R`) ### Deprecated diff --git a/theories/hoelder.v b/theories/hoelder.v index 0f6c3d1ff0..ad593ee490 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -21,7 +21,7 @@ From mathcomp Require Import lebesgue_integral numfun exp convex. (* conjugate -oo = 0 *) (* ``` *) (* *) -(* Lp-spaces and properties of Lp-norms *) +(* Lp-spaces and properties of Lp-norms: *) (* *) (* ``` *) (* finite_norm mu p f := the L-norm of real-valued function f is finite *) @@ -78,11 +78,11 @@ Section Lnorm_properties. Context d {T : measurableType d} {R : realType}. Variable mu : {measure set T -> \bar R}. Local Open Scope ereal_scope. -Implicit Types (p : \bar R) (f g : T -> R) (r : R). +Implicit Types (p : \bar R) (f g : T -> \bar R) (r : R). -Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). +Local Notation "'N_ p [ f ]" := (Lnorm mu p f). -Lemma Lnorm0 p : 1 <= p -> 'N_p[cst 0%R] = 0. +Lemma Lnorm0 p : 1 <= p -> 'N_p[cst 0] = 0. Proof. rewrite unlock /Lnorm. case: p => [r||//]. @@ -94,23 +94,54 @@ case: ifPn => //mu0 _; rewrite (ess_sup_ae_cst 0)//. by apply: nearW => x; rewrite /= normr0. Qed. -Lemma Lnorm1 f : 'N_1[f] = \int[mu]_x `|f x|%:E. +Lemma Lnorm1 f : 'N_1[f] = \int[mu]_x `|f x|. Proof. rewrite unlock invr1// poweRe1//; under eq_integral do [rewrite poweRe1//=] => //. exact: integral_ge0. Qed. -Lemma Lnorm_ge0 p f : 0 <= 'N_p[f]. +Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. +Proof. by move=> fg; congr Lnorm; apply/eq_fun => ?; rewrite /= fg. Qed. + +Lemma poweR_Lnorm f r : r != 0%R -> + 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r). +Proof. +move=> r0; rewrite unlock -poweRrM mulVf// poweRe1//. +by apply: integral_ge0 => x _; exact: poweR_ge0. +Qed. + +Lemma oppe_Lnorm f p : 'N_p[\- f]%E = 'N_p[f]. +Proof. +have NfE : abse \o (\- f) = abse \o f. + by apply/funext => x /=; rewrite abseN. +rewrite unlock /Lnorm NfE; case: p => /= [r|//|//]. +by under eq_integral => x _ do rewrite abseN. +Qed. + +Lemma Lnorm_cst1 r : ('N_r%:E[cst 1] = (mu setT)`^(r^-1)). +Proof. +rewrite unlock /Lnorm; under eq_integral do rewrite /= normr1 powR1. +by rewrite integral_cst// mul1e. +Qed. + +End Lnorm_properties. + +Section Lnorm_properties. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. +Implicit Types (p : \bar R) (f g : T -> R) (r : R). + +Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). + +Lemma Lnormr_ge0 p f : 0 <= 'N_p[f]. Proof. rewrite unlock; move: p => [r/=|/=|//]; first exact: poweR_ge0. - by case: ifPn => // /ess_sup_ger; apply => t/=. - by case: ifPn => // muT0; apply/ess_infP/nearW => x /=. Qed. -Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. -Proof. by move=> fg; congr Lnorm; apply/eq_fun => ?; rewrite /= fg. Qed. - -Lemma Lnorm_eq0_eq0 (f : T -> R) p : +Lemma Lnormr_eq0_eq0 (f : T -> R) p : measurable_fun setT f -> (0 < p)%E -> 'N_p[f] = 0 -> f = 0%R %[ae mu]. Proof. rewrite unlock /Lnorm => mf. @@ -136,32 +167,21 @@ Qed. Lemma powR_Lnorm f r : r != 0%R -> 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r)%:E. -Proof. -move=> r0; rewrite unlock -poweRrM mulVf// poweRe1//. -by apply: integral_ge0 => x _; rewrite lee_fin// powR_ge0. -Qed. +Proof. by move=> r0; rewrite poweR_Lnorm. Qed. Lemma oppr_Lnorm f p : 'N_p[\- f]%R = 'N_p[f]. -Proof. -have NfE : abse \o (EFin \o (\- f)%R) = abse \o EFin \o f. - by apply/funext => x /=; rewrite normrN. -rewrite unlock /Lnorm NfE; case: p => /= [r|//|//]. -by under eq_integral => x _ do rewrite normrN. -Qed. - -Lemma Lnorm_cst1 r : ('N_r%:E[cst 1%R] = (mu setT)`^(r^-1)). -Proof. -rewrite unlock /Lnorm; under eq_integral do rewrite /= normr1 powR1. -by rewrite integral_cst// mul1e. -Qed. +Proof. by rewrite -[RHS]oppe_Lnorm. Qed. End Lnorm_properties. +#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed to `Lnormr_ge0`")] +Notation Lnorm_ge0 := Lnormr_ge0 (only parsing). +#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed to `Lnormr_eq0_eq0`")] +Notation Lnorm_eq0_eq0 := Lnormr_eq0_eq0 (only parsing). #[global] +Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnormr_ge0] : core. -Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnorm_ge0] : core. - -Notation "'N[ mu ]_ p [ f ]" := (Lnorm mu p f). +Notation "'N[ mu ]_ p [ f ]" := (Lnorm mu p f) : ereal_scope. Section lnorm. Context d {T : measurableType d} {R : realType}. @@ -243,14 +263,14 @@ rewrite -lte_fin. move=> mf mg p0 q0 pq f0; rewrite f0 mul0e Lnorm1 [leLHS](_ : _ = 0)//. rewrite (ae_eq_integral (cst 0)) => [|//||//|]; first by rewrite integral0. - by do 2 apply: measurableT_comp => //; exact: measurable_funM. -- apply: filterS (Lnorm_eq0_eq0 mf p0 f0) => x /(_ I) + _. - by rewrite normrM => ->; rewrite normr0 mul0r. +- apply: filterS (Lnormr_eq0_eq0 mf p0 f0) => x /(_ I) + _. + by rewrite /= normrM => ->; rewrite normr0 mul0r. Qed. Let normalized p f x := `|f x| / fine 'N_p%:E[f]. Let normalized_ge0 p f x : (0 <= normalized p f x)%R. -Proof. by rewrite /normalized divr_ge0// fine_ge0// Lnorm_ge0. Qed. +Proof. by rewrite /normalized divr_ge0// fine_ge0// Lnormr_ge0. Qed. Let measurable_normalized p f : measurable_fun [set: T] f -> measurable_fun [set: T] (normalized p f). @@ -263,8 +283,8 @@ Proof. move=> p0 fpos ifp. transitivity (\int[mu]_x (`|f x| `^ p / fine ('N_p%:E[f] `^ p))%:E). apply: eq_integral => t _. - rewrite powRM//; last by rewrite invr_ge0 fine_ge0// Lnorm_ge0. - rewrite -[in LHS]powR_inv1; last by rewrite fine_ge0 // Lnorm_ge0. + rewrite powRM//; last by rewrite invr_ge0 fine_ge0// Lnormr_ge0. + rewrite -[in LHS]powR_inv1; last by rewrite fine_ge0 // Lnormr_ge0. by rewrite fine_poweR powRAC -powR_inv1 // powR_ge0. have fp0 : 0 < \int[mu]_x (`|f x| `^ p)%:E. rewrite unlock in fpos. @@ -280,7 +300,8 @@ rewrite integralZl//; apply/eqP; rewrite eqe_pdivrMl ?mule1. - by rewrite gt_eqF// fine_gt0// foo andbT. Qed. -Lemma hoelder f g p q : measurable_fun setT f -> measurable_fun setT g -> +Lemma hoelder (f g : T -> R) p q : + measurable_fun [set: T] f -> measurable_fun [set: T] g -> (0 < p)%R -> (0 < q)%R -> (p^-1 + q^-1 = 1)%R -> 'N_1[(f \* g)%R] <= 'N_p%:E[f] * 'N_q%:E[g]. Proof. @@ -289,26 +310,26 @@ have [f0|f0] := eqVneq 'N_p%:E[f] 0%E; first exact: hoelder0. have [g0|g0] := eqVneq 'N_q%:E[g] 0%E. rewrite muleC; apply: le_trans; last by apply: hoelder0 => //; rewrite addrC. by under eq_Lnorm do rewrite /= mulrC. -have {f0}fpos : 0 < 'N_p%:E[f] by rewrite lt0e f0 Lnorm_ge0. -have {g0}gpos : 0 < 'N_q%:E[g] by rewrite lt0e g0 Lnorm_ge0. +have {f0}fpos : 0 < 'N_p%:E[f] by rewrite lt0e f0 Lnormr_ge0. +have {g0}gpos : 0 < 'N_q%:E[g] by rewrite lt0e g0 Lnormr_ge0. have [foo|foo] := eqVneq 'N_p%:E[f] +oo%E; first by rewrite foo gt0_mulye ?leey. have [goo|goo] := eqVneq 'N_q%:E[g] +oo%E; first by rewrite goo gt0_muley ?leey. pose F := normalized p f; pose G := normalized q g. rewrite [leLHS](_ : _ = 'N_1[(F \* G)%R] * 'N_p%:E[f] * 'N_q%:E[g]); last first. rewrite !Lnorm1; under [in RHS]eq_integral. move=> x _; rewrite /F /G /normalized/=. - rewrite ger0_norm; last by rewrite mulr_ge0 ?divr_ge0 ?fine_ge0 ?Lnorm_ge0. + rewrite ger0_norm; last by rewrite mulr_ge0 ?divr_ge0 ?fine_ge0 ?Lnormr_ge0. by rewrite mulrACA -normrM EFinM; over. rewrite ge0_integralZr//; last 2 first. - by do 2 apply: measurableT_comp => //; exact: measurable_funM. - - by rewrite lee_fin mulr_ge0// invr_ge0 fine_ge0// Lnorm_ge0. + - by rewrite lee_fin mulr_ge0// invr_ge0 fine_ge0// Lnormr_ge0. rewrite -!muleA [X in _ * X](_ : _ = 1) ?mule1// EFinM muleACA. rewrite (_ : _ * 'N_p%:E[f] = 1) ?mul1e; last first. - rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnorm_ge0. + rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnormr_ge0. by rewrite -EFinM mulVr ?unitfE ?gt_eqF// fine_gt0// fpos/= ltey. - rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnorm_ge0. + rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnormr_ge0. by rewrite -EFinM mulVr ?unitfE ?gt_eqF// fine_gt0// gpos/= ltey. -rewrite -(mul1e ('N_p%:E[f] * _)) -muleA lee_pmul ?mule_ge0 ?Lnorm_ge0//. +rewrite -(mul1e ('N_p%:E[f] * _)) -muleA lee_pmul ?mule_ge0 ?Lnormr_ge0//. rewrite [leRHS](_ : _ = \int[mu]_x (F x `^ p / p + G x `^ q / q)%:E). rewrite Lnorm1 ae_ge0_le_integral //. - do 2 apply: measurableT_comp => //. @@ -458,7 +479,7 @@ Let minkowski1 f g p : measurable_fun [set: T] f -> measurable_fun [set: T] g -> 'N_1[(f \+ g)%R] <= 'N_1[f] + 'N_1[g]. Proof. move=> mf mg. -rewrite !Lnorm1 -ge0_integralD//; [|by do 2 apply: measurableT_comp..]. +rewrite !Lnorm1 -ge0_integralD//=; [|by do 2 apply: measurableT_comp..]. rewrite ge0_le_integral//. - by do 2 apply: measurableT_comp => //; exact: measurable_funD. - by move=> x _; rewrite adde_ge0. @@ -505,25 +526,25 @@ Lemma minkowski_EFin f g p : Proof. move=> mf mg; rewrite le_eqVlt => /predU1P[<-|p1]; first exact: minkowski1. have [->|Nfoo] := eqVneq 'N_p%:E[f] +oo. - by rewrite addye ?leey// -ltNye (lt_le_trans _ (Lnorm_ge0 _ _ _)). + by rewrite addye ?leey// -ltNye (lt_le_trans _ (Lnormr_ge0 _ _ _)). have [->|Ngoo] := eqVneq 'N_p%:E[g] +oo. - by rewrite addey ?leey// -ltNye (lt_le_trans _ (Lnorm_ge0 _ _ _)). + by rewrite addey ?leey// -ltNye (lt_le_trans _ (Lnormr_ge0 _ _ _)). have Nfgoo : 'N_p%:E[(f \+ g)%R] < +oo. by rewrite minkowski_lty// ?ltW// ltey; [exact: Nfoo|exact: Ngoo]. suff : 'N_p%:E[(f \+ g)%R] `^ p <= ('N_p%:E[f] + 'N_p%:E[g]) * 'N_p%:E[(f \+ g)%R] `^ p * (fine 'N_p%:E[(f \+ g)%R])^-1%:E. have [-> _|Nfg0] := eqVneq 'N_p%:E[(f \+ g)%R] 0. - by rewrite adde_ge0 ?Lnorm_ge0. - rewrite lee_pdivlMr ?fine_gt0// ?lt0e ?Nfg0 ?Lnorm_ge0//. + by rewrite adde_ge0 ?Lnormr_ge0. + rewrite lee_pdivlMr ?fine_gt0// ?lt0e ?Nfg0 ?Lnormr_ge0//. rewrite -{1}(@fineK _ ('N_p%:E[(f \+ g)%R] `^ p)); last first. - by rewrite fin_num_poweR// ge0_fin_numE// Lnorm_ge0. + by rewrite fin_num_poweR// ge0_fin_numE// Lnormr_ge0. rewrite -(invrK (fine _)) lee_pdivrMl; last first. rewrite invr_gt0 fine_gt0// (poweR_lty _ Nfgoo) andbT poweR_gt0//. - by rewrite lt0e Nfg0 Lnorm_ge0. - rewrite fineK ?ge0_fin_numE ?Lnorm_ge0// => /le_trans; apply. + by rewrite lt0e Nfg0 Lnormr_ge0. + rewrite fineK ?ge0_fin_numE ?Lnormr_ge0// => /le_trans; apply. rewrite lee_pdivrMl; last first. - by rewrite fine_gt0// poweR_lty// andbT poweR_gt0// lt0e Nfg0 Lnorm_ge0. - by rewrite fineK// 1?muleC// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. + by rewrite fine_gt0// poweR_lty// andbT poweR_gt0// lt0e Nfg0 Lnormr_ge0. + by rewrite fineK// 1?muleC// fin_num_poweR// ge0_fin_numE ?Lnormr_ge0. have p0 : (0 < p)%R by exact: (lt_trans _ p1). rewrite powR_Lnorm ?gt_eqF//. under eq_integral => x _ do rewrite -mulr_powRB1//. @@ -549,12 +570,12 @@ rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * (\int[mu]_x (`|f x + g x| `^ p)%:E) `^ `1-(p^-1)). rewrite muleDl; last 2 first. - rewrite fin_num_poweR// -powR_Lnorm ?gt_eqF// fin_num_poweR//. - by rewrite ge0_fin_numE ?Lnorm_ge0. - - by rewrite ge0_adde_def// inE Lnorm_ge0. + by rewrite ge0_fin_numE ?Lnormr_ge0. + - by rewrite ge0_adde_def// inE Lnormr_ge0. apply: leeD. - pose h := (@powR R ^~ (p - 1) \o normr \o (f \+ g))%R; pose i := (f \* h)%R. rewrite [leLHS](_ : _ = 'N_1[i]%R); last first. - rewrite Lnorm1; apply: eq_integral => x _. + rewrite Lnorm1; apply: eq_integral => x _ /=. by rewrite normrM (ger0_norm (powR_ge0 _ _)). rewrite [X in _ * X](_ : _ = 'N_(p / (p - 1))%:E[h]); last first. rewrite unlock. @@ -568,7 +589,7 @@ rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * + by rewrite invf_div -onemV ?gt_eqF// addrCA subrr addr0. - pose h := (fun x => `|f x + g x| `^ (p - 1))%R; pose i := (g \* h)%R. rewrite [leLHS](_ : _ = 'N_1[i]); last first. - rewrite Lnorm1; apply: eq_integral => x _ . + rewrite Lnorm1; apply: eq_integral => x _ /=. by rewrite normrM norm_powR// normr_id. rewrite [X in _ * X](_ : _ = 'N_((1 - p^-1)^-1)%:E[h])//; last first. rewrite unlock. @@ -586,7 +607,7 @@ rewrite poweRD; last by rewrite poweRD_defE gt_eqF ?implyFb// subr_gt0 invf_lt1. rewrite poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. congr (_ * _); rewrite poweRN. - by rewrite unlock fine_poweR. -- by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. +- by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnormr_ge0. Qed. Lemma lerB_DLnorm f g p : @@ -611,7 +632,7 @@ move=> mf mg p1. set rhs := (leRHS); have [?|] := boolP (rhs \is a fin_num). by rewrite lee_subel_addr//; exact: lerB_DLnorm. rewrite fin_numEn => /orP[|/eqP ->]; last by rewrite leey. -by rewrite gt_eqF// (lt_le_trans _ (Lnorm_ge0 _ _ _)). +by rewrite gt_eqF// (lt_le_trans _ (Lnormr_ge0 _ _ _)). Qed. (* TODO: rename to minkowski after version 1.12.0 *) @@ -630,7 +651,6 @@ End minkowski. note="use `minkowski_EFin` or `eminkowski` instead")] Notation minkowski := minkowski_EFin (only parsing). - Definition finite_norm d (T : measurableType d) (R : realType) (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := ('N[ mu ]_p [ EFin \o f ] < +oo)%E. @@ -838,7 +858,7 @@ case: p p1 f => //[r r1 f|? f]. exact: measurableT_comp. apply: (@lty_poweRy _ _ r^-1). by rewrite gt_eqF// invr_gt0 ?(lt_le_trans ltr01). - rewrite [ltLHS](_ : _ = 'N[mu]_r%:E[EFin \o f]); first exact: (lfuny r1 f). + rewrite [ltLHS](_ : _ = 'N[mu]_r%:E[EFin \o f]%E); first exact: (lfuny r1 f). rewrite unlock /Lnorm. by under eq_integral do rewrite gee0_abs ?lee_fin ?powR_ge0//. rewrite poweRM ?integral_ge0//. @@ -879,19 +899,19 @@ Variables (p : \bar R) (p1 : (1 <= p)%E). Notation ty := (LfunType mu p1). Let nm f := fine ('N[mu]_p[EFin \o f]). -Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]. +Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]%E. Proof. -rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. +rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnormr_ge0//=. exact: lfuny. Qed. Lemma ler_LnormD (f g : ty) : nm (f + g) <= nm f + nm g. Proof. by rewrite -lee_fin EFinD !finite_norm_fine eminkowski. Qed. -Lemma LnormN (f : ty) : nm (\-f) = nm f. +Lemma LnormrN (f : ty) : nm (\-f) = nm f. Proof. by rewrite /nm oppr_Lnorm. Qed. -Lemma Lnorm_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. +Lemma Lnormr_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. Proof. apply/EFin_inj; rewrite finite_norm_fine -scaler_nat LnormZ normr_nat. by rewrite -[in RHS]mulr_natl EFinM finite_norm_fine. @@ -906,10 +926,10 @@ HB.instance Definition _ := (* TODO: add equivalent of mx_normZ and HB instance *) -Lemma fine_Lnorm_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. +Lemma fine_Lnormr_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. Proof. move=> /eqP; rewrite -eqe => /eqP. -rewrite finite_norm_fine => /Lnorm_eq0_eq0. +rewrite finite_norm_fine => /Lnormr_eq0_eq0. by apply; rewrite ?(lt_le_trans _ p1). Qed. From d87492fa16fc7ba6e2708a65136d457221ed9e8e Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Tue, 18 Mar 2025 17:49:11 +0900 Subject: [PATCH 25/73] generalized cantelli and use of lfun --- CHANGELOG_UNRELEASED.md | 9 ++- theories/hoelder.v | 142 ++++++++++++++++++++++++---------------- theories/probability.v | 15 +++-- 3 files changed, 106 insertions(+), 60 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 4d75d4555a..2f95f0dcd7 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -119,7 +119,7 @@ + record `LType` + coercion `LfunType_of_LType` + definition `Lspace` with notation `mu.-Lspace p` - + lemma `LType1_integrable`, `LType2_integrable_sqr` + + lemma `lfun1_integrable`, `lfun2_integrable_sqr`, `lfun2M2_1` + definitions `finlfun`, `lfun`, `lfun_key` + canonical `lfun_keyed` + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` @@ -130,6 +130,8 @@ + lemmas `finite_norm_fine`, `ler_LnormD`, `LnormrN`, `Lnormr_natmul`, `fine_Lnormr_eq0` + lemma `Lspace_inclusion` + `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` + + lemma `lfun_inclusion`, `lfun_inclusion12` - in `lebesgue_integral.v`: + lemma `mfunMn` @@ -177,6 +179,8 @@ - in `hoelder.v`: + lemmas `poweR_Lnorm`, `oppe_Lnorm` +- in `probability.v`: + + lemma `lfun1_expectation_lty` ### Changed @@ -278,6 +282,9 @@ (this impacts the notation `'N_p[f]`) + lemmas `Lnorm1`, `eq_Lnorm` (from `f : _ -> R` to `f : _ -> \bar R`) +- in `probability.v` + + lemma `cantelli` + ### Deprecated ### Removed diff --git a/theories/hoelder.v b/theories/hoelder.v index ad593ee490..95cf707087 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -721,55 +721,6 @@ Coercion LfunType_of_LType (f : LType) : LfunType mu p1 := End Lequiv. -Section Lspace. -Context d (T : measurableType d) (R : realType). -Variable mu : {measure set T -> \bar R}. - -Definition Lspace p (p1 : (1 <= p)%E) := [set: LType mu p1]. -Arguments Lspace : clear implicits. - -Lemma LType1_integrable (f : LType mu (@lexx _ _ 1%E)) : - mu.-integrable setT (EFin \o f). -Proof. -apply/integrableP; split; first exact/measurable_EFinP. -have := lfuny _ f. -rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. - by apply integral_ge0 => x _; rewrite lee_fin powRr1. -by under eq_integral => i _ do rewrite poweRe1//. -Qed. - -Let le12 : (1 <= 2%:E :> \bar R)%E. -Proof. -rewrite lee_fin. -rewrite (ler_nat _ 1 2). -by []. -Qed. - -Lemma LType2_integrable_sqr (f : LType mu le12) : - mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). -Proof. -apply/integrableP; split. - apply/measurable_EFinP. - exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). -rewrite (@lty_poweRy _ _ 2^-1)//. -rewrite (le_lt_trans _ (lfuny _ f))//. -rewrite unlock. -rewrite gt0_ler_poweR//. -- by rewrite in_itv/= leey integral_ge0. -- by rewrite in_itv/= leey integral_ge0. -- rewrite ge0_le_integral//. - + apply: measurableT_comp => //; apply/measurable_EFinP. - exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). - + by move=> x _; rewrite lee_fin powR_ge0. - + apply/measurable_EFinP. - apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. - exact/measurableT_comp. - + by move=> t _/=; rewrite lee_fin normrX powR_mulrn. -Qed. - -End Lspace. -Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. - Section lfun_pred. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). @@ -935,18 +886,86 @@ Qed. End Lspace_norm. -Section Lspace_inclusion. + +Section Lspace. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. + +Definition Lspace p (p1 : (1 <= p)%E) := [set: LType mu p1]. +Arguments Lspace : clear implicits. + +Definition LType1 := LType mu (@lexx _ _ 1%E). + +Let le12 : (1 <= 2%:E :> \bar R)%E. +Proof. by rewrite lee_fin (ler_nat _ 1 2). Qed. + +Definition LType2 := LType mu le12. + +Lemma lfun1_integrable (f : {mfun T >-> R}) : + (f : T -> R) \in lfun mu 1 -> mu.-integrable setT (EFin \o f). +Proof. +rewrite inE => /andP[_]; rewrite inE/= => l1f. +apply/integrableP; split; first exact/measurable_EFinP. +move: l1f; rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. + by apply integral_ge0 => x _; rewrite lee_fin powRr1. +by under eq_integral => i _ do rewrite poweRe1//. +Qed. + +Lemma lfun2_integrable_sqr (f : {mfun T >-> R}) : + (f : T -> R) \in lfun mu 2%:E -> + mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). +Proof. +rewrite inE => /andP[_]; rewrite inE/= => l2f. +apply/integrableP; split. + apply/measurable_EFinP. + exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). +rewrite (@lty_poweRy _ _ 2^-1)//. +rewrite (le_lt_trans _ l2f)//. +rewrite unlock. +rewrite gt0_ler_poweR//. +- by rewrite in_itv/= leey integral_ge0. +- by rewrite in_itv/= leey integral_ge0. +- rewrite ge0_le_integral//. + + apply: measurableT_comp => //; apply/measurable_EFinP. + exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). + + by move=> x _; rewrite lee_fin powR_ge0. + + apply/measurable_EFinP. + apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. + exact/measurableT_comp. + + by move=> t _/=; rewrite lee_fin normrX powR_mulrn. +Qed. + +Lemma lfun2M2_1 (f g : {mfun T >-> R}) : + (f : T -> R) \in lfun mu 2%:E -> (g : T -> R) \in lfun mu 2%:E -> + (f \* g : T -> R) \in lfun mu 1. +Proof. +move=> l2f l2g. +rewrite inE; apply/andP; split; rewrite inE//=. +rewrite /finite_norm. +apply: le_lt_trans. + by apply: (@hoelder _ _ _ _ _ _ 2 2) => //; rewrite [RHS]splitr !div1r. +rewrite lte_mul_pinfty// ?ge0_fin_numE ?Lnormr_ge0//. +by move: l2f; rewrite inE => /andP[_]; rewrite inE/=. +by move: l2g; rewrite inE => /andP[_]; rewrite inE/=. +Qed. + +End Lspace. +Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. + +Section lfun_inclusion. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. Local Open Scope ereal_scope. -Lemma Lspace_inclusion (p q : \bar R) : +Lemma lfun_inclusion (p q : \bar R) : forall (p1 : 1 <= p) (q1 : 1 <= q), mu [set: T] < +oo -> p < q -> - forall f : {mfun T >-> R}, finite_norm mu q f -> finite_norm mu p f. + forall f : {mfun T >-> R}, + (f : T -> R) \in lfun mu q -> (f : T -> R) \in lfun mu p. Proof. have := measure_ge0 mu [set: T]. rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. + rewrite inE; apply/andP; split; rewrite inE//=. rewrite /finite_norm unlock /Lnorm. move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. move=> r r1. @@ -960,7 +979,9 @@ move: p q. case=> //[p|]; case=> //[q|] p1 q1; last first. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). move=> muoo _ f. - rewrite /finite_norm unlock /Lnorm mu_pos => supf_lty. + rewrite !inE => /andP[_]. + rewrite !inE/= /finite_norm unlock /Lnorm mu_pos => supf_lty. + apply/andP; split; rewrite inE//= /finite_norm unlock /Lnorm. rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. by rewrite integral_cst// lte_mul_pinfty// lee_fin powR_ge0. @@ -973,7 +994,9 @@ case=> //[p|]; case=> //[q|] p1 q1; last first. apply: filterS fM => t/= ftM _. rewrite lee_fin ge0_ler_powR//; first exact: ltW. by rewrite nnegrE (le_trans _ ftM). -move=> mu_fin pleq f ffin. +move=> mu_fin pleq f. +rewrite inE/= => /andP[_]; rewrite inE/= => ffin. +rewrite inE/=; apply/andP; split; rewrite inE//=. have:= ffin; rewrite /finite_norm. have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). have pN0 : p != 0%R by rewrite gt_eqF. @@ -1010,4 +1033,13 @@ rewrite poweR_lty// (lty_poweRy qinv0)//. by have:= ffin; rewrite /finite_norm unlock /Lnorm. Qed. -End Lspace_inclusion. +Lemma lfun_inclusion12 (f : {mfun T >-> R}) : + mu [set: T] < +oo -> (f : T -> R) \in lfun mu (2%:E) -> (f : T -> R) \in lfun mu 1. +Proof. +move => muoo f2. +have le12 : (1 <= 2%:E :> \bar R) by rewrite lee_fin (ler_nat _ 1 2). +have lte12 : (1 < 2%:E :> \bar R) by rewrite lte_fin (ltr_nat _ 1 2). +exact: (@lfun_inclusion 1 (2%:E) (lexx _) le12 _ lte12). +Qed. + +End lfun_inclusion. diff --git a/theories/probability.v b/theories/probability.v index bb799a3891..466246d742 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -8,7 +8,7 @@ From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. From mathcomp Require Import reals interval_inference ereal topology normedtype. From mathcomp Require Import sequences derive esum measure exp trigo realfun. From mathcomp Require Import numfun lebesgue_measure lebesgue_integral kernel. -From mathcomp Require Import ftc gauss_integral. +From mathcomp Require Import ftc gauss_integral hoelder. (**md**************************************************************************) (* # Probability *) @@ -273,6 +273,10 @@ move: iX => /integrableP[? Xoo]; rewrite (le_lt_trans _ Xoo)// unlock. exact: le_trans (le_abse_integral _ _ _). Qed. +Lemma finite_norm_expectation (X : {RV P >-> R}) : + (X : T -> R) \in lfun P 1 -> `| 'E_P[X] | < +oo. +Proof. by move/lfun1_integrable; exact: integrable_expectation. Qed. + Lemma expectationZl (X : {RV P >-> R}) (iX : P.-integrable [set: T] (EFin \o X)) (k : R) : 'E_P[k \o* X] = k%:E * 'E_P [X]. Proof. by rewrite unlock muleC -integralZr. Qed. @@ -332,6 +336,9 @@ HB.lock Definition covariance {d} {T : measurableType d} {R : realType} Canonical covariance_unlockable := Unlockable covariance.unlock. Arguments covariance {d T R} P _%_R _%_R. +Hint Extern 0 (fin_num_fun _) => + (apply: fin_num_measure) : core. + Section covariance_lemmas. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (P : probability T R). @@ -715,12 +722,12 @@ by move=> /le_trans; apply; rewrite /variance [in leRHS]unlock. Qed. Lemma cantelli (X : {RV P >-> R}) (lambda : R) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - (0 < lambda)%R -> + (X : T -> R) \in lfun P 2%:E -> (0 < lambda)%R -> P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] <= (fine 'V_P[X] / (fine 'V_P[X] + lambda^2))%:E. Proof. -move=> X1 X2 lambda_gt0. +move=>/[dup] /lfun2_integrable_sqr X2 /lfun_inclusion12 /lfun1_integrable. +rewrite fin_num_fun_lty// => /(_ isT) X1 lambda_gt0. have finEK : (fine 'E_P[X])%:E = 'E_P[X]. by rewrite fineK ?unlock ?integral_fune_fin_num. have finVK : (fine 'V_P[X])%:E = 'V_P[X] by rewrite fineK ?variance_fin_num. From c19331a9bf0472bc079b28dd36f8861534648dc9 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Wed, 19 Mar 2025 01:18:44 +0900 Subject: [PATCH 26/73] integrable -> lfun & simplifications (#31) * integrable -> lfun & simplifications --- CHANGELOG_UNRELEASED.md | 10 +- theories/hoelder.v | 100 +++++++++++- theories/probability.v | 334 +++++++++++++++++----------------------- 3 files changed, 249 insertions(+), 195 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 2f95f0dcd7..19659c86e6 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -119,7 +119,8 @@ + record `LType` + coercion `LfunType_of_LType` + definition `Lspace` with notation `mu.-Lspace p` - + lemma `lfun1_integrable`, `lfun2_integrable_sqr`, `lfun2M2_1` + + lemma `lfun_integrable`, `lfun1_integrable`, `lfun2_integrable_sqr`, `lfun2M2_1` + + lemma `lfunp_scale`, `lfunN`, `lfunD`, `lfunB`, `lfun_cst`, `lfun_sum` + definitions `finlfun`, `lfun`, `lfun_key` + canonical `lfun_keyed` + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` @@ -219,6 +220,13 @@ + definiton `ae_eq` + definition `ess_sup` moved to `ess_sup_inf.v` +- in `probability.v` + + lemma `expectation_fin_num`, `expectationZl`, `expectationD`, `expectationB`, `expectation_sum`, + `covarianceE`, `covariance_fin_num`, `covarianceZl`, `covarianceZr`, `covarianceNl`, + `covarianceNr`, `covarianceNN`, `covarianceDl`, `covarianceDr`, `covarianceBl`, `covarianceBr`, + `varianceE`, `variance_fin_num`, `varianceZ`, `varianceN`, `varianceD`, `varianceB`, + `varianceD_cst_l`, `varianceD_cst_r`, `varianceB_cst_l`, `varianceB_cst_r`, `covariance_le` + ### Renamed - in `kernel.v`: diff --git a/theories/hoelder.v b/theories/hoelder.v index 95cf707087..7dafed0d31 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -901,14 +901,35 @@ Proof. by rewrite lee_fin (ler_nat _ 1 2). Qed. Definition LType2 := LType mu le12. +Lemma lfun_integrable (f : {mfun T >-> R}) r : + 1 <= r -> (f : T -> R) \in lfun mu r%:E -> mu.-integrable setT (fun x => (`|f x| `^ r)%:E). +Proof. +rewrite inE => r0 /andP[_]; rewrite inE/= => lpf. +have ? : measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). + apply: measurableT_comp => //. + apply: (measurableT_comp (measurable_powR _)) => //. + exact: measurableT_comp. +apply/integrableP; split => //. +apply/abse_integralP => //. +move: lpf. +rewrite /finite_norm => /(poweR_lty r); rewrite powR_Lnorm// ?gt_eqF// ?(lt_le_trans ltr01)//. +move=> ?. +apply/abse_integralP => //. +under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. +by []. +Qed. + Lemma lfun1_integrable (f : {mfun T >-> R}) : (f : T -> R) \in lfun mu 1 -> mu.-integrable setT (EFin \o f). Proof. -rewrite inE => /andP[_]; rewrite inE/= => l1f. -apply/integrableP; split; first exact/measurable_EFinP. -move: l1f; rewrite /finite_norm unlock /Lnorm invr1 poweRe1; last first. - by apply integral_ge0 => x _; rewrite lee_fin powRr1. -by under eq_integral => i _ do rewrite poweRe1//. +move=> /lfun_integrable => /(_ (lexx _)). +under eq_fun => x do rewrite powRr1//. +move/integrableP => [? fley]. +apply/integrableP; split. + exact: measurableT_comp. +rewrite (le_lt_trans _ fley)//=. +under [leRHS]eq_integral => x _ do rewrite normr_id. +exact: lexx. Qed. Lemma lfun2_integrable_sqr (f : {mfun T >-> R}) : @@ -949,6 +970,75 @@ by move: l2f; rewrite inE => /andP[_]; rewrite inE/=. by move: l2g; rewrite inE => /andP[_]; rewrite inE/=. Qed. +Lemma lfunp_scale (f : {mfun T >-> R}) a r : + 1 <= r -> (f : T -> R) \in lfun mu r%:E -> (a \o* f) \in lfun mu r%:E. +Proof. +move=> r1 lpf. +rewrite inE; apply/andP; split; rewrite inE//=. +rewrite /finite_norm unlock /Lnorm. +rewrite poweR_lty//=. +under eq_integral => x _ do rewrite normrM powRM// EFinM. +rewrite integralZr// ?lfun_integrable//. +rewrite muleC lte_mul_pinfty// ?lee_fin ?powR_ge0//. +move: lpf => /(lfun_integrable r1) /integrableP [_]. +under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. +by []. +Qed. + +Lemma lfunN (f : {mfun T >-> R}) r : + (f : T -> R) \in lfun mu r%:E -> (\- f : T -> R) \in lfun mu r%:E. +Proof. +move=> lpf. +rewrite inE; apply/andP; split; rewrite inE//= /finite_norm. +rewrite unlock /Lnorm. +under eq_integral => x _/= do rewrite normrN. +move: lpf. +rewrite inE; move/andP => [_]. rewrite inE/=/finite_norm unlock/Lnorm/=. +exact. +Qed. + +Lemma lfunD (f g : {mfun T >-> R}) r : + 1 <= r -> (f : T -> R) \in lfun mu r%:E -> (g : T -> R) \in lfun mu r%:E -> + (f \+ g : T -> R) \in lfun mu r%:E. +Proof. +rewrite !inE => r1 /andP[_] +/andP[_]; rewrite !inE/= /finite_norm => lpf lpg. +apply/andP; split; rewrite inE//= /finite_norm. +apply: (le_lt_trans (minkowski mu _ _ r1)) => //. +by rewrite lte_add_pinfty. +Qed. + +Lemma lfunB (f g : {mfun T >-> R}) r : + 1 <= r -> (f : T -> R) \in lfun mu r%:E -> (g : T -> R) \in lfun mu r%:E -> + (f \- g : T -> R) \in lfun mu r%:E. +Proof. +by move=> r1 lpf lpg; rewrite (_ : f \- g = f \+ (\- g))// lfunD//= lfunN. +Qed. + +End Lspace. + +Section Lspace. +Context d (T : measurableType d) (R : realType). +Variable mu : {finite_measure set T -> \bar R}. + +Lemma lfun_cst c r : cst c \in lfun mu r%:E. +Proof. +rewrite inE; apply/andP; split; rewrite inE//= /finite_norm unlock/Lnorm poweR_lty//. +under eq_integral => x _/= do rewrite (_ : `|c| `^ r = cst (`|c| `^ r) x)//. +have /integrableP[_/=] := finite_measure_integrable_cst mu (`|c| `^ r). +under eq_integral => x _ do rewrite ger0_norm ?powR_ge0//. +by []. +Qed. + +Lemma lfun_sum (F : seq {mfun T >-> R}) r : + (forall Fi, Fi \in F -> (Fi : T -> R) \in lfun mu r%:E) -> + (1 <= r)%R -> + (\sum_(Fi <- F) Fi : T -> R) \in lfun mu r%:E. +Proof. +elim: F => //=[_|F0 F ih lpF r1]; first by rewrite big_nil lfun_cst. +rewrite big_cons lfunD//; first by rewrite lpF ?mem_head. +by rewrite ih// => Fi FiF; rewrite lpF ?in_cons ?FiF ?orbT. +Qed. + End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. diff --git a/theories/probability.v b/theories/probability.v index 466246d742..287299ebb7 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -256,9 +256,9 @@ Context d (T : measurableType d) (R : realType) (P : probability T R). Lemma expectation_def (X : {RV P >-> R}) : 'E_P[X] = (\int[P]_w (X w)%:E)%E. Proof. by rewrite unlock. Qed. -Lemma expectation_fin_num (X : {RV P >-> R}) : P.-integrable setT (EFin \o X) -> +Lemma expectation_fin_num (X : {RV P >-> R}) : (X : T -> R) \in lfun P 1 -> 'E_P[X] \is a fin_num. -Proof. by move=> ?; rewrite unlock integral_fune_fin_num. Qed. +Proof. by move=> ?; rewrite unlock integral_fune_fin_num ?lfun1_integrable. Qed. Lemma expectation_cst r : 'E_P[cst r] = r%:E. Proof. by rewrite unlock/= integral_cst//= probability_setT mule1. Qed. @@ -273,13 +273,9 @@ move: iX => /integrableP[? Xoo]; rewrite (le_lt_trans _ Xoo)// unlock. exact: le_trans (le_abse_integral _ _ _). Qed. -Lemma finite_norm_expectation (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> `| 'E_P[X] | < +oo. -Proof. by move/lfun1_integrable; exact: integrable_expectation. Qed. - -Lemma expectationZl (X : {RV P >-> R}) (iX : P.-integrable [set: T] (EFin \o X)) +Lemma expectationZl (X : {RV P >-> R}) (iX : (X : T -> R) \in lfun P 1) (k : R) : 'E_P[k \o* X] = k%:E * 'E_P [X]. -Proof. by rewrite unlock muleC -integralZr. Qed. +Proof. by rewrite unlock muleC -integralZr ?lfun1_integrable. Qed. Lemma expectation_ge0 (X : {RV P >-> R}) : (forall x, 0 <= X x)%R -> 0 <= 'E_P[X]. @@ -302,28 +298,25 @@ move=> mX mY X0 Y0 XY; rewrite unlock ae_ge0_le_integral => //. Qed. Lemma expectationD (X Y : {RV P >-> R}) : - P.-integrable [set: T] (EFin \o X) -> P.-integrable [set: T] (EFin \o Y) -> + (X : T -> R) \in lfun P 1 -> (Y : T -> R) \in lfun P 1 -> 'E_P[X \+ Y] = 'E_P[X] + 'E_P[Y]. -Proof. by move=> ? ?; rewrite unlock integralD_EFin. Qed. +Proof. by move=> ? ?; rewrite unlock integralD_EFin ?lfun1_integrable. Qed. Lemma expectationB (X Y : {RV P >-> R}) : - P.-integrable [set: T] (EFin \o X) -> P.-integrable [set: T] (EFin \o Y) -> + (X : T -> R) \in lfun P 1 -> (Y : T -> R) \in lfun P 1 -> 'E_P[X \- Y] = 'E_P[X] - 'E_P[Y]. -Proof. by move=> ? ?; rewrite unlock integralB_EFin. Qed. +Proof. by move=> ? ?; rewrite unlock integralB_EFin ?lfun1_integrable. Qed. Lemma expectation_sum (X : seq {RV P >-> R}) : - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + (forall Xi, Xi \in X -> (Xi : T -> R) \in lfun P 1) -> 'E_P[\sum_(Xi <- X) Xi] = \sum_(Xi <- X) 'E_P[Xi]. Proof. elim: X => [|X0 X IHX] intX; first by rewrite !big_nil expectation_cst. -have intX0 : P.-integrable [set: T] (EFin \o X0). +have intX0 : (X0 : T -> R) \in lfun P 1. by apply: intX; rewrite in_cons eqxx. -have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). +have {}intX Xi : Xi \in X -> (Xi : T -> R) \in lfun P 1. by move=> XiX; apply: intX; rewrite in_cons XiX orbT. -rewrite !big_cons expectationD ?IHX// (_ : _ \o _ = fun x => - \sum_(f <- map (fun x : {RV P >-> R} => EFin \o x) X) f x). - by apply: integrable_sum => // _ /mapP[h hX ->]; exact: intX. -by apply/funext => t/=; rewrite big_map sumEFin mfun_sum. +by rewrite !big_cons expectationD ?IHX ?lfun_sum. Qed. End expectation_lemmas. @@ -343,27 +336,21 @@ Section covariance_lemmas. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (P : probability T R). -Lemma covarianceE (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> +Lemma covarianceE (X Y : {mfun T >-> R}) : + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P X Y = 'E_P[X * Y] - 'E_P[X] * 'E_P[Y]. Proof. -move=> X1 Y1 XY1. -have ? : 'E_P[X] \is a fin_num by rewrite fin_num_abs// integrable_expectation. -have ? : 'E_P[Y] \is a fin_num by rewrite fin_num_abs// integrable_expectation. +move=> l1X l1Y l1XY. rewrite unlock [X in 'E_P[X]](_ : _ = (X \* Y \- fine 'E_P[X] \o* Y \- fine 'E_P[Y] \o* X \+ fine ('E_P[X] * 'E_P[Y]) \o* cst 1)%R); last first. - apply/funeqP => x /=; rewrite mulrDr !mulrDl/= mul1r fineM// mulrNN addrA. + apply/funeqP => x /=; rewrite mulrDr !mulrDl/= mul1r fineM ?expectation_fin_num// mulrNN addrA. by rewrite mulrN mulNr [Z in (X x * Y x - Z)%R]mulrC. -have ? : P.-integrable [set: T] (EFin \o (X \* Y \- fine 'E_P[X] \o* Y)%R). - by rewrite compreBr ?integrableB// compre_scale ?integrableZl. -rewrite expectationD/=; last 2 first. - - by rewrite compreBr// integrableB// compre_scale ?integrableZl. - - by rewrite compre_scale// integrableZl// finite_measure_integrable_cst. -rewrite 2?expectationB//= ?compre_scale// ?integrableZl//. -rewrite 3?expectationZl//= ?finite_measure_integrable_cst//. -by rewrite expectation_cst mule1 fineM// EFinM !fineK// muleC subeK ?fin_numM. +rewrite expectationD/= ?lfunB ?lfunp_scale ?lfun_cst//. +rewrite 2?expectationB//= ?lfunB ?lfunp_scale// 3?expectationZl//= ?lfun_cst//. +rewrite expectation_cst mule1 fineM ?expectation_fin_num// EFinM !fineK ?expectation_fin_num//. +by rewrite muleC subeK ?fin_numM ?expectation_fin_num. Qed. Lemma covarianceC (X Y : T -> R) : covariance P X Y = covariance P Y X. @@ -372,9 +359,9 @@ by rewrite unlock; congr expectation; apply/funeqP => x /=; rewrite mulrC. Qed. Lemma covariance_fin_num (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P X Y \is a fin_num. Proof. by move=> X1 Y1 XY1; rewrite covarianceE// fin_numB fin_numM expectation_fin_num. @@ -391,25 +378,25 @@ Lemma covariance_cst_r (X : {RV P >-> R}) c : covariance P X (cst c) = 0. Proof. by rewrite covarianceC covariance_cst_l. Qed. Lemma covarianceZl a (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P (a \o* X)%R Y = a%:E * covariance P X Y. Proof. move=> X1 Y1 XY1. have aXY : (a \o* X * Y = a \o* (X * Y))%R. by apply/funeqP => x; rewrite mulrAC. -rewrite [LHS]covarianceE => [||//|] /=; last 2 first. -- by rewrite compre_scale ?integrableZl. -- by rewrite aXY compre_scale ?integrableZl. +rewrite [LHS]covarianceE => [||//|] //=; last 2 first. +- by rewrite lfunp_scale. +- by rewrite aXY lfunp_scale. rewrite covarianceE// aXY !expectationZl//. by rewrite -muleA -muleBr// fin_num_adde_defr// expectation_fin_num. Qed. Lemma covarianceZr a (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P X (a \o* Y)%R = a%:E * covariance P X Y. Proof. move=> X1 Y1 XY1. @@ -417,9 +404,9 @@ by rewrite [in RHS]covarianceC covarianceC covarianceZl; last rewrite mulrC. Qed. Lemma covarianceNl (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P (\- X)%R Y = - covariance P X Y. Proof. move=> X1 Y1 XY1. @@ -428,33 +415,36 @@ by rewrite covarianceZl// EFinN mulNe mul1e. Qed. Lemma covarianceNr (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P X (\- Y)%R = - covariance P X Y. Proof. by move=> X1 Y1 XY1; rewrite !(covarianceC X) covarianceNl 1?mulrC. Qed. Lemma covarianceNN (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 1 -> + (Y : T -> R) \in lfun P 1 -> + ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P (\- X)%R (\- Y)%R = covariance P X Y. Proof. -move=> X1 Y1 XY1. -have NY : P.-integrable setT (EFin \o (\- Y)%R) by rewrite compreN ?integrableN. -by rewrite covarianceNl ?covarianceNr ?oppeK//= mulrN compreN ?integrableN. -Qed. +by move=> X1 Y1 XY1; rewrite covarianceNl//= ?covarianceNr ?oppeK ?mulrN//= ?lfunN. +Qed. Lemma covarianceDl (X Y Z : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Z)%R) -> - P.-integrable setT (EFin \o (Y * Z)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> + (Z : T -> R) \in lfun P 2%:E -> covariance P (X \+ Y)%R Z = covariance P X Z + covariance P Y Z. Proof. -move=> X1 X2 Y1 Y2 Z1 Z2 XZ1 YZ1. -rewrite [LHS]covarianceE//= ?mulrDl ?compreDr// ?integrableD//. +move=> X2 Y2 Z2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have X1 := lfun_inclusion12 Poo X2. +have Y1 := lfun_inclusion12 Poo Y2. +have Z1 := lfun_inclusion12 Poo Z2. +have XY1 := lfun2M2_1 X2 Y2. +have YZ1 := lfun2M2_1 Y2 Z2. +have XZ1 := lfun2M2_1 X2 Z2. +rewrite [LHS]covarianceE//= ?mulrDl ?compreDr ?lfunD//=. rewrite 2?expectationD//=. rewrite muleDl ?fin_num_adde_defr ?expectation_fin_num//. rewrite oppeD ?fin_num_adde_defr ?fin_numM ?expectation_fin_num//. @@ -462,41 +452,39 @@ by rewrite addeACA 2?covarianceE. Qed. Lemma covarianceDr (X Y Z : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Y)%R) -> - P.-integrable setT (EFin \o (X * Z)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> + (Z : T -> R) \in lfun P 2%:E -> covariance P X (Y \+ Z)%R = covariance P X Y + covariance P X Z. Proof. -move=> X1 X2 Y1 Y2 Z1 Z2 XY1 XZ1. -by rewrite covarianceC covarianceDl ?(covarianceC X) 1?mulrC. +by move=> X2 Y2 Z2; rewrite covarianceC covarianceDl ?(covarianceC X) 1?mulrC. Qed. Lemma covarianceBl (X Y Z : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Z)%R) -> - P.-integrable setT (EFin \o (Y * Z)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> + (Z : T -> R) \in lfun P 2%:E -> covariance P (X \- Y)%R Z = covariance P X Z - covariance P Y Z. Proof. -move=> X1 X2 Y1 Y2 Z1 Z2 XZ1 YZ1. -rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl//=. -- by rewrite compreN// integrableN. -- by rewrite mulrNN. -- by rewrite mulNr compreN// integrableN. +move=> X2 Y2 Z2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have Y1 := lfun_inclusion12 Poo Y2. +have Z1 := lfun_inclusion12 Poo Z2. +have YZ1 := lfun2M2_1 Y2 Z2. +by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl ?lfunN. Qed. Lemma covarianceBr (X Y Z : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Y)%R) -> - P.-integrable setT (EFin \o (X * Z)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> + (Z : T -> R) \in lfun P 2%:E -> covariance P X (Y \- Z)%R = covariance P X Y - covariance P X Z. Proof. -move=> X1 X2 Y1 Y2 Z1 Z2 XY1 XZ1. +move=> X2 Y2 Z2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have Y1 := lfun_inclusion12 Poo Y2. +have Z1 := lfun_inclusion12 Poo Z2. +have YZ1 := lfun2M2_1 Y2 Z2. by rewrite !(covarianceC X) covarianceBl 1?(mulrC _ X). Qed. @@ -510,14 +498,20 @@ Definition variance (X : T -> R) := covariance P X X. Local Notation "''V_' P [ X ]" := (variance X). Lemma varianceE (X : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[X] = 'E_P[X ^+ 2] - ('E_P[X]) ^+ 2. -Proof. by move=> X1 X2; rewrite /variance covarianceE. Qed. +Proof. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +by move=> X2; rewrite /variance covarianceE ?lfun2M2_1// lfun_inclusion12. +Qed. Lemma variance_fin_num (X : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o X ^+ 2)%R -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[X] \is a fin_num. -Proof. by move=> /[dup]; apply: covariance_fin_num. Qed. +Proof. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +by move=> X2; rewrite covariance_fin_num ?lfun2M2_1// lfun_inclusion12. +Qed. Lemma variance_ge0 (X : {RV P >-> R}) : (0 <= 'V_P[X])%E. Proof. @@ -532,106 +526,98 @@ by apply/funext => x; rewrite /GRing.exp/GRing.mul/= subrr mulr0. Qed. Lemma varianceZ a (X : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[(a \o* X)%R] = (a ^+ 2)%:E * 'V_P[X]. Proof. -move=> X1 X2; rewrite /variance covarianceZl//=. -- by rewrite covarianceZr// muleA. -- by rewrite compre_scale// integrableZl. -- rewrite [X in EFin \o X](_ : _ = (a \o* X ^+ 2)%R); last first. - by apply/funeqP => x; rewrite mulrA. - by rewrite compre_scale// integrableZl. +move=> X2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have X1 := lfun_inclusion12 Poo X2. +have le12 : (1 <= 2%:E :> \bar R)%E by rewrite lee_fin (ler_nat _ 1 2). +by rewrite /variance covarianceZl ?covarianceZr ?lfun2M2_1 ?lfunp_scale// muleA EFinM. Qed. Lemma varianceN (X : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[(\- X)%R] = 'V_P[X]. -Proof. by move=> X1 X2; rewrite /variance covarianceNN. Qed. +Proof. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +move=> X2; rewrite /variance covarianceNN ?lfun2M2_1// lfun_inclusion12//. +Qed. Lemma varianceD (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> 'V_P[X \+ Y]%R = 'V_P[X] + 'V_P[Y] + 2%:E * covariance P X Y. Proof. -move=> X1 X2 Y1 Y2 XY1. +move=> X2 Y2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have X1 := lfun_inclusion12 Poo X2. +have Y1 := lfun_inclusion12 Poo Y2. +have XY1 := lfun2M2_1 X2 Y2. rewrite -['V_P[_]]/(covariance P (X \+ Y)%R (X \+ Y)%R). -have XY : P.-integrable [set: T] (EFin \o (X \+ Y)%R). - by rewrite compreDr// integrableD. -rewrite covarianceDl//=; last 3 first. -- rewrite -expr2 sqrrD compreDr ?integrableD// compreDr// integrableD//. - rewrite -mulr_natr -[(_ * 2)%R]/(2 \o* (X * Y))%R compre_scale//. - exact: integrableZl. -- by rewrite mulrDr compreDr ?integrableD. -- by rewrite mulrDr mulrC compreDr ?integrableD. -rewrite covarianceDr// covarianceDr; [|by []..|by rewrite mulrC |exact: Y2]. +rewrite covarianceDl ?lfunD//= ?(ler_nat _ 1 2)// covarianceDr// covarianceDr//. rewrite (covarianceC P Y X) [LHS]addeA [LHS](ACl (1*4*(2*3)))/=. by rewrite -[2%R]/(1 + 1)%R EFinD muleDl ?mul1e// covariance_fin_num. Qed. Lemma varianceB (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> 'V_P[(X \- Y)%R] = 'V_P[X] + 'V_P[Y] - 2%:E * covariance P X Y. Proof. -move=> X1 X2 Y1 Y2 XY1. -rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R. -rewrite varianceD/= ?varianceN ?covarianceNr ?muleN//. -- by rewrite compreN ?integrableN. -- by rewrite mulrNN. -- by rewrite mulrN compreN ?integrableN. +move=> X2 Y2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have X1 := lfun_inclusion12 Poo X2. +have Y1 := lfun_inclusion12 Poo Y2. +have XY1 := lfun2M2_1 X2 Y2. +by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R varianceD/= ?varianceN ?covarianceNr ?muleN ?lfunN. Qed. Lemma varianceD_cst_l c (X : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[(cst c \+ X)%R] = 'V_P[X]. Proof. -move=> X1 X2. -rewrite varianceD//=; last 3 first. -- exact: finite_measure_integrable_cst. -- by rewrite compre_scale// integrableZl// finite_measure_integrable_cst. -- by rewrite mulrC compre_scale ?integrableZl. -by rewrite variance_cst add0e covariance_cst_l mule0 adde0. +move=> X2. +by rewrite varianceD ?lfun_cst// variance_cst add0e covariance_cst_l mule0 adde0. Qed. Lemma varianceD_cst_r (X : {RV P >-> R}) c : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[(X \+ cst c)%R] = 'V_P[X]. Proof. -move=> X1 X2. +move=> X2. have -> : (X \+ cst c = cst c \+ X)%R by apply/funeqP => x /=; rewrite addrC. exact: varianceD_cst_l. Qed. Lemma varianceB_cst_l c (X : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[(cst c \- X)%R] = 'V_P[X]. Proof. -move=> X1 X2. -rewrite -[(cst c \- X)%R]/(cst c \+ (\- X))%R varianceD_cst_l/=; last 2 first. -- by rewrite compreN ?integrableN. -- by rewrite mulrNN; apply: X2. -by rewrite varianceN. +move=> X2. +by rewrite -[(cst c \- X)%R]/(cst c \+ (\- X))%R varianceD_cst_l/= ?lfunN// varianceN. Qed. Lemma varianceB_cst_r (X : {RV P >-> R}) c : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (X : T -> R) \in lfun P 2%:E -> 'V_P[(X \- cst c)%R] = 'V_P[X]. Proof. -by move=> X1 X2; rewrite -[(X \- cst c)%R]/(X \+ (cst (- c)))%R varianceD_cst_r. +by move=> X2; rewrite -[(X \- cst c)%R]/(X \+ (cst (- c)))%R varianceD_cst_r. Qed. Lemma covariance_le (X Y : {RV P >-> R}) : - P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> - P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> - P.-integrable setT (EFin \o (X * Y)%R) -> + (X : T -> R) \in lfun P 2%:E -> + (Y : T -> R) \in lfun P 2%:E -> covariance P X Y <= sqrte 'V_P[X] * sqrte 'V_P[Y]. Proof. -move=> X1 X2 Y1 Y2 XY1. +move=> X2 Y2. +have Poo : P setT < +oo by rewrite fin_num_fun_lty. +have X1 := lfun_inclusion12 Poo X2. +have Y1 := lfun_inclusion12 Poo Y2. +have XY1 := lfun2M2_1 X2 Y2. rewrite -sqrteM ?variance_ge0//. rewrite lee_sqrE ?sqrte_ge0// sqr_sqrte ?mule_ge0 ?variance_ge0//. -rewrite -(fineK (variance_fin_num X1 X2)) -(fineK (variance_fin_num Y1 Y2)). +rewrite -(fineK (variance_fin_num X2)) -(fineK (variance_fin_num Y2)). rewrite -(fineK (covariance_fin_num X1 Y1 XY1)). rewrite -EFin_expe -EFinM lee_fin -(@ler_pM2l _ 4) ?ltr0n// [leRHS]mulrA. rewrite [in leLHS](_ : 4 = 2 * 2)%R -natrM// [in leLHS]natrM mulrACA -expr2. @@ -649,10 +635,7 @@ rewrite -lee_fin !EFinD EFinM fineK ?variance_fin_num// muleC -varianceZ//. rewrite 2!EFinM ?fineK ?variance_fin_num// ?covariance_fin_num//. rewrite -muleA [_ * r%:E]muleC -covarianceZl//. rewrite addeAC -varianceD ?variance_ge0//=. -- by rewrite compre_scale ?integrableZl. -- rewrite [X in EFin \o X](_ : _ = r ^+2 \o* X ^+ 2)%R 1?mulrACA//. - by rewrite compre_scale ?integrableZl. -- by rewrite -mulrAC compre_scale// integrableZl. +by rewrite lfunp_scale// (ler_nat _ 1 2). Qed. End variance. @@ -726,54 +709,27 @@ Lemma cantelli (X : {RV P >-> R}) (lambda : R) : P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] <= (fine 'V_P[X] / (fine 'V_P[X] + lambda^2))%:E. Proof. -move=>/[dup] /lfun2_integrable_sqr X2 /lfun_inclusion12 /lfun1_integrable. +move=> /[dup] X2 /lfun_inclusion12. rewrite fin_num_fun_lty// => /(_ isT) X1 lambda_gt0. have finEK : (fine 'E_P[X])%:E = 'E_P[X]. - by rewrite fineK ?unlock ?integral_fune_fin_num. -have finVK : (fine 'V_P[X])%:E = 'V_P[X] by rewrite fineK ?variance_fin_num. + by rewrite fineK ?expectation_fin_num. +have finVK : (fine 'V_P[X])%:E = 'V_P[X]. + by rewrite fineK ?variance_fin_num. pose Y := (X \- cst (fine 'E_P[X]))%R. -have Y1 : P.-integrable [set: T] (EFin \o Y). - rewrite compreBr => [|//]; apply: integrableB X1 _ => [//|]. - exact: finite_measure_integrable_cst. -have Y2 : P.-integrable [set: T] (EFin \o (Y ^+ 2)%R). - rewrite sqrrD/= compreDr => [|//]. - apply: integrableD => [//||]; last first. - rewrite -[(_ ^+ 2)%R]/(cst ((- fine 'E_P[X]) ^+ 2)%R). - exact: finite_measure_integrable_cst. - rewrite compreDr => [|//]; apply: integrableD X2 _ => [//|]. - rewrite [X in EFin \o X](_ : _ = (- fine 'E_P[X] * 2) \o* X)%R; last first. - by apply/funeqP => x /=; rewrite -mulr_natl mulrC mulrA. - by rewrite compre_scale => [|//]; apply: integrableZl X1. +have Y2 : (Y : T -> R) \in lfun P 2%:E by rewrite lfunB ?lfun_cst ?(ler_nat _ 1 2). have EY : 'E_P[Y] = 0. - rewrite expectationB/= ?finite_measure_integrable_cst//. - rewrite expectation_cst finEK subee//. - by rewrite unlock; apply: integral_fune_fin_num X1. + by rewrite expectationB ?lfun_cst// expectation_cst finEK subee// ?expectation_fin_num. have VY : 'V_P[Y] = 'V_P[X] by rewrite varianceB_cst_r. have le (u : R) : (0 <= u)%R -> P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] <= ((fine 'V_P[X] + u^2) / (lambda + u)^2)%:E. move=> uge0; rewrite EFinM. - have YU1 : P.-integrable [set: T] (EFin \o (Y \+ cst u)%R). - rewrite compreDr => [|//]; apply: integrableD Y1 _ => [//|]. - exact: finite_measure_integrable_cst. - have YU2 : P.-integrable [set: T] (EFin \o ((Y \+ cst u) ^+ 2)%R). - rewrite sqrrD/= compreDr => [|//]. - apply: integrableD => [//||]; last first. - rewrite -[(_ ^+ 2)%R]/(cst (u ^+ 2))%R. - exact: finite_measure_integrable_cst. - rewrite compreDr => [|//]; apply: integrableD Y2 _ => [//|]. - rewrite [X in EFin \o X](_ : _ = (2 * u) \o* Y)%R; last first. - by apply/funeqP => x /=; rewrite -mulr_natl mulrCA. - by rewrite compre_scale => [|//]; apply: integrableZl Y1. have -> : (fine 'V_P[X] + u^2)%:E = 'E_P[(Y \+ cst u)^+2]%R. rewrite -VY -[RHS](@subeK _ _ (('E_P[(Y \+ cst u)%R])^+2)); last first. - by rewrite fin_numX ?unlock ?integral_fune_fin_num. - rewrite -varianceE/= -/Y -?expe2//. - rewrite expectationD/= ?EY ?add0e ?expectation_cst -?EFinM; last 2 first. - - rewrite compreBr => [|//]; apply: integrableB X1 _ => [//|]. - exact: finite_measure_integrable_cst. - - exact: finite_measure_integrable_cst. - by rewrite (varianceD_cst_r _ Y1 Y2) EFinD fineK ?(variance_fin_num Y1 Y2). + by rewrite fin_numX ?expectation_fin_num ?lfunD ?lfunB ?lfun_cst. + rewrite -varianceE/= -/Y -?expe2 ?lfunD ?lfun_cst ?(ler_nat _ 1 2)//=. + rewrite expectationD/= ?EY ?add0e ?expectation_cst -?EFinM ?lfunB ?lfun_cst//. + by rewrite (varianceD_cst_r _ Y2) EFinD fineK ?variance_fin_num. have le : [set x | lambda%:E <= (X x)%:E - 'E_P[X]] `<=` [set x | ((lambda + u)^2)%:E <= ((Y x + u)^+2)%:E]. move=> x /= le; rewrite lee_fin; apply: lerXn2r. @@ -783,7 +739,7 @@ have le (u : R) : (0 <= u)%R -> - by rewrite lerD2r -lee_fin EFinB finEK. apply: (le_trans (le_measure _ _ _ le)). - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. - by apply: emeasurable_funB => //; exact: measurable_int X1. + by apply: emeasurable_funB => //; apply: measurable_int; exact: (lfun1_integrable X1). - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. rewrite measurable_EFinP [X in measurable_fun _ X](_ : _ = (fun x => x ^+ 2) \o (fun x => Y x + u))%R//. From c7bfd9f52dbe6ed2fb3a4095aa51e2ee4298402c Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Wed, 19 Mar 2025 10:23:04 +0900 Subject: [PATCH 27/73] slight generalization of lfun_sum, not requiring a finite measure --- theories/hoelder.v | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 7dafed0d31..28bb437a3a 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -1014,6 +1014,18 @@ Proof. by move=> r1 lpf lpg; rewrite (_ : f \- g = f \+ (\- g))// lfunD//= lfunN. Qed. +Lemma lfun_sum (F : seq {mfun T >-> R}) r : + 1 <= r -> (forall Fi, Fi \in F -> (Fi : T -> R) \in lfun mu r%:E) -> + (\sum_(Fi <- F) Fi : T -> R) \in lfun mu r%:E. +Proof. +elim: F => //=[r1 _|F0 F ih r1 lpF]. + rewrite big_nil inE/=; apply/andP; split; rewrite inE /finite_norm/=. + exact: measurable_cst. + by rewrite [X in Lnorm _ _ X](_ : _ = cst 0)%E ?Lnorm0 ?lee_fin. +rewrite big_cons lfunD//; first by rewrite lpF ?mem_head. +by rewrite ih// => Fi FiF; rewrite lpF ?in_cons ?FiF ?orbT. +Qed. + End Lspace. Section Lspace. @@ -1029,16 +1041,6 @@ under eq_integral => x _ do rewrite ger0_norm ?powR_ge0//. by []. Qed. -Lemma lfun_sum (F : seq {mfun T >-> R}) r : - (forall Fi, Fi \in F -> (Fi : T -> R) \in lfun mu r%:E) -> - (1 <= r)%R -> - (\sum_(Fi <- F) Fi : T -> R) \in lfun mu r%:E. -Proof. -elim: F => //=[_|F0 F ih lpF r1]; first by rewrite big_nil lfun_cst. -rewrite big_cons lfunD//; first by rewrite lpF ?mem_head. -by rewrite ih// => Fi FiF; rewrite lpF ?in_cons ?FiF ?orbT. -Qed. - End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. From 696079000ab893edb5c0be612081d343bacefc0f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 20 Mar 2025 13:08:06 +0900 Subject: [PATCH 28/73] introduce the oppr_closed machinery --- CHANGELOG_UNRELEASED.md | 3 +- theories/hoelder.v | 103 ++++++++++++--------------------- theories/probability.v | 125 +++++++++++++++++++++------------------- 3 files changed, 106 insertions(+), 125 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 19659c86e6..786987da10 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -120,7 +120,7 @@ + coercion `LfunType_of_LType` + definition `Lspace` with notation `mu.-Lspace p` + lemma `lfun_integrable`, `lfun1_integrable`, `lfun2_integrable_sqr`, `lfun2M2_1` - + lemma `lfunp_scale`, `lfunN`, `lfunD`, `lfunB`, `lfun_cst`, `lfun_sum` + + lemma `lfunp_scale`, `lfun0`, `lfun_cst`, `lfun_sum` + definitions `finlfun`, `lfun`, `lfun_key` + canonical `lfun_keyed` + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` @@ -133,6 +133,7 @@ + lemma `Lspace_inclusion` `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` + lemma `lfun_inclusion`, `lfun_inclusion12` + + lemma `lfun_oppr_closed` - in `lebesgue_integral.v`: + lemma `mfunMn` diff --git a/theories/hoelder.v b/theories/hoelder.v index 28bb437a3a..559038ba85 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -200,7 +200,7 @@ End lnorm. Section conjugate. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). -Hypothesis (p1 : (1 <= p)%E). +Hypothesis p1 : (1 <= p)%E. Local Open Scope classical_set_scope. Local Open Scope ereal_scope. @@ -819,6 +819,15 @@ case: p p1 f => //[r r1 f|? f]. by rewrite normrZ EFinM. Qed. +Lemma lfun_oppr_closed : oppr_closed lfun. +Proof. +move=> f /andP[mf /[!inE] lf]. +by rewrite rpredN/= mf/= inE/= /finite_norm oppr_Lnorm. +Qed. + +HB.instance Definition _ := GRing.isOppClosed.Build _ lfun + lfun_oppr_closed. + Lemma lfun_submod_closed : submod_closed lfun. Proof. split. @@ -836,6 +845,7 @@ Qed. HB.instance Definition _ := GRing.isSubmodClosed.Build _ _ lfun lfun_submod_closed. + HB.instance Definition _ := [SubChoice_isSubLmodule of LfunType mu p1 by <:]. End lfun. @@ -886,7 +896,6 @@ Qed. End Lspace_norm. - Section Lspace. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. @@ -896,27 +905,21 @@ Arguments Lspace : clear implicits. Definition LType1 := LType mu (@lexx _ _ 1%E). -Let le12 : (1 <= 2%:E :> \bar R)%E. -Proof. by rewrite lee_fin (ler_nat _ 1 2). Qed. - -Definition LType2 := LType mu le12. +Definition LType2 := LType mu (lee1n 2). Lemma lfun_integrable (f : {mfun T >-> R}) r : - 1 <= r -> (f : T -> R) \in lfun mu r%:E -> mu.-integrable setT (fun x => (`|f x| `^ r)%:E). + 1 <= r -> (f : T -> R) \in lfun mu r%:E -> + mu.-integrable setT (fun x => (`|f x| `^ r)%:E). Proof. rewrite inE => r0 /andP[_]; rewrite inE/= => lpf. -have ? : measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). +apply/integrableP; split => //. apply: measurableT_comp => //. apply: (measurableT_comp (measurable_powR _)) => //. exact: measurableT_comp. -apply/integrableP; split => //. -apply/abse_integralP => //. -move: lpf. -rewrite /finite_norm => /(poweR_lty r); rewrite powR_Lnorm// ?gt_eqF// ?(lt_le_trans ltr01)//. -move=> ?. -apply/abse_integralP => //. -under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. -by []. +move: lpf => /(poweR_lty r). +rewrite powR_Lnorm// ?gt_eqF// ?(lt_le_trans ltr01)//. +apply: le_lt_trans. +by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. Qed. Lemma lfun1_integrable (f : {mfun T >-> R}) : @@ -924,12 +927,10 @@ Lemma lfun1_integrable (f : {mfun T >-> R}) : Proof. move=> /lfun_integrable => /(_ (lexx _)). under eq_fun => x do rewrite powRr1//. -move/integrableP => [? fley]. -apply/integrableP; split. - exact: measurableT_comp. +move/integrableP => [mf fley]. +apply/integrableP; split; first exact: measurableT_comp. rewrite (le_lt_trans _ fley)//=. -under [leRHS]eq_integral => x _ do rewrite normr_id. -exact: lexx. +by under [leRHS]eq_integral => x _ do rewrite normr_id. Qed. Lemma lfun2_integrable_sqr (f : {mfun T >-> R}) : @@ -985,50 +986,26 @@ under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. by []. Qed. -Lemma lfunN (f : {mfun T >-> R}) r : - (f : T -> R) \in lfun mu r%:E -> (\- f : T -> R) \in lfun mu r%:E. +Lemma lfun0 r : 1 <= r -> (cst 0 : T -> R) \in lfun mu r%:E. Proof. -move=> lpf. -rewrite inE; apply/andP; split; rewrite inE//= /finite_norm. -rewrite unlock /Lnorm. -under eq_integral => x _/= do rewrite normrN. -move: lpf. -rewrite inE; move/andP => [_]. rewrite inE/=/finite_norm unlock/Lnorm/=. -exact. -Qed. - -Lemma lfunD (f g : {mfun T >-> R}) r : - 1 <= r -> (f : T -> R) \in lfun mu r%:E -> (g : T -> R) \in lfun mu r%:E -> - (f \+ g : T -> R) \in lfun mu r%:E. -Proof. -rewrite !inE => r1 /andP[_] +/andP[_]; rewrite !inE/= /finite_norm => lpf lpg. -apply/andP; split; rewrite inE//= /finite_norm. -apply: (le_lt_trans (minkowski mu _ _ r1)) => //. -by rewrite lte_add_pinfty. -Qed. - -Lemma lfunB (f g : {mfun T >-> R}) r : - 1 <= r -> (f : T -> R) \in lfun mu r%:E -> (g : T -> R) \in lfun mu r%:E -> - (f \- g : T -> R) \in lfun mu r%:E. -Proof. -by move=> r1 lpf lpg; rewrite (_ : f \- g = f \+ (\- g))// lfunD//= lfunN. +move=> r1; apply/andP; split. + by rewrite inE; exact: measurable_cst. +by rewrite inE/= /finite_norm// Lnorm0. Qed. Lemma lfun_sum (F : seq {mfun T >-> R}) r : 1 <= r -> (forall Fi, Fi \in F -> (Fi : T -> R) \in lfun mu r%:E) -> (\sum_(Fi <- F) Fi : T -> R) \in lfun mu r%:E. Proof. -elim: F => //=[r1 _|F0 F ih r1 lpF]. - rewrite big_nil inE/=; apply/andP; split; rewrite inE /finite_norm/=. - exact: measurable_cst. - by rewrite [X in Lnorm _ _ X](_ : _ = cst 0)%E ?Lnorm0 ?lee_fin. -rewrite big_cons lfunD//; first by rewrite lpF ?mem_head. +elim: F => //=[r1 _|F0 F ih r1 lpF]; first by rewrite big_nil lfun0. +rewrite big_cons rpredD//; first by rewrite lpF ?mem_head. by rewrite ih// => Fi FiF; rewrite lpF ?in_cons ?FiF ?orbT. Qed. End Lspace. +Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. -Section Lspace. +Section Lspace_finite_measure. Context d (T : measurableType d) (R : realType). Variable mu : {finite_measure set T -> \bar R}. @@ -1041,8 +1018,7 @@ under eq_integral => x _ do rewrite ger0_norm ?powR_ge0//. by []. Qed. -End Lspace. -Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. +End Lspace_finite_measure. Section lfun_inclusion. Context d (T : measurableType d) (R : realType). @@ -1051,7 +1027,7 @@ Local Open Scope ereal_scope. Lemma lfun_inclusion (p q : \bar R) : forall (p1 : 1 <= p) (q1 : 1 <= q), - mu [set: T] < +oo -> p < q -> + mu [set: T] \is a fin_num -> p < q -> forall f : {mfun T >-> R}, (f : T -> R) \in lfun mu q -> (f : T -> R) \in lfun mu p. Proof. @@ -1076,7 +1052,7 @@ case=> //[p|]; case=> //[q|] p1 q1; last first. apply/andP; split; rewrite inE//= /finite_norm unlock /Lnorm. rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. - by rewrite integral_cst// lte_mul_pinfty// lee_fin powR_ge0. + by rewrite integral_cst// ltey_eq fin_numM. apply: ae_ge0_le_integral => //. - by move=> x _; rewrite lee_fin powR_ge0. apply/measurable_EFinP. @@ -1120,18 +1096,13 @@ move=> h1 /lty_poweRy h2. apply: poweR_lty. apply: (le_lt_trans h1). rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. - by rewrite (lt_le_trans _ (poweR_ge0 _ _)) ?ltNyr// ?poweR_lty. + by rewrite (lt_le_trans _ (poweR_ge0 _ _))//= ltey_eq fin_num_poweR. rewrite poweR_lty// (lty_poweRy qinv0)//. by have:= ffin; rewrite /finite_norm unlock /Lnorm. Qed. -Lemma lfun_inclusion12 (f : {mfun T >-> R}) : - mu [set: T] < +oo -> (f : T -> R) \in lfun mu (2%:E) -> (f : T -> R) \in lfun mu 1. -Proof. -move => muoo f2. -have le12 : (1 <= 2%:E :> \bar R) by rewrite lee_fin (ler_nat _ 1 2). -have lte12 : (1 < 2%:E :> \bar R) by rewrite lte_fin (ltr_nat _ 1 2). -exact: (@lfun_inclusion 1 (2%:E) (lexx _) le12 _ lte12). -Qed. +Lemma lfun_inclusion12 (f : {mfun T >-> R}) : mu [set: T] \is a fin_num -> + (f : T -> R) \in lfun mu 2%:E -> (f : T -> R) \in lfun mu 1. +Proof. by move=> ? ?; rewrite (@lfun_inclusion 1 (2%:E))// ?lee1n// lte1n. Qed. End lfun_inclusion. diff --git a/theories/probability.v b/theories/probability.v index 287299ebb7..dec2edfd1b 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -16,6 +16,10 @@ From mathcomp Require Import ftc gauss_integral hoelder. (* This file provides basic notions of probability theory. See measure.v for *) (* the type probability T R (a measure that sums to 1). *) (* *) +(* About integrability: as a rule of thumb, in this file, we favor the use *) +(* of `lfun P n` hypotheses instead of the `integrable` predicate from *) +(* `lebesgue_integral.v`. *) +(* *) (* ``` *) (* {RV P >-> T'} == random variable: a measurable function to the *) (* measurableType T' from the measured space *) @@ -345,11 +349,13 @@ Proof. move=> l1X l1Y l1XY. rewrite unlock [X in 'E_P[X]](_ : _ = (X \* Y \- fine 'E_P[X] \o* Y \- fine 'E_P[Y] \o* X \+ fine ('E_P[X] * 'E_P[Y]) \o* cst 1)%R); last first. - apply/funeqP => x /=; rewrite mulrDr !mulrDl/= mul1r fineM ?expectation_fin_num// mulrNN addrA. + apply/funeqP => x /=; rewrite mulrDr !mulrDl/= mul1r. + rewrite fineM ?expectation_fin_num// mulrNN addrA. by rewrite mulrN mulNr [Z in (X x * Y x - Z)%R]mulrC. -rewrite expectationD/= ?lfunB ?lfunp_scale ?lfun_cst//. -rewrite 2?expectationB//= ?lfunB ?lfunp_scale// 3?expectationZl//= ?lfun_cst//. -rewrite expectation_cst mule1 fineM ?expectation_fin_num// EFinM !fineK ?expectation_fin_num//. +rewrite expectationD/= ?rpredB ?lfunp_scale ?lfun_cst//. +rewrite 2?expectationB//= ?rpredB ?lfunp_scale// 3?expectationZl//= ?lfun_cst//. +rewrite expectation_cst mule1 fineM ?expectation_fin_num// EFinM. +rewrite !fineK ?expectation_fin_num//. by rewrite muleC subeK ?fin_numM ?expectation_fin_num. Qed. @@ -364,7 +370,7 @@ Lemma covariance_fin_num (X Y : {RV P >-> R}) : ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P X Y \is a fin_num. Proof. -by move=> X1 Y1 XY1; rewrite covarianceE// fin_numB fin_numM expectation_fin_num. +by move=> ? ? ?; rewrite covarianceE// fin_numB fin_numM expectation_fin_num. Qed. Lemma covariance_cst_l c (X : {RV P >-> R}) : covariance P (cst c) X = 0. @@ -427,8 +433,8 @@ Lemma covarianceNN (X Y : {RV P >-> R}) : ((X * Y)%R : T -> R) \in lfun P 1 -> covariance P (\- X)%R (\- Y)%R = covariance P X Y. Proof. -by move=> X1 Y1 XY1; rewrite covarianceNl//= ?covarianceNr ?oppeK ?mulrN//= ?lfunN. -Qed. +by move=> ? ? ?; rewrite covarianceNl//= ?covarianceNr ?oppeK ?mulrN//= ?rpredN. +Qed. Lemma covarianceDl (X Y Z : {RV P >-> R}) : (X : T -> R) \in lfun P 2%:E -> @@ -437,15 +443,14 @@ Lemma covarianceDl (X Y Z : {RV P >-> R}) : covariance P (X \+ Y)%R Z = covariance P X Z + covariance P Y Z. Proof. move=> X2 Y2 Z2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have X1 := lfun_inclusion12 Poo X2. -have Y1 := lfun_inclusion12 Poo Y2. -have Z1 := lfun_inclusion12 Poo Z2. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have X1 := lfun_inclusion12 Pfin X2. +have Y1 := lfun_inclusion12 Pfin Y2. +have Z1 := lfun_inclusion12 Pfin Z2. have XY1 := lfun2M2_1 X2 Y2. have YZ1 := lfun2M2_1 Y2 Z2. have XZ1 := lfun2M2_1 X2 Z2. -rewrite [LHS]covarianceE//= ?mulrDl ?compreDr ?lfunD//=. -rewrite 2?expectationD//=. +rewrite [LHS]covarianceE//= ?mulrDl ?compreDr ?rpredD//= 2?expectationD//=. rewrite muleDl ?fin_num_adde_defr ?expectation_fin_num//. rewrite oppeD ?fin_num_adde_defr ?fin_numM ?expectation_fin_num//. by rewrite addeACA 2?covarianceE. @@ -467,11 +472,11 @@ Lemma covarianceBl (X Y Z : {RV P >-> R}) : covariance P (X \- Y)%R Z = covariance P X Z - covariance P Y Z. Proof. move=> X2 Y2 Z2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have Y1 := lfun_inclusion12 Poo Y2. -have Z1 := lfun_inclusion12 Poo Z2. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have Y1 := lfun_inclusion12 Pfin Y2. +have Z1 := lfun_inclusion12 Pfin Z2. have YZ1 := lfun2M2_1 Y2 Z2. -by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl ?lfunN. +by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl ?rpredN. Qed. Lemma covarianceBr (X Y Z : {RV P >-> R}) : @@ -481,9 +486,9 @@ Lemma covarianceBr (X Y Z : {RV P >-> R}) : covariance P X (Y \- Z)%R = covariance P X Y - covariance P X Z. Proof. move=> X2 Y2 Z2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have Y1 := lfun_inclusion12 Poo Y2. -have Z1 := lfun_inclusion12 Poo Z2. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have Y1 := lfun_inclusion12 Pfin Y2. +have Z1 := lfun_inclusion12 Pfin Z2. have YZ1 := lfun2M2_1 Y2 Z2. by rewrite !(covarianceC X) covarianceBl 1?(mulrC _ X). Qed. @@ -500,22 +505,22 @@ Local Notation "''V_' P [ X ]" := (variance X). Lemma varianceE (X : {RV P >-> R}) : (X : T -> R) \in lfun P 2%:E -> 'V_P[X] = 'E_P[X ^+ 2] - ('E_P[X]) ^+ 2. -Proof. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -by move=> X2; rewrite /variance covarianceE ?lfun2M2_1// lfun_inclusion12. +Proof. +move=> X2. +by rewrite /variance covarianceE ?lfun2M2_1// lfun_inclusion12 ?fin_num_measure. Qed. Lemma variance_fin_num (X : {RV P >-> R}) : (X : T -> R) \in lfun P 2%:E -> 'V_P[X] \is a fin_num. Proof. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -by move=> X2; rewrite covariance_fin_num ?lfun2M2_1// lfun_inclusion12. +move=> X2. +by rewrite covariance_fin_num ?lfun2M2_1// lfun_inclusion12 ?fin_num_measure. Qed. Lemma variance_ge0 (X : {RV P >-> R}) : (0 <= 'V_P[X])%E. Proof. -by rewrite /variance unlock; apply: expectation_ge0 => x; apply: sqr_ge0. +by rewrite /variance unlock; apply: expectation_ge0 => x; exact: sqr_ge0. Qed. Lemma variance_cst r : 'V_P[cst r] = 0%E. @@ -530,18 +535,18 @@ Lemma varianceZ a (X : {RV P >-> R}) : 'V_P[(a \o* X)%R] = (a ^+ 2)%:E * 'V_P[X]. Proof. move=> X2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have X1 := lfun_inclusion12 Poo X2. -have le12 : (1 <= 2%:E :> \bar R)%E by rewrite lee_fin (ler_nat _ 1 2). -by rewrite /variance covarianceZl ?covarianceZr ?lfun2M2_1 ?lfunp_scale// muleA EFinM. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have X1 := lfun_inclusion12 Pfin X2. +rewrite /variance covarianceZl ?covarianceZr ?lfun2M2_1 ?lfunp_scale ?ler1n//. +by rewrite muleA EFinM. Qed. Lemma varianceN (X : {RV P >-> R}) : (X : T -> R) \in lfun P 2%:E -> 'V_P[(\- X)%R] = 'V_P[X]. Proof. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -move=> X2; rewrite /variance covarianceNN ?lfun2M2_1// lfun_inclusion12//. +move=> X2. +by rewrite /variance covarianceNN ?lfun2M2_1 ?lfun_inclusion12 ?fin_num_measure. Qed. Lemma varianceD (X Y : {RV P >-> R}) : @@ -550,12 +555,12 @@ Lemma varianceD (X Y : {RV P >-> R}) : 'V_P[X \+ Y]%R = 'V_P[X] + 'V_P[Y] + 2%:E * covariance P X Y. Proof. move=> X2 Y2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have X1 := lfun_inclusion12 Poo X2. -have Y1 := lfun_inclusion12 Poo Y2. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have X1 := lfun_inclusion12 Pfin X2. +have Y1 := lfun_inclusion12 Pfin Y2. have XY1 := lfun2M2_1 X2 Y2. rewrite -['V_P[_]]/(covariance P (X \+ Y)%R (X \+ Y)%R). -rewrite covarianceDl ?lfunD//= ?(ler_nat _ 1 2)// covarianceDr// covarianceDr//. +rewrite covarianceDl ?rpredD ?lee1n//= covarianceDr// covarianceDr//. rewrite (covarianceC P Y X) [LHS]addeA [LHS](ACl (1*4*(2*3)))/=. by rewrite -[2%R]/(1 + 1)%R EFinD muleDl ?mul1e// covariance_fin_num. Qed. @@ -566,11 +571,12 @@ Lemma varianceB (X Y : {RV P >-> R}) : 'V_P[(X \- Y)%R] = 'V_P[X] + 'V_P[Y] - 2%:E * covariance P X Y. Proof. move=> X2 Y2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have X1 := lfun_inclusion12 Poo X2. -have Y1 := lfun_inclusion12 Poo Y2. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have X1 := lfun_inclusion12 Pfin X2. +have Y1 := lfun_inclusion12 Pfin Y2. have XY1 := lfun2M2_1 X2 Y2. -by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R varianceD/= ?varianceN ?covarianceNr ?muleN ?lfunN. +rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R. +by rewrite varianceD/= ?varianceN ?covarianceNr ?muleN ?rpredN. Qed. Lemma varianceD_cst_l c (X : {RV P >-> R}) : @@ -594,8 +600,8 @@ Lemma varianceB_cst_l c (X : {RV P >-> R}) : (X : T -> R) \in lfun P 2%:E -> 'V_P[(cst c \- X)%R] = 'V_P[X]. Proof. -move=> X2. -by rewrite -[(cst c \- X)%R]/(cst c \+ (\- X))%R varianceD_cst_l/= ?lfunN// varianceN. +move=> X2; rewrite -[(cst c \- X)%R]/(cst c \+ (\- X))%R. +by rewrite varianceD_cst_l/= ?rpredN// varianceN. Qed. Lemma varianceB_cst_r (X : {RV P >-> R}) c : @@ -611,9 +617,9 @@ Lemma covariance_le (X Y : {RV P >-> R}) : covariance P X Y <= sqrte 'V_P[X] * sqrte 'V_P[Y]. Proof. move=> X2 Y2. -have Poo : P setT < +oo by rewrite fin_num_fun_lty. -have X1 := lfun_inclusion12 Poo X2. -have Y1 := lfun_inclusion12 Poo Y2. +have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. +have X1 := lfun_inclusion12 Pfin X2. +have Y1 := lfun_inclusion12 Pfin Y2. have XY1 := lfun2M2_1 X2 Y2. rewrite -sqrteM ?variance_ge0//. rewrite lee_sqrE ?sqrte_ge0// sqr_sqrte ?mule_ge0 ?variance_ge0//. @@ -635,7 +641,7 @@ rewrite -lee_fin !EFinD EFinM fineK ?variance_fin_num// muleC -varianceZ//. rewrite 2!EFinM ?fineK ?variance_fin_num// ?covariance_fin_num//. rewrite -muleA [_ * r%:E]muleC -covarianceZl//. rewrite addeAC -varianceD ?variance_ge0//=. -by rewrite lfunp_scale// (ler_nat _ 1 2). +by rewrite lfunp_scale// ler1n. Qed. End variance. @@ -709,16 +715,16 @@ Lemma cantelli (X : {RV P >-> R}) (lambda : R) : P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] <= (fine 'V_P[X] / (fine 'V_P[X] + lambda^2))%:E. Proof. -move=> /[dup] X2 /lfun_inclusion12. -rewrite fin_num_fun_lty// => /(_ isT) X1 lambda_gt0. -have finEK : (fine 'E_P[X])%:E = 'E_P[X]. - by rewrite fineK ?expectation_fin_num. -have finVK : (fine 'V_P[X])%:E = 'V_P[X]. - by rewrite fineK ?variance_fin_num. +move=> /[dup] X2. +move=> /(lfun_inclusion12 (fin_num_measure P _ measurableT)) X1 lambda_gt0. +have finEK : (fine 'E_P[X])%:E = 'E_P[X] by rewrite fineK ?expectation_fin_num. +have finVK : (fine 'V_P[X])%:E = 'V_P[X] by rewrite fineK ?variance_fin_num. pose Y := (X \- cst (fine 'E_P[X]))%R. -have Y2 : (Y : T -> R) \in lfun P 2%:E by rewrite lfunB ?lfun_cst ?(ler_nat _ 1 2). +have Y2 : (Y : T -> R) \in lfun P 2%:E. + by rewrite /Y rpredB ?lee1n//= => _; rewrite lfun_cst. have EY : 'E_P[Y] = 0. - by rewrite expectationB ?lfun_cst// expectation_cst finEK subee// ?expectation_fin_num. + rewrite expectationB ?lfun_cst//= expectation_cst. + by rewrite finEK subee// expectation_fin_num. have VY : 'V_P[Y] = 'V_P[X] by rewrite varianceB_cst_r. have le (u : R) : (0 <= u)%R -> P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] @@ -726,9 +732,12 @@ have le (u : R) : (0 <= u)%R -> move=> uge0; rewrite EFinM. have -> : (fine 'V_P[X] + u^2)%:E = 'E_P[(Y \+ cst u)^+2]%R. rewrite -VY -[RHS](@subeK _ _ (('E_P[(Y \+ cst u)%R])^+2)); last first. - by rewrite fin_numX ?expectation_fin_num ?lfunD ?lfunB ?lfun_cst. - rewrite -varianceE/= -/Y -?expe2 ?lfunD ?lfun_cst ?(ler_nat _ 1 2)//=. - rewrite expectationD/= ?EY ?add0e ?expectation_cst -?EFinM ?lfunB ?lfun_cst//. + rewrite fin_numX// expectation_fin_num//= rpredD ?lfun_cst//. + by rewrite rpredB// lfun_cst. + rewrite -varianceE/=; last first. + by rewrite rpredD ?lee1n//= => _; rewrite lfun_cst. + rewrite -expe2 expectationD/= ?lfun_cst//; last by rewrite rpredB ?lfun_cst. + rewrite EY// add0e expectation_cst -EFinM. by rewrite (varianceD_cst_r _ Y2) EFinD fineK ?variance_fin_num. have le : [set x | lambda%:E <= (X x)%:E - 'E_P[X]] `<=` [set x | ((lambda + u)^2)%:E <= ((Y x + u)^+2)%:E]. @@ -739,7 +748,7 @@ have le (u : R) : (0 <= u)%R -> - by rewrite lerD2r -lee_fin EFinB finEK. apply: (le_trans (le_measure _ _ _ le)). - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. - by apply: emeasurable_funB => //; apply: measurable_int; exact: (lfun1_integrable X1). + by apply: emeasurable_funB=> //; apply/measurable_int/(lfun1_integrable X1). - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. rewrite measurable_EFinP [X in measurable_fun _ X](_ : _ = (fun x => x ^+ 2) \o (fun x => Y x + u))%R//. From ad26643d9d79532ce5811c1bf3128233faba1859 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 21 Mar 2025 16:19:15 +0900 Subject: [PATCH 29/73] rm lfun_sum, lfun0 --- CHANGELOG_UNRELEASED.md | 3 +- experimental_reals/discrete.v | 2 +- reals/reals.v | 2 +- theories/hoelder.v | 89 +++++++++++++++++++---------------- theories/probability.v | 15 +++--- 5 files changed, 62 insertions(+), 49 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 786987da10..dbce6c8382 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -120,7 +120,7 @@ + coercion `LfunType_of_LType` + definition `Lspace` with notation `mu.-Lspace p` + lemma `lfun_integrable`, `lfun1_integrable`, `lfun2_integrable_sqr`, `lfun2M2_1` - + lemma `lfunp_scale`, `lfun0`, `lfun_cst`, `lfun_sum` + + lemma `lfunp_scale`, `lfun_cst`, + definitions `finlfun`, `lfun`, `lfun_key` + canonical `lfun_keyed` + lemmas `sub_lfun_mfun`, `sub_lfun_finlfun` @@ -134,6 +134,7 @@ `LnormN`, `Lnorm_natmul`, `fine_Lnorm_eq0` + lemma `lfun_inclusion`, `lfun_inclusion12` + lemma `lfun_oppr_closed` + + lemma `lfun_addr_closed` - in `lebesgue_integral.v`: + lemma `mfunMn` diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 9681124ea2..52515d7413 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -4,7 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -From Corelib Require Setoid. +From Coq Require Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. diff --git a/reals/reals.v b/reals/reals.v index 601ad4fe7c..90bb30d878 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -38,7 +38,7 @@ (* *) (******************************************************************************) -From Corelib Require Import Setoid. +From Coq Require Import Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import boolp classical_sets set_interval. diff --git a/theories/hoelder.v b/theories/hoelder.v index 559038ba85..55724fb84c 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -721,6 +721,25 @@ Coercion LfunType_of_LType (f : LType) : LfunType mu p1 := End Lequiv. +Section mfun_extra. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}). + +Lemma mfunP (f : {mfun T >-> R}) : (f : T -> R) \in mfun. +Proof. exact: valP. Qed. + +Import numFieldNormedType.Exports. + +Lemma mfun_scaler_closed : scaler_closed (@mfun _ _ T R). +Proof. by move=> a/= f; rewrite !inE; exact: measurable_funM. Qed. + +HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) + mfun_scaler_closed. + +HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. + +End mfun_extra. + Section lfun_pred. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R). @@ -736,23 +755,25 @@ Proof. by move=> x /andP[]. Qed. End lfun_pred. +Reserved Notation "[ 'lfun' 'of' f ]" + (at level 0, format "[ 'lfun' 'of' f ]"). +Notation "[ 'lfun' 'of' f ]" := [the LfunType _ _ of f] : form_scope. + Section lfun. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (p : \bar R) (p1 : (1 <= p)%E). - Notation lfun := (@lfun _ T R mu p). + Section Sub. Context (f : T -> R) (fP : f \in lfun). Definition lfun_Sub1_subproof := @isMeasurableFun.Build d _ T R f (set_mem (sub_lfun_mfun fP)). #[local] HB.instance Definition _ := lfun_Sub1_subproof. + Definition lfun_Sub2_subproof := @isLfun.Build d T R mu p p1 f (set_mem (sub_lfun_finlfun fP)). - -Import HBSimple. - #[local] HB.instance Definition _ := lfun_Sub2_subproof. -Definition lfun_Sub : LfunType mu p1 := f. +Definition lfun_Sub := [lfun of f]. End Sub. Lemma lfun_rect (K : LfunType mu p1 -> Type) : @@ -776,25 +797,38 @@ Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. HB.instance Definition _ := [Choice of LfunType mu p1 by <:]. -Import numFieldNormedType.Exports. - Lemma lfuny0 : finite_norm mu p (cst 0). Proof. by rewrite /finite_norm Lnorm0// ltry. Qed. HB.instance Definition _ := @isLfun.Build d T R mu p p1 (cst 0) lfuny0. -Lemma mfunP (f : {mfun T >-> R}) : (f : T -> R) \in mfun. -Proof. exact: valP. Qed. - Lemma lfunP (f : LfunType mu p1) : (f : T -> R) \in lfun. Proof. exact: valP. Qed. -Lemma mfun_scaler_closed : scaler_closed (@mfun _ _ T R). -Proof. move=> a/= f; rewrite !inE; exact: measurable_funM. Qed. +Lemma lfun_oppr_closed : oppr_closed lfun. +Proof. +move=> f /andP[mf /[!inE] lf]. +by rewrite rpredN/= mf/= inE/= /finite_norm oppr_Lnorm. +Qed. -HB.instance Definition _ := GRing.isScaleClosed.Build _ _ (@mfun _ _ T R) - mfun_scaler_closed. -HB.instance Definition _ := [SubZmodule_isSubLmodule of {mfun T >-> R} by <:]. +HB.instance Definition _ := GRing.isOppClosed.Build _ lfun + lfun_oppr_closed. + +(* NB: not used directly by HB.instance *) +Lemma lfun_addr_closed : addr_closed lfun. +Proof. +split. + by rewrite inE rpred0/= inE/= /finite_norm/= Lnorm0. +move=> f g /andP[mf /[!inE]/= lf] /andP[mg /[!inE]/= lg]. +rewrite rpredD//= inE/=. +rewrite /finite_norm. +rewrite (le_lt_trans (@eminkowski _ _ _ mu f g p _ _ _))//. +- by rewrite inE in mf. +- by rewrite inE in mg. +- by rewrite lte_add_pinfty. +Qed. + +Import numFieldNormedType.Exports. Lemma LnormZ (f : LfunType mu p1) a : ('N[mu]_p[EFin \o (a \*: f)] = `|a|%:E * 'N[mu]_p[EFin \o f])%E. @@ -819,15 +853,6 @@ case: p p1 f => //[r r1 f|? f]. by rewrite normrZ EFinM. Qed. -Lemma lfun_oppr_closed : oppr_closed lfun. -Proof. -move=> f /andP[mf /[!inE] lf]. -by rewrite rpredN/= mf/= inE/= /finite_norm oppr_Lnorm. -Qed. - -HB.instance Definition _ := GRing.isOppClosed.Build _ lfun - lfun_oppr_closed. - Lemma lfun_submod_closed : submod_closed lfun. Proof. split. @@ -986,22 +1011,6 @@ under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. by []. Qed. -Lemma lfun0 r : 1 <= r -> (cst 0 : T -> R) \in lfun mu r%:E. -Proof. -move=> r1; apply/andP; split. - by rewrite inE; exact: measurable_cst. -by rewrite inE/= /finite_norm// Lnorm0. -Qed. - -Lemma lfun_sum (F : seq {mfun T >-> R}) r : - 1 <= r -> (forall Fi, Fi \in F -> (Fi : T -> R) \in lfun mu r%:E) -> - (\sum_(Fi <- F) Fi : T -> R) \in lfun mu r%:E. -Proof. -elim: F => //=[r1 _|F0 F ih r1 lpF]; first by rewrite big_nil lfun0. -rewrite big_cons rpredD//; first by rewrite lpF ?mem_head. -by rewrite ih// => Fi FiF; rewrite lpF ?in_cons ?FiF ?orbT. -Qed. - End Lspace. Notation "mu .-Lspace p" := (@Lspace _ _ _ mu p) : type_scope. diff --git a/theories/probability.v b/theories/probability.v index dec2edfd1b..9034d6523c 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -311,16 +311,19 @@ Lemma expectationB (X Y : {RV P >-> R}) : 'E_P[X \- Y] = 'E_P[X] - 'E_P[Y]. Proof. by move=> ? ?; rewrite unlock integralB_EFin ?lfun1_integrable. Qed. +Let sum_sort (X : seq {RV P >-> R}) : + (\sum_(j <- X) MeasurableFun.sort j)%R = MeasurableFun.sort (\sum_(j <- X) j)%R. +Proof. by elim/big_ind2 : _ => //= x1 y1 x2 y2 -> ->. Qed. + Lemma expectation_sum (X : seq {RV P >-> R}) : (forall Xi, Xi \in X -> (Xi : T -> R) \in lfun P 1) -> 'E_P[\sum_(Xi <- X) Xi] = \sum_(Xi <- X) 'E_P[Xi]. Proof. elim: X => [|X0 X IHX] intX; first by rewrite !big_nil expectation_cst. -have intX0 : (X0 : T -> R) \in lfun P 1. - by apply: intX; rewrite in_cons eqxx. -have {}intX Xi : Xi \in X -> (Xi : T -> R) \in lfun P 1. - by move=> XiX; apply: intX; rewrite in_cons XiX orbT. -by rewrite !big_cons expectationD ?IHX ?lfun_sum. +rewrite !big_cons expectationD; last 2 first. + by rewrite intX// mem_head. + by rewrite -sum_sort big_seq rpred_sum// => Y YX/=; rewrite intX// inE YX orbT. +by rewrite IHX//= => Xi XiX; rewrite intX// inE XiX orbT. Qed. End expectation_lemmas. @@ -352,7 +355,7 @@ rewrite unlock [X in 'E_P[X]](_ : _ = (X \* Y \- fine 'E_P[X] \o* Y apply/funeqP => x /=; rewrite mulrDr !mulrDl/= mul1r. rewrite fineM ?expectation_fin_num// mulrNN addrA. by rewrite mulrN mulNr [Z in (X x * Y x - Z)%R]mulrC. -rewrite expectationD/= ?rpredB ?lfunp_scale ?lfun_cst//. +rewrite expectationD/= ?rpredB//= ?lfunp_scale ?lfun_cst//. rewrite 2?expectationB//= ?rpredB ?lfunp_scale// 3?expectationZl//= ?lfun_cst//. rewrite expectation_cst mule1 fineM ?expectation_fin_num// EFinM. rewrite !fineK ?expectation_fin_num//. From 7ca6d608c9df264b65c02c057c81ee4eaf4481b8 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Thu, 20 Mar 2025 16:53:52 +0100 Subject: [PATCH 30/73] Use HB.instance instead of direct Canonical --- theories/hoelder.v | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 55724fb84c..4dfda31bc0 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -706,10 +706,8 @@ Canonical Lequiv_canonical := Local Open Scope quotient_scope. Definition LspaceType := {eq_quot Lequiv}. -Canonical LspaceType_quotType := [the quotType _ of LspaceType]. -Canonical LspaceType_eqType := [the eqType of LspaceType]. -Canonical LspaceType_choiceType := [the choiceType of LspaceType]. -Canonical LspaceType_eqQuotType := [the eqQuotType Lequiv of LspaceType]. +HB.instance Definition _ := Choice.on LspaceType. +HB.instance Definition _ := EqQuotient.on LspaceType. Lemma LequivP (f g : LfunType mu p1) : reflect (f = g %[ae mu]) (f == g %[mod LspaceType]). From d367362ce2514f329d016362eb54cb077569ac52 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 21 Mar 2025 17:48:14 +0900 Subject: [PATCH 31/73] rm all casts but cantelli --- theories/hoelder.v | 166 ++++++++++++++++++++--------------------- theories/probability.v | 158 +++++++++++++++------------------------ 2 files changed, 144 insertions(+), 180 deletions(-) diff --git a/theories/hoelder.v b/theories/hoelder.v index 4dfda31bc0..ecd7948eba 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -930,11 +930,11 @@ Definition LType1 := LType mu (@lexx _ _ 1%E). Definition LType2 := LType mu (lee1n 2). -Lemma lfun_integrable (f : {mfun T >-> R}) r : - 1 <= r -> (f : T -> R) \in lfun mu r%:E -> +Lemma lfun_integrable (f : T -> R) r : + 1 <= r -> f \in lfun mu r%:E -> mu.-integrable setT (fun x => (`|f x| `^ r)%:E). Proof. -rewrite inE => r0 /andP[_]; rewrite inE/= => lpf. +rewrite inE => r0 /andP[/[!inE]/= mf] lpf. apply/integrableP; split => //. apply: measurableT_comp => //. apply: (measurableT_comp (measurable_powR _)) => //. @@ -945,25 +945,26 @@ apply: le_lt_trans. by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. Qed. -Lemma lfun1_integrable (f : {mfun T >-> R}) : - (f : T -> R) \in lfun mu 1 -> mu.-integrable setT (EFin \o f). +Lemma lfun1_integrable (f : T -> R) : + f \in lfun mu 1 -> mu.-integrable setT (EFin \o f). Proof. -move=> /lfun_integrable => /(_ (lexx _)). +move=> /[dup] lf /lfun_integrable => /(_ (lexx _)). under eq_fun => x do rewrite powRr1//. move/integrableP => [mf fley]. -apply/integrableP; split; first exact: measurableT_comp. +apply/integrableP; split. + move: lf; rewrite inE => /andP[/[!inE]/= {}mf _]. + exact: measurableT_comp. rewrite (le_lt_trans _ fley)//=. by under [leRHS]eq_integral => x _ do rewrite normr_id. Qed. -Lemma lfun2_integrable_sqr (f : {mfun T >-> R}) : - (f : T -> R) \in lfun mu 2%:E -> - mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). +Lemma lfun2_integrable_sqr (f : T -> R) : f \in lfun mu 2%:E -> + mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). Proof. -rewrite inE => /andP[_]; rewrite inE/= => l2f. +rewrite inE => /andP[mf]; rewrite inE/= => l2f. +move: mf; rewrite inE/= => mf. apply/integrableP; split. - apply/measurable_EFinP. - exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). + by apply/measurable_EFinP; exact: measurable_funX. rewrite (@lty_poweRy _ _ 2^-1)//. rewrite (le_lt_trans _ l2f)//. rewrite unlock. @@ -972,7 +973,7 @@ rewrite gt0_ler_poweR//. - by rewrite in_itv/= leey integral_ge0. - rewrite ge0_le_integral//. + apply: measurableT_comp => //; apply/measurable_EFinP. - exact/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x ^+ 2)%R _ f). + exact: measurable_funX. + by move=> x _; rewrite lee_fin powR_ge0. + apply/measurable_EFinP. apply/(@measurableT_comp _ _ _ _ _ _ (fun x : R => x `^ 2)%R) => //. @@ -980,13 +981,14 @@ rewrite gt0_ler_poweR//. + by move=> t _/=; rewrite lee_fin normrX powR_mulrn. Qed. -Lemma lfun2M2_1 (f g : {mfun T >-> R}) : - (f : T -> R) \in lfun mu 2%:E -> (g : T -> R) \in lfun mu 2%:E -> - (f \* g : T -> R) \in lfun mu 1. +Lemma lfun2M2_1 (f g : T -> R) : f \in lfun mu 2%:E -> g \in lfun mu 2%:E -> + f \* g \in lfun mu 1. Proof. move=> l2f l2g. -rewrite inE; apply/andP; split; rewrite inE//=. -rewrite /finite_norm. +move: (l2f) (l2g) => /[!inE] /andP[/[!inE]/= mf _] /andP[/[!inE]/= mg _]. +apply/andP; split. + by rewrite inE/=; apply: measurable_funM. +rewrite !inE/= /finite_norm. apply: le_lt_trans. by apply: (@hoelder _ _ _ _ _ _ 2 2) => //; rewrite [RHS]splitr !div1r. rewrite lte_mul_pinfty// ?ge0_fin_numE ?Lnormr_ge0//. @@ -994,17 +996,19 @@ by move: l2f; rewrite inE => /andP[_]; rewrite inE/=. by move: l2g; rewrite inE => /andP[_]; rewrite inE/=. Qed. -Lemma lfunp_scale (f : {mfun T >-> R}) a r : - 1 <= r -> (f : T -> R) \in lfun mu r%:E -> (a \o* f) \in lfun mu r%:E. +Lemma lfunp_scale (f : T -> R) a r : + 1 <= r -> f \in lfun mu r%:E -> a \o* f \in lfun mu r%:E. Proof. -move=> r1 lpf. -rewrite inE; apply/andP; split; rewrite inE//=. -rewrite /finite_norm unlock /Lnorm. +move=> r1 /[dup] lf lpf. +rewrite inE; apply/andP; split. + move: lf; rewrite inE => /andP[/[!inE]/= lf _]. + exact: measurable_funM. +rewrite !inE/= /finite_norm unlock /Lnorm. rewrite poweR_lty//=. under eq_integral => x _ do rewrite normrM powRM// EFinM. rewrite integralZr// ?lfun_integrable//. rewrite muleC lte_mul_pinfty// ?lee_fin ?powR_ge0//. -move: lpf => /(lfun_integrable r1) /integrableP [_]. +move: lpf => /(lfun_integrable r1) /integrableP[_]. under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. by []. Qed. @@ -1032,84 +1036,80 @@ Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. Local Open Scope ereal_scope. -Lemma lfun_inclusion (p q : \bar R) : - forall (p1 : 1 <= p) (q1 : 1 <= q), - mu [set: T] \is a fin_num -> p < q -> - forall f : {mfun T >-> R}, - (f : T -> R) \in lfun mu q -> (f : T -> R) \in lfun mu p. +Lemma lfun_inclusion (p q : \bar R) : forall (p1 : 1 <= p) (q1 : 1 <= q), + mu [set: T] \is a fin_num -> + p <= q -> {subset lfun mu q <= lfun mu p}. Proof. have := measure_ge0 mu [set: T]. -rewrite le_eqVlt => /predU1P[mu0 p1 q1 _ _ f _|mu_pos]. +rewrite le_eqVlt => /predU1P[mu0 p1 q1 muTfin pq f +|mu_pos]. + rewrite inE => /andP[/[1!inE]/= mf _]. rewrite inE; apply/andP; split; rewrite inE//=. rewrite /finite_norm unlock /Lnorm. - move: p p1; case=> //; last by rewrite -mu0 ltxx ltry. - move=> r r1. + move: p p1 {pq} => [r r1| |//]; last by rewrite -mu0 ltxx ltry. under eq_integral do rewrite /= -[(_ `^ _)%R]ger0_norm ?powR_ge0//=. rewrite (@integral_abs_eq0 _ _ _ _ setT setT (fun x => (`|f x| `^ r)%:E))//. by rewrite poweR0r// invr_neq0// gt_eqF// -lte_fin (lt_le_trans _ r1). - apply/measurable_EFinP. - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. + apply/measurable_EFinP/(@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. exact: measurableT_comp. -move: p q. -case=> //[p|]; case=> //[q|] p1 q1; last first. - have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). +move: p q => [p| |//] [q| |]// p1 q1. +- move=> mu_fin. + rewrite le_eqVlt => /predU1P[[->]//|]; rewrite lte_fin => pq f. + rewrite inE/= => /andP[/[!inE]/= mf] ffin. + apply/andP; split; rewrite inE//=. + move: (ffin); rewrite /finite_norm. + have p0 : (0 < p)%R by rewrite (lt_le_trans ltr01). + have pN0 : p != 0%R by rewrite gt_eqF. + have q0 : (0 < q)%R by rewrite (lt_le_trans ltr01). + have qinv0 : q^-1 != 0%R by rewrite invr_neq0// gt_eqF. + pose r := q / p. + pose r' := (1 - r^-1)^-1. + have := @hoelder _ _ _ mu (fun x => `|f x| `^ p)%R (cst 1)%R r r'. + rewrite (_ : (_ \* cst 1)%R = (fun x => `|f x| `^ p))%R -?fctM ?mulr1//. + rewrite Lnorm_cst1 unlock /Lnorm invr1. + have mfp : measurable_fun [set: T] (fun x : T => (`|f x| `^ p)%R). + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. + exact: measurableT_comp. + have m1 : measurable_fun [set: T] (@cst _ R 1%R) by exact: measurable_cst. + have r0 : (0 < r)%R by rewrite/r divr_gt0. + have r'0 : (0 < r')%R. + by rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; + rewrite /r ltr_pdivlMr// mul1r. + have rr'1 : r^-1 + r'^-1 = 1%R. + by rewrite /r' /r invf_div invrK addrCA subrr addr0. + move=> /(_ mfp m1 r0 r'0 rr'1). + under [in leLHS] eq_integral do rewrite /= powRr1// norm_powR// normrE. + under [in leRHS] eq_integral do + rewrite /= norm_powR// normr_id -powRrM mulrCA divff// mulr1. + rewrite [X in X <= _]poweRe1; last + by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. + move=> h1 /lty_poweRy h2. + apply/poweR_lty/(le_lt_trans h1). + rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. + by rewrite (lt_le_trans _ (poweR_ge0 _ _))//= ltey_eq fin_num_poweR. + rewrite poweR_lty// (lty_poweRy qinv0)//. + by have:= ffin; rewrite /finite_norm unlock /Lnorm. +- have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). move=> muoo _ f. - rewrite !inE => /andP[_]. + rewrite !inE => /andP[/[1!inE]/= mf]. rewrite !inE/= /finite_norm unlock /Lnorm mu_pos => supf_lty. apply/andP; split; rewrite inE//= /finite_norm unlock /Lnorm. rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. by rewrite integral_cst// ltey_eq fin_numM. apply: ae_ge0_le_integral => //. - - by move=> x _; rewrite lee_fin powR_ge0. - apply/measurable_EFinP. + + by move=> x _; rewrite lee_fin powR_ge0. + + apply/measurable_EFinP. apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. exact: measurableT_comp. - - by move=> x _; rewrite lee_fin powR_ge0. - apply: filterS fM => t/= ftM _. + + by move=> x _; rewrite lee_fin powR_ge0. + + apply: filterS fM => t/= ftM _. rewrite lee_fin ge0_ler_powR//; first exact: ltW. by rewrite nnegrE (le_trans _ ftM). -move=> mu_fin pleq f. -rewrite inE/= => /andP[_]; rewrite inE/= => ffin. -rewrite inE/=; apply/andP; split; rewrite inE//=. -have:= ffin; rewrite /finite_norm. -have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). -have pN0 : p != 0%R by rewrite gt_eqF. -have q0 : (0 < q)%R by rewrite ?(lt_le_trans ltr01). -have qinv0 : q^-1 != 0%R by rewrite invr_neq0// gt_eqF. -pose r := q/p. -pose r' := (1 - r^-1)^-1. -have := (@hoelder _ _ _ mu (fun x => `|f x| `^ p) (cst 1)%R r r')%R. -rewrite (_ : (_ \* cst 1)%R = (fun x : T => `|f x| `^ p))%R -?fctM ?mulr1//. -rewrite Lnorm_cst1 unlock /Lnorm invr1. -have mfp : measurable_fun [set: T] (fun x : T => (`|f x| `^ p)%R). - apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)) => //. - exact: measurableT_comp. -have m1 : measurable_fun [set: T] (@cst _ R 1%R). - exact: measurable_cst. -have r0 : (0 < r)%R by rewrite/r divr_gt0. -have r'0 : (0 < r')%R. - by rewrite /r' invr_gt0 subr_gt0 invf_lt1 ?(lt_trans ltr01)//; - rewrite /r ltr_pdivlMr// mul1r. -have rr'1 : r^-1 + r'^-1 = 1%R. - by rewrite /r' /r invf_div invrK addrCA subrr addr0. -move=> /(_ mfp m1 r0 r'0 rr'1). -under [in leLHS] eq_integral do rewrite /= powRr1// norm_powR// normrE. -under [in leRHS] eq_integral do - rewrite /= norm_powR// normr_id -powRrM mulrCA divff// mulr1. -rewrite [X in X <= _]poweRe1; last - by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. -move=> h1 /lty_poweRy h2. -apply: poweR_lty. -apply: (le_lt_trans h1). -rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. - by rewrite (lt_le_trans _ (poweR_ge0 _ _))//= ltey_eq fin_num_poweR. -rewrite poweR_lty// (lty_poweRy qinv0)//. -by have:= ffin; rewrite /finite_norm unlock /Lnorm. +- by move=> muTfin _. Qed. -Lemma lfun_inclusion12 (f : {mfun T >-> R}) : mu [set: T] \is a fin_num -> - (f : T -> R) \in lfun mu 2%:E -> (f : T -> R) \in lfun mu 1. -Proof. by move=> ? ?; rewrite (@lfun_inclusion 1 (2%:E))// ?lee1n// lte1n. Qed. +Lemma lfun_inclusion12 : mu [set: T] \is a fin_num -> + {subset lfun mu 2%:E <= lfun mu 1}. +Proof. by move=> ?; apply: lfun_inclusion => //; rewrite lee1n. Qed. End lfun_inclusion. diff --git a/theories/probability.v b/theories/probability.v index 9034d6523c..0e00575f8c 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -260,7 +260,7 @@ Context d (T : measurableType d) (R : realType) (P : probability T R). Lemma expectation_def (X : {RV P >-> R}) : 'E_P[X] = (\int[P]_w (X w)%:E)%E. Proof. by rewrite unlock. Qed. -Lemma expectation_fin_num (X : {RV P >-> R}) : (X : T -> R) \in lfun P 1 -> +Lemma expectation_fin_num (X : T -> R) : X \in lfun P 1 -> 'E_P[X] \is a fin_num. Proof. by move=> ?; rewrite unlock integral_fune_fin_num ?lfun1_integrable. Qed. @@ -277,12 +277,12 @@ move: iX => /integrableP[? Xoo]; rewrite (le_lt_trans _ Xoo)// unlock. exact: le_trans (le_abse_integral _ _ _). Qed. -Lemma expectationZl (X : {RV P >-> R}) (iX : (X : T -> R) \in lfun P 1) - (k : R) : 'E_P[k \o* X] = k%:E * 'E_P [X]. -Proof. by rewrite unlock muleC -integralZr ?lfun1_integrable. Qed. +Lemma expectationZl (X : T -> R) (k : R) : X \in lfun P 1 -> + 'E_P[k \o* X] = k%:E * 'E_P [X]. +Proof. by move=> ?; rewrite unlock muleC -integralZr ?lfun1_integrable. Qed. -Lemma expectation_ge0 (X : {RV P >-> R}) : - (forall x, 0 <= X x)%R -> 0 <= 'E_P[X]. +Lemma expectation_ge0 (X : T -> R) : (forall x, 0 <= X x)%R -> + 0 <= 'E_P[X]. Proof. by move=> ?; rewrite unlock integral_ge0// => x _; rewrite lee_fin. Qed. @@ -301,28 +301,22 @@ move=> mX mY X0 Y0 XY; rewrite unlock ae_ge0_le_integral => //. by apply: XYN => /=; apply: contra_not h; rewrite lee_fin. Qed. -Lemma expectationD (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> (Y : T -> R) \in lfun P 1 -> +Lemma expectationD (X Y : T -> R) : X \in lfun P 1 -> Y \in lfun P 1 -> 'E_P[X \+ Y] = 'E_P[X] + 'E_P[Y]. Proof. by move=> ? ?; rewrite unlock integralD_EFin ?lfun1_integrable. Qed. -Lemma expectationB (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> (Y : T -> R) \in lfun P 1 -> +Lemma expectationB (X Y : T -> R) : X \in lfun P 1 -> Y \in lfun P 1 -> 'E_P[X \- Y] = 'E_P[X] - 'E_P[Y]. Proof. by move=> ? ?; rewrite unlock integralB_EFin ?lfun1_integrable. Qed. -Let sum_sort (X : seq {RV P >-> R}) : - (\sum_(j <- X) MeasurableFun.sort j)%R = MeasurableFun.sort (\sum_(j <- X) j)%R. -Proof. by elim/big_ind2 : _ => //= x1 y1 x2 y2 -> ->. Qed. - -Lemma expectation_sum (X : seq {RV P >-> R}) : - (forall Xi, Xi \in X -> (Xi : T -> R) \in lfun P 1) -> +Lemma expectation_sum (X : seq (T -> R)) : + (forall Xi, Xi \in X -> Xi \in lfun P 1) -> 'E_P[\sum_(Xi <- X) Xi] = \sum_(Xi <- X) 'E_P[Xi]. Proof. elim: X => [|X0 X IHX] intX; first by rewrite !big_nil expectation_cst. rewrite !big_cons expectationD; last 2 first. by rewrite intX// mem_head. - by rewrite -sum_sort big_seq rpred_sum// => Y YX/=; rewrite intX// inE YX orbT. + by rewrite big_seq rpred_sum// => Y YX/=; rewrite intX// inE YX orbT. by rewrite IHX//= => Xi XiX; rewrite intX// inE XiX orbT. Qed. @@ -343,10 +337,9 @@ Section covariance_lemmas. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (P : probability T R). -Lemma covarianceE (X Y : {mfun T >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covarianceE (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P X Y = 'E_P[X * Y] - 'E_P[X] * 'E_P[Y]. Proof. move=> l1X l1Y l1XY. @@ -367,34 +360,31 @@ Proof. by rewrite unlock; congr expectation; apply/funeqP => x /=; rewrite mulrC. Qed. -Lemma covariance_fin_num (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covariance_fin_num (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P X Y \is a fin_num. Proof. by move=> ? ? ?; rewrite covarianceE// fin_numB fin_numM expectation_fin_num. Qed. -Lemma covariance_cst_l c (X : {RV P >-> R}) : covariance P (cst c) X = 0. +Lemma covariance_cst_l c (X : T -> R) : covariance P (cst c) X = 0. Proof. rewrite unlock expectation_cst/=. rewrite [X in 'E_P[X]](_ : _ = cst 0%R) ?expectation_cst//. by apply/funeqP => x; rewrite /GRing.mul/= subrr mul0r. Qed. -Lemma covariance_cst_r (X : {RV P >-> R}) c : covariance P X (cst c) = 0. +Lemma covariance_cst_r (X : T -> R) c : covariance P X (cst c) = 0. Proof. by rewrite covarianceC covariance_cst_l. Qed. -Lemma covarianceZl a (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covarianceZl a (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P (a \o* X)%R Y = a%:E * covariance P X Y. Proof. move=> X1 Y1 XY1. -have aXY : (a \o* X * Y = a \o* (X * Y))%R. - by apply/funeqP => x; rewrite mulrAC. +have aXY : (a \o* X * Y = a \o* (X * Y))%R by apply/funeqP => x; rewrite mulrAC. rewrite [LHS]covarianceE => [||//|] //=; last 2 first. - by rewrite lfunp_scale. - by rewrite aXY lfunp_scale. @@ -402,20 +392,18 @@ rewrite covarianceE// aXY !expectationZl//. by rewrite -muleA -muleBr// fin_num_adde_defr// expectation_fin_num. Qed. -Lemma covarianceZr a (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covarianceZr a (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P X (a \o* Y)%R = a%:E * covariance P X Y. Proof. move=> X1 Y1 XY1. by rewrite [in RHS]covarianceC covarianceC covarianceZl; last rewrite mulrC. Qed. -Lemma covarianceNl (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covarianceNl (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P (\- X)%R Y = - covariance P X Y. Proof. move=> X1 Y1 XY1. @@ -423,26 +411,22 @@ have -> : (\- X = -1 \o* X)%R by apply/funeqP => x /=; rewrite mulrN mulr1. by rewrite covarianceZl// EFinN mulNe mul1e. Qed. -Lemma covarianceNr (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covarianceNr (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P X (\- Y)%R = - covariance P X Y. Proof. by move=> X1 Y1 XY1; rewrite !(covarianceC X) covarianceNl 1?mulrC. Qed. -Lemma covarianceNN (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 1 -> - (Y : T -> R) \in lfun P 1 -> - ((X * Y)%R : T -> R) \in lfun P 1 -> +Lemma covarianceNN (X Y : T -> R) : + X \in lfun P 1 -> Y \in lfun P 1 -> + (X * Y)%R \in lfun P 1 -> covariance P (\- X)%R (\- Y)%R = covariance P X Y. Proof. by move=> ? ? ?; rewrite covarianceNl//= ?covarianceNr ?oppeK ?mulrN//= ?rpredN. Qed. -Lemma covarianceDl (X Y Z : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> - (Z : T -> R) \in lfun P 2%:E -> +Lemma covarianceDl (X Y Z : T -> R) : + X \in lfun P 2%:E -> Y \in lfun P 2%:E -> Z \in lfun P 2%:E -> covariance P (X \+ Y)%R Z = covariance P X Z + covariance P Y Z. Proof. move=> X2 Y2 Z2. @@ -459,19 +443,15 @@ rewrite oppeD ?fin_num_adde_defr ?fin_numM ?expectation_fin_num//. by rewrite addeACA 2?covarianceE. Qed. -Lemma covarianceDr (X Y Z : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> - (Z : T -> R) \in lfun P 2%:E -> +Lemma covarianceDr (X Y Z : T -> R) : + X \in lfun P 2%:E -> Y \in lfun P 2%:E -> Z \in lfun P 2%:E -> covariance P X (Y \+ Z)%R = covariance P X Y + covariance P X Z. Proof. by move=> X2 Y2 Z2; rewrite covarianceC covarianceDl ?(covarianceC X) 1?mulrC. Qed. -Lemma covarianceBl (X Y Z : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> - (Z : T -> R) \in lfun P 2%:E -> +Lemma covarianceBl (X Y Z : T -> R) : + X \in lfun P 2%:E -> Y \in lfun P 2%:E -> Z \in lfun P 2%:E -> covariance P (X \- Y)%R Z = covariance P X Z - covariance P Y Z. Proof. move=> X2 Y2 Z2. @@ -482,10 +462,8 @@ have YZ1 := lfun2M2_1 Y2 Z2. by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl ?rpredN. Qed. -Lemma covarianceBr (X Y Z : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> - (Z : T -> R) \in lfun P 2%:E -> +Lemma covarianceBr (X Y Z : T -> R) : + X \in lfun P 2%:E -> Y \in lfun P 2%:E -> Z \in lfun P 2%:E -> covariance P X (Y \- Z)%R = covariance P X Y - covariance P X Z. Proof. move=> X2 Y2 Z2. @@ -505,23 +483,21 @@ Context d (T : measurableType d) (R : realType) (P : probability T R). Definition variance (X : T -> R) := covariance P X X. Local Notation "''V_' P [ X ]" := (variance X). -Lemma varianceE (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> +Lemma varianceE (X : T -> R) : X \in lfun P 2%:E -> 'V_P[X] = 'E_P[X ^+ 2] - ('E_P[X]) ^+ 2. Proof. move=> X2. by rewrite /variance covarianceE ?lfun2M2_1// lfun_inclusion12 ?fin_num_measure. Qed. -Lemma variance_fin_num (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> +Lemma variance_fin_num (X : T -> R) : X \in lfun P 2%:E -> 'V_P[X] \is a fin_num. Proof. move=> X2. by rewrite covariance_fin_num ?lfun2M2_1// lfun_inclusion12 ?fin_num_measure. Qed. -Lemma variance_ge0 (X : {RV P >-> R}) : (0 <= 'V_P[X])%E. +Lemma variance_ge0 (X : T -> R) : 0 <= 'V_P[X]. Proof. by rewrite /variance unlock; apply: expectation_ge0 => x; exact: sqr_ge0. Qed. @@ -533,28 +509,25 @@ rewrite [X in 'E_P[X]](_ : _ = cst 0%R) ?expectation_cst//. by apply/funext => x; rewrite /GRing.exp/GRing.mul/= subrr mulr0. Qed. -Lemma varianceZ a (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> +Lemma varianceZ a (X : T -> R) : X \in lfun P 2%:E -> 'V_P[(a \o* X)%R] = (a ^+ 2)%:E * 'V_P[X]. Proof. move=> X2. have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. have X1 := lfun_inclusion12 Pfin X2. -rewrite /variance covarianceZl ?covarianceZr ?lfun2M2_1 ?lfunp_scale ?ler1n//. -by rewrite muleA EFinM. +rewrite /variance covarianceZl//=. +- by rewrite covarianceZr// ?muleA ?EFinM// lfun2M2_1. +- by rewrite lfunp_scale. +- by rewrite lfun2M2_1// lfunp_scale// ler1n. Qed. -Lemma varianceN (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - 'V_P[(\- X)%R] = 'V_P[X]. +Lemma varianceN (X : T -> R) : X \in lfun P 2%:E -> 'V_P[(\- X)%R] = 'V_P[X]. Proof. move=> X2. by rewrite /variance covarianceNN ?lfun2M2_1 ?lfun_inclusion12 ?fin_num_measure. Qed. -Lemma varianceD (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> +Lemma varianceD (X Y : T -> R) : X \in lfun P 2%:E -> Y \in lfun P 2%:E -> 'V_P[X \+ Y]%R = 'V_P[X] + 'V_P[Y] + 2%:E * covariance P X Y. Proof. move=> X2 Y2. @@ -568,9 +541,7 @@ rewrite (covarianceC P Y X) [LHS]addeA [LHS](ACl (1*4*(2*3)))/=. by rewrite -[2%R]/(1 + 1)%R EFinD muleDl ?mul1e// covariance_fin_num. Qed. -Lemma varianceB (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> +Lemma varianceB (X Y : T -> R) : X \in lfun P 2%:E -> Y \in lfun P 2%:E -> 'V_P[(X \- Y)%R] = 'V_P[X] + 'V_P[Y] - 2%:E * covariance P X Y. Proof. move=> X2 Y2. @@ -582,16 +553,14 @@ rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R. by rewrite varianceD/= ?varianceN ?covarianceNr ?muleN ?rpredN. Qed. -Lemma varianceD_cst_l c (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> +Lemma varianceD_cst_l c (X : T -> R) : X \in lfun P 2%:E -> 'V_P[(cst c \+ X)%R] = 'V_P[X]. Proof. move=> X2. by rewrite varianceD ?lfun_cst// variance_cst add0e covariance_cst_l mule0 adde0. Qed. -Lemma varianceD_cst_r (X : {RV P >-> R}) c : - (X : T -> R) \in lfun P 2%:E -> +Lemma varianceD_cst_r (X : T -> R) c : X \in lfun P 2%:E -> 'V_P[(X \+ cst c)%R] = 'V_P[X]. Proof. move=> X2. @@ -599,24 +568,20 @@ have -> : (X \+ cst c = cst c \+ X)%R by apply/funeqP => x /=; rewrite addrC. exact: varianceD_cst_l. Qed. -Lemma varianceB_cst_l c (X : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> +Lemma varianceB_cst_l c (X : T -> R) : X \in lfun P 2%:E -> 'V_P[(cst c \- X)%R] = 'V_P[X]. Proof. move=> X2; rewrite -[(cst c \- X)%R]/(cst c \+ (\- X))%R. by rewrite varianceD_cst_l/= ?rpredN// varianceN. Qed. -Lemma varianceB_cst_r (X : {RV P >-> R}) c : - (X : T -> R) \in lfun P 2%:E -> +Lemma varianceB_cst_r (X : T -> R) c : X \in lfun P 2%:E -> 'V_P[(X \- cst c)%R] = 'V_P[X]. Proof. by move=> X2; rewrite -[(X \- cst c)%R]/(X \+ (cst (- c)))%R varianceD_cst_r. Qed. -Lemma covariance_le (X Y : {RV P >-> R}) : - (X : T -> R) \in lfun P 2%:E -> - (Y : T -> R) \in lfun P 2%:E -> +Lemma covariance_le (X Y : T -> R) : X \in lfun P 2%:E -> Y \in lfun P 2%:E -> covariance P X Y <= sqrte 'V_P[X] * sqrte 'V_P[Y]. Proof. move=> X2 Y2. @@ -654,8 +619,7 @@ Section markov_chebyshev_cantelli. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (P : probability T R). -Lemma markov (X : {RV P >-> R}) (f : R -> R) (eps : R) : - (0 < eps)%R -> +Lemma markov (X : {RV P >-> R}) (f : R -> R) (eps : R) : (0 < eps)%R -> measurable_fun [set: R] f -> (forall r, 0 <= r -> 0 <= f r)%R -> {in Num.nneg &, {homo f : x y / x <= y}}%R -> (f eps)%:E * P [set x | eps%:E <= `| (X x)%:E | ] <= @@ -672,7 +636,7 @@ apply: (le_trans (@le_integral_comp_abse _ _ _ P _ measurableT (EFin \o X) - by rewrite unlock. Qed. -Definition mmt_gen_fun (X : {RV P >-> R}) (t : R) := 'E_P[expR \o t \o* X]. +Definition mmt_gen_fun (X : T -> R) (t : R) := 'E_P[expR \o t \o* X]. Local Notation "'M_ X t" := (mmt_gen_fun X t). Lemma chernoff (X : {RV P >-> R}) (r a : R) : (0 < r)%R -> From d3ac27ade1b412e825c7268bf22304766f2d5062 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 8 Apr 2025 10:52:19 +0900 Subject: [PATCH 32/73] fix --- experimental_reals/discrete.v | 2 +- reals/reals.v | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 52515d7413..9681124ea2 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -4,7 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -From Coq Require Setoid. +From Corelib Require Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. diff --git a/reals/reals.v b/reals/reals.v index 90bb30d878..601ad4fe7c 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -38,7 +38,7 @@ (* *) (******************************************************************************) -From Coq Require Import Setoid. +From Corelib Require Import Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import boolp classical_sets set_interval. From 6bd34f9f16bcade44e2d923e4c29ed32cde8d608 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 28 Apr 2025 16:53:15 +0900 Subject: [PATCH 33/73] Lnorm_ge0 and Lnorm_eq0_eq0 need not be specialized --- CHANGELOG_UNRELEASED.md | 125 +---------------------------- _CoqProject | 2 +- classical/functions.v | 4 - classical/mathcomp_extra.v | 145 ---------------------------------- experimental_reals/discrete.v | 1 + theories/hoelder.v | 122 +++++++++++++++------------- 6 files changed, 69 insertions(+), 330 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index dbce6c8382..a46eccd8ec 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -70,33 +70,6 @@ - in `pi_irrational`: + definition `rational` -- new directory `lebesgue_integral_theory` with new files: - + `simple_functions.v` - + `lebesgue_integral_definition.v` - + `lebesgue_integral_approximation.v` - + `lebesgue_integral_monotone_convergence.v` - + `lebesgue_integral_nonneg.v` - + `lebesgue_integrable.v` - + `lebesgue_integral_dominated_convergence.v` - + `lebesgue_integral_under.v` - + `lebesgue_Rintegral.v` - + `lebesgue_integral_fubini.v` - + `lebesgue_integral_differentiation.v` - + `lebesgue_integral.v` -- in `boolp.v`: - + lemmas `orW`, `or3W`, `or4W` - -- in `classical_sets.v`: - + lemma `image_nonempty` - -- in `mathcomp_extra.v`: - + lemmas `eq_exists2l`, `eq_exists2r` - -- in `ereal.v`: - + lemmas `ereal_infEN`, `ereal_supN`, `ereal_infN`, `ereal_supEN` - + lemmas `ereal_supP`, `ereal_infP`, `ereal_sup_gtP`, `ereal_inf_ltP`, - `ereal_inf_leP`, `ereal_sup_geP`, `lb_ereal_infNy_adherent`, - `ereal_sup_real`, `ereal_inf_real` - in `charge.v`: + lemma `ae_eq_mul2l` @@ -136,12 +109,9 @@ + lemma `lfun_oppr_closed` + lemma `lfun_addr_closed` -- in `lebesgue_integral.v`: +- in `simple_functions.v`: + lemma `mfunMn` -- in `classical_sets.v`: - + lemma `set_cst` - - in `measurable_realfun.v`: + lemmas `ereal_inf_seq`, `ereal_sup_seq`, `ereal_sup_cst`, `ereal_inf_cst`, `ereal_sup_pZl`, @@ -155,9 +125,6 @@ + instances `comp_ae_eq`, `comp_ae_eq2`, `comp_ae_eq2'`, `sub_ae_eq2` + lemmas `ae_eq_comp2`, `ae_foralln` -- in `functions.v`: - + lemma `natmulfctE` - - new file `ess_sup_inf.v`: + lemma `measure0_ae` + definition `ess_esup` @@ -185,32 +152,6 @@ - in `probability.v`: + lemma `lfun1_expectation_lty` -### Changed - -- file `nsatz_realtype.v` moved from `reals` to `reals-stdlib` package -- moved from `gauss_integral` to `trigo.v`: - + `oneDsqr`, `oneDsqr_ge1`, `oneDsqr_inum`, `oneDsqrV_le1`, - `continuous_oneDsqr`, `continuous_oneDsqr` -- moved, generalized, and renamed from `gauss_integral` to `trigo.v`: - + `integral01_oneDsqr` -> `integral0_oneDsqr` - -- in `interval_inference.v`: - + definition `IntItv.exprn_le1_bound` - + lemmas `Instances.nat_spec_succ`, `Instances.num_spec_natmul`, - `Instances.num_spec_intmul`, `Instances.num_itv_bound_exprn_le1` - + canonical instance `Instances.succn_inum` - -- in `lebesgue_integral_properties.v` - (new file with contents moved from `lebesgue_integral.v`) - + `le_normr_integral` renamed to `le_normr_Rintegral` - -- moved to `lebesgue_measure.v` (from old `lebesgue_integral.v`) - + `compact_finite_measure` - -- moved from `ftc.v` to `lebesgue_integral_under.v` (new file) - + notation `'d1`, definition `partial1of2`, lemmas `partial1of2E`, - `cvg_differentiation_under_integral`, `differentiation_under_integral`, - `derivable_under_integral` - in `hoelder.v`: + lemmas `Lnorm_eq0_eq0` @@ -258,35 +199,10 @@ - in `measurable_realfun.v` + lemma `measurable_ln` -- in `ereal.v`: - + lemmas `ereal_infEN`, `ereal_supN`, `ereal_infN`, `ereal_supEN` - + lemmas `ereal_supP`, `ereal_infP`, `ereal_sup_gtP`, `ereal_inf_ltP`, - `ereal_inf_leP`, `ereal_sup_geP`, `lb_ereal_infNy_adherent`, - `ereal_sup_real`, `ereal_inf_real` -- in `boolp.v`: - + `eq_fun2` -> `eq2_fun` - + `eq_fun3` -> `eq3_fun` - + `eq_forall2` -> `eq2_forall` - + `eq_forall3` -> `eq3_forall` -- in `ereal.v`: - + `ereal_sup_le` -> `ereal_sup_ge` - in `hoelder.v`: + `minkowski` -> `minkowski_EFin` - + `Lnorm_ge0` -> `Lnormr_ge0` - + `Lnorm_eq0_eq0` -> `Lnormr_eq0_eq0` -### Generalized - -- in `constructive_ereal.v`: - + lemma `EFin_natmul` - -- in `lebesgue_integral.v` - + lemmas `measurable_funP`, `ge0_integral_pushforward`, - `integrable_pushforward`, `integral_pushforward` - -- in `real_interval.v`: - + lemmas `bigcup_itvT`, `itv_bndy_bigcup_BRight`, `itv_bndy_bigcup_BLeft_shift` - in `hoelder.v`: + definition `Lnorm` generalized to functions with codomain `\bar R` (this impacts the notation `'N_p[f]`) @@ -300,44 +216,7 @@ ### Removed - in `functions.v`: - + definitions `fct_ringMixin`, `fct_ringMixin` (was only used in an `HB.instance`) -- file `mathcomp_extra.v` - + lemma `Pos_to_natE` (moved to `Rstruct.v`) - + lemma `deg_le2_ge0` (available as `deg_le2_poly_ge0` in `ssrnum.v` - since MathComp 2.1.0) - + definitions `monotonous`, `boxed`, `onem`, `inv_fun`, - `bound_side`, `swap`, `prodA`, `prodAr`, `map_pair`, `sigT_fun` - (moved to new file `unstable.v` that shouldn't be used outside of - Analysis) - + notations `` `1 - r ``, `f \^-1` (moved to new file `unstable.v` - that shouldn't be used outside of Analysis) - + lemmas `dependent_choice_Type`, `maxr_absE`, `minr_absE`, - `le_bigmax_seq`, `bigmax_sup_seq`, `leq_ltn_expn`, `last_filterP`, - `path_lt_filter0`, `path_lt_filterT`, `path_lt_head`, - `path_lt_last_filter`, `path_lt_le_last`, `sumr_le0`, - `fset_nat_maximum`, `image_nat_maximum`, `card_fset_sum1`, - `onem0`, `onem1`, `onemK`, `add_onemK`, `onem_gt0`, `onem_ge0`, - `onem_le1`, `onem_lt1`, `onemX_ge0`, `onemX_lt1`, `onemD`, - `onemMr`, `onemM`, `onemV`, `lez_abs2`, `ler_gtP`, `ler_ltP`, - `real_ltr_distlC`, `prodAK`, `prodArK`, `swapK`, `lt_min_lt`, - `intrD1`, `intr1D`, `floor_lt_int`, `floor_ge0`, `floor_le0`, - `floor_lt0`, `floor_eq`, `floor_neq0`, `ceil_gt_int`, `ceil_ge0`, - `ceil_gt0`, `ceil_le0`, `abs_ceil_ge`, `nat_int`, `bij_forall`, - `and_prop_in`, `mem_inc_segment`, `mem_dec_segment`, - `partition_disjoint_bigfcup`, `partition_disjoint_bigfcup`, - `prodr_ile1`, `size_filter_gt0`, `ltr_sum`, `ltr_sum_nat` (moved - to new file `unstable.v` that shouldn't be used outside of - Analysis) - -- in `reals.v`: - + lemmas `floor_le`, `le_floor` (deprecated since 1.3.0) - -- file `lebesgue_integral.v` (split in several files in the directory - `lebesgue_integral_theory`) - -- in `classical_sets.v`: - + notations `setvI`, `setIv`, `bigcup_set`, `bigcup_set_cond`, `bigcap_set`, - `bigcap_set_cond` + + definitions `fct_zmodMixin`, `fct_ringMixin` (was only used in an `HB.instance`) - in `measure.v`: + definition `almost_everywhere_notation` diff --git a/_CoqProject b/_CoqProject index a187020c5e..4ce5662f31 100644 --- a/_CoqProject +++ b/_CoqProject @@ -120,6 +120,6 @@ theories/kernel.v theories/pi_irrational.v theories/gauss_integral.v theories/showcase/summability.v -theories/lspace.v + analysis_stdlib/Rstruct_topology.v analysis_stdlib/showcase/uniform_bigO.v diff --git a/classical/functions.v b/classical/functions.v index e1fa4cb293..1af52e51fe 100644 --- a/classical/functions.v +++ b/classical/functions.v @@ -2702,10 +2702,6 @@ Proof. by []. Qed. Definition fctE := (cstE, compE, opprfctE, addrfctE, mulrfctE, scalrfctE, exprfctE). -Lemma natmulfctE (U : pointedType) (K : ringType) (f : U -> K) n : - f *+ n = (fun x => f x *+ n). -Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. - End function_space_lemmas. Lemma inv_funK T (R : unitRingType) (f : T -> R) : f\^-1\^-1%R = f. diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index 9d55d5c1cf..6245db399c 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -470,148 +470,3 @@ Proof. by move=> ? ? []. Qed. Lemma inl_inj {A B} : injective (@inl A B). Proof. by move=> ? ? []. Qed. - -Section bijection_forall. - -Lemma bij_forall A B (f : A -> B) (P : B -> Prop) : - bijective f -> (forall y, P y) <-> (forall x, P (f x)). -Proof. -by case; rewrite /cancel => g _ cangf; split => // => ? y; rewrite -(cangf y). -Qed. - -End bijection_forall. - -Lemma and_prop_in (T : Type) (p : mem_pred T) (P Q : T -> Prop) : - {in p, forall x, P x /\ Q x} <-> - {in p, forall x, P x} /\ {in p, forall x, Q x}. -Proof. -split=> [cnd|[cnd1 cnd2] x xin]; first by split=> x xin; case: (cnd x xin). -by split; [apply: cnd1 | apply: cnd2]. -Qed. - -Lemma mem_inc_segment d (T : porderType d) (a b : T) (f : T -> T) : - {in `[a, b] &, {mono f : x y / (x <= y)%O}} -> - {homo f : x / x \in `[a, b] >-> x \in `[f a, f b]}. -Proof. -move=> fle x xab; have leab : (a <= b)%O by rewrite (itvP xab). -by rewrite in_itv/= !fle ?(itvP xab). -Qed. - -Lemma mem_dec_segment d (T : porderType d) (a b : T) (f : T -> T) : - {in `[a, b] &, {mono f : x y /~ (x <= y)%O}} -> - {homo f : x / x \in `[a, b] >-> x \in `[f b, f a]}. -Proof. -move=> fge x xab; have leab : (a <= b)%O by rewrite (itvP xab). -by rewrite in_itv/= !fge ?(itvP xab). -Qed. - -Definition sigT_fun {I : Type} {X : I -> Type} {T : Type} - (f : forall i, X i -> T) (x : {i & X i}) : T := - (f (projT1 x) (projT2 x)). - -(* PR 114 to finmap in progress *) -Section FsetPartitions. -Variables T I : choiceType. -Implicit Types (x y z : T) (A B D X : {fset T}) (P Q : {fset {fset T}}). -Implicit Types (J : pred I) (F : I -> {fset T}). - -Variables (R : Type) (idx : R) (op : Monoid.com_law idx). -Let rhs_cond P K E := - (\big[op/idx]_(A <- P) \big[op/idx]_(x <- A | K x) E x)%fset. -Let rhs P E := (\big[op/idx]_(A <- P) \big[op/idx]_(x <- A) E x)%fset. - -Lemma partition_disjoint_bigfcup (f : T -> R) (F : I -> {fset T}) - (K : {fset I}) : - (forall i j, i \in K -> j \in K -> i != j -> [disjoint F i & F j])%fset -> - \big[op/idx]_(i <- \big[fsetU/fset0]_(x <- K) (F x)) f i = - \big[op/idx]_(k <- K) (\big[op/idx]_(i <- F k) f i). -Proof. -move=> disjF; pose P := [fset F i | i in K & F i != fset0]%fset. -have trivP : trivIfset P. - apply/trivIfsetP => _ _ /imfsetP[i iK ->] /imfsetP[j jK ->] neqFij. - move: iK; rewrite !inE/= => /andP[iK Fi0]. - move: jK; rewrite !inE/= => /andP[jK Fj0]. - by apply: (disjF _ _ iK jK); apply: contraNneq neqFij => ->. -have -> : (\bigcup_(i <- K) F i)%fset = fcover P. - apply/esym; rewrite /P fcover_imfset big_mkcond /=; apply eq_bigr => i _. - by case: ifPn => // /negPn/eqP. -rewrite big_trivIfset // /rhs big_imfset => [|i j iK /andP[jK notFj0] eqFij] /=. - rewrite big_filter big_mkcond; apply eq_bigr => i _. - by case: ifPn => // /negPn /eqP ->; rewrite big_seq_fset0. -move: iK; rewrite !inE/= => /andP[iK Fi0]. -by apply: contraNeq (disjF _ _ iK jK) _; rewrite -fsetI_eq0 eqFij fsetIid. -Qed. - -End FsetPartitions. - -(* TODO: move to ssrnum *) -Lemma prodr_ile1 {R : realDomainType} (s : seq R) : - (forall x, x \in s -> 0 <= x <= 1)%R -> (\prod_(j <- s) j <= 1)%R. -Proof. -elim: s => [_ | y s ih xs01]; rewrite ?big_nil// big_cons. -have /andP[y0 y1] : (0 <= y <= 1)%R by rewrite xs01// mem_head. -rewrite mulr_ile1 ?andbT//. - rewrite big_seq prodr_ge0// => x xs. - by have := xs01 x; rewrite inE xs orbT => /(_ _)/andP[]. -by rewrite ih// => e xs; rewrite xs01// in_cons xs orbT. -Qed. - -(* TODO: move to ssrnum *) - -Lemma size_filter_gt0 T P (r : seq T) : (size (filter P r) > 0)%N = (has P r). -Proof. by elim: r => //= x r; case: ifP. Qed. - -Lemma ltr_sum [R : numDomainType] [I : Type] (r : seq I) - [P : pred I] [F G : I -> R] : - has P r -> - (forall i : I, P i -> F i < G i) -> - \sum_(i <- r | P i) F i < \sum_(i <- r | P i) G i. -Proof. -rewrite -big_filter -[ltRHS]big_filter -size_filter_gt0. -case: filter (filter_all P r) => //= x {}r /andP[Px Pr] _ ltFG. -rewrite !big_cons ltr_leD// ?ltFG// -(all_filterP Pr) !big_filter. -by rewrite ler_sum => // i Pi; rewrite ltW ?ltFG. -Qed. - -Lemma ltr_sum_nat [R : numDomainType] [m n : nat] [F G : nat -> R] : - (m < n)%N -> (forall i : nat, (m <= i < n)%N -> F i < G i) -> - \sum_(m <= i < n) F i < \sum_(m <= i < n) G i. -Proof. -move=> lt_mn i; rewrite big_nat [ltRHS]big_nat ltr_sum//. -by apply/hasP; exists m; rewrite ?mem_index_iota leqnn lt_mn. -Qed. - -Lemma eq_exists2l (A : Type) (P P' Q : A -> Prop) : - (forall x, P x <-> P' x) -> - (exists2 x, P x & Q x) <-> (exists2 x, P' x & Q x). -Proof. -by move=> eqQ; split=> -[x p q]; exists x; move: p q; rewrite ?eqQ. -Qed. - -Lemma eq_exists2r (A : Type) (P Q Q' : A -> Prop) : - (forall x, Q x <-> Q' x) -> - (exists2 x, P x & Q x) <-> (exists2 x, P x & Q' x). -Proof. -by move=> eqP; split=> -[x p q]; exists x; move: p q; rewrite ?eqP. -Qed. - -Declare Scope signature_scope. -Delimit Scope signature_scope with signature. - -Import -(notations) Morphisms. -Arguments Proper {A}%_type R%_signature m. -Arguments respectful {A B}%_type (R R')%_signature _ _. - -Module ProperNotations. - -Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) - (right associativity, at level 55) : signature_scope. - -Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature)) - (right associativity, at level 55) : signature_scope. - -Notation " R ~~> R' " := (@respectful _ _ (Program.Basics.flip (R%signature)) (R'%signature)) - (right associativity, at level 55) : signature_scope. - -Export -(notations) Morphisms. -End ProperNotations. diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 9681124ea2..63ca0e73b8 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -21,6 +21,7 @@ Local Open Scope ring_scope. Local Open Scope real_scope. Section ProofIrrelevantChoice. + Context {T : choiceType}. Lemma existsTP (P : T -> Prop) : { x : T | P x } + (forall x, ~ P x). diff --git a/theories/hoelder.v b/theories/hoelder.v index ecd7948eba..11f6ddf7a5 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -124,47 +124,56 @@ rewrite unlock /Lnorm; under eq_integral do rewrite /= normr1 powR1. by rewrite integral_cst// mul1e. Qed. -End Lnorm_properties. - -Section Lnorm_properties. -Context d {T : measurableType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Local Open Scope ereal_scope. -Implicit Types (p : \bar R) (f g : T -> R) (r : R). - -Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). - -Lemma Lnormr_ge0 p f : 0 <= 'N_p[f]. +Lemma Lnorm_ge0 p f : 0 <= 'N_p[f]. Proof. rewrite unlock; move: p => [r/=|/=|//]; first exact: poweR_ge0. -- by case: ifPn => // /ess_sup_ger; apply => t/=. +- by case: ifPn => // /ess_sup_gee; apply; apply/nearW => r/=. - by case: ifPn => // muT0; apply/ess_infP/nearW => x /=. Qed. -Lemma Lnormr_eq0_eq0 (f : T -> R) p : - measurable_fun setT f -> (0 < p)%E -> 'N_p[f] = 0 -> f = 0%R %[ae mu]. +Lemma Lnorm_eq0_eq0 f p : + measurable_fun setT f -> (0 < p)%E -> 'N_p[f] = 0 -> f = \0 %[ae mu]. Proof. rewrite unlock /Lnorm => mf. case: p => [r||//]. - rewrite lte_fin => r0 /poweR_eq0_eq0 => /(_ (integral_ge0 _ _)) h. - have : \int[mu]_x (`|f x| `^ r)%:E = 0. - by apply: h => x _; rewrite lee_fin powR_ge0. - under eq_integral => x _ do rewrite -[_%:E]gee0_abs ?lee_fin ?powR_ge0//. - have mp : measurable_fun [set: T] (fun x : T => (`|f x| `^ r)%:E). - apply: measurableT_comp => //. - apply (measurableT_comp (measurable_powR _)) => //. + have : \int[mu]_x `|f x| `^ r = 0. + by apply: h => x _; rewrite poweR_ge0. + move=> H. + have {H} : \int[mu]_x `| `|f x| `^ r | = 0%R. + under eq_integral. + move=> x _. + rewrite gee0_abs; last first. + by rewrite poweR_ge0. + over. + exact: H. + have mp : measurable_fun [set: T] (fun x : T => `|f x| `^ r). + apply: (@measurableT_comp _ _ _ _ _ _ (fun x => x `^ r)) => //=. + by apply (measurableT_comp (measurable_poweR _)) => //. exact: measurableT_comp. - move/(ae_eq_integral_abs _ measurableT mp). + move/(ae_eq_integral_abs mu measurableT mp). apply: filterS => x/= /[apply]. - by case=> /powR_eq0_eq0 /eqP; rewrite normr_eq0 => /eqP. + move=> /poweR_eq0_eq0 /eqP => /(_ (abse_ge0 _)). + by rewrite abse_eq0 => /eqP. - case: ifPn => [mu0 _|]. move=> /abs_sup_eq0_ae_eq/=. - by apply: filterS => x/= /(_ I) /eqP + _; rewrite eqe => /eqP. + apply: filterS => x/= /(_ I) /eqP + _. + by move=> /eqP. rewrite ltNge => /negbNE mu0 _ _. suffices mueq0: mu setT = 0 by exact: ae_eq0. by apply/eqP; rewrite eq_le mu0/=. Qed. +End Lnorm_properties. + +Section Lnorm_properties. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. +Implicit Types (p : \bar R) (f g : T -> R) (r : R). + +Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). + Lemma powR_Lnorm f r : r != 0%R -> 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r)%:E. Proof. by move=> r0; rewrite poweR_Lnorm. Qed. @@ -173,13 +182,9 @@ Lemma oppr_Lnorm f p : 'N_p[\- f]%R = 'N_p[f]. Proof. by rewrite -[RHS]oppe_Lnorm. Qed. End Lnorm_properties. -#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed to `Lnormr_ge0`")] -Notation Lnorm_ge0 := Lnormr_ge0 (only parsing). -#[deprecated(since="mathcomp-analysis 1.10.0", note="renamed to `Lnormr_eq0_eq0`")] -Notation Lnorm_eq0_eq0 := Lnormr_eq0_eq0 (only parsing). #[global] -Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnormr_ge0] : core. +Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnorm_ge0] : core. Notation "'N[ mu ]_ p [ f ]" := (Lnorm mu p f) : ereal_scope. @@ -263,14 +268,15 @@ rewrite -lte_fin. move=> mf mg p0 q0 pq f0; rewrite f0 mul0e Lnorm1 [leLHS](_ : _ = 0)//. rewrite (ae_eq_integral (cst 0)) => [|//||//|]; first by rewrite integral0. - by do 2 apply: measurableT_comp => //; exact: measurable_funM. -- apply: filterS (Lnormr_eq0_eq0 mf p0 f0) => x /(_ I) + _. - by rewrite /= normrM => ->; rewrite normr0 mul0r. +- move/measurable_EFinP in mf. + apply: filterS (Lnorm_eq0_eq0 mf p0 f0) => x /(_ I) + _. + by rewrite /= normrM EFinM -abse_EFin => ->; rewrite abse0 mul0e. Qed. Let normalized p f x := `|f x| / fine 'N_p%:E[f]. Let normalized_ge0 p f x : (0 <= normalized p f x)%R. -Proof. by rewrite /normalized divr_ge0// fine_ge0// Lnormr_ge0. Qed. +Proof. by rewrite /normalized divr_ge0// fine_ge0// Lnorm_ge0. Qed. Let measurable_normalized p f : measurable_fun [set: T] f -> measurable_fun [set: T] (normalized p f). @@ -283,8 +289,8 @@ Proof. move=> p0 fpos ifp. transitivity (\int[mu]_x (`|f x| `^ p / fine ('N_p%:E[f] `^ p))%:E). apply: eq_integral => t _. - rewrite powRM//; last by rewrite invr_ge0 fine_ge0// Lnormr_ge0. - rewrite -[in LHS]powR_inv1; last by rewrite fine_ge0 // Lnormr_ge0. + rewrite powRM//; last by rewrite invr_ge0 fine_ge0// Lnorm_ge0. + rewrite -[in LHS]powR_inv1; last by rewrite fine_ge0 // Lnorm_ge0. by rewrite fine_poweR powRAC -powR_inv1 // powR_ge0. have fp0 : 0 < \int[mu]_x (`|f x| `^ p)%:E. rewrite unlock in fpos. @@ -310,26 +316,26 @@ have [f0|f0] := eqVneq 'N_p%:E[f] 0%E; first exact: hoelder0. have [g0|g0] := eqVneq 'N_q%:E[g] 0%E. rewrite muleC; apply: le_trans; last by apply: hoelder0 => //; rewrite addrC. by under eq_Lnorm do rewrite /= mulrC. -have {f0}fpos : 0 < 'N_p%:E[f] by rewrite lt0e f0 Lnormr_ge0. -have {g0}gpos : 0 < 'N_q%:E[g] by rewrite lt0e g0 Lnormr_ge0. +have {f0}fpos : 0 < 'N_p%:E[f] by rewrite lt0e f0 Lnorm_ge0. +have {g0}gpos : 0 < 'N_q%:E[g] by rewrite lt0e g0 Lnorm_ge0. have [foo|foo] := eqVneq 'N_p%:E[f] +oo%E; first by rewrite foo gt0_mulye ?leey. have [goo|goo] := eqVneq 'N_q%:E[g] +oo%E; first by rewrite goo gt0_muley ?leey. pose F := normalized p f; pose G := normalized q g. rewrite [leLHS](_ : _ = 'N_1[(F \* G)%R] * 'N_p%:E[f] * 'N_q%:E[g]); last first. rewrite !Lnorm1; under [in RHS]eq_integral. move=> x _; rewrite /F /G /normalized/=. - rewrite ger0_norm; last by rewrite mulr_ge0 ?divr_ge0 ?fine_ge0 ?Lnormr_ge0. + rewrite ger0_norm; last by rewrite mulr_ge0 ?divr_ge0 ?fine_ge0 ?Lnorm_ge0. by rewrite mulrACA -normrM EFinM; over. rewrite ge0_integralZr//; last 2 first. - by do 2 apply: measurableT_comp => //; exact: measurable_funM. - - by rewrite lee_fin mulr_ge0// invr_ge0 fine_ge0// Lnormr_ge0. + - by rewrite lee_fin mulr_ge0// invr_ge0 fine_ge0// Lnorm_ge0. rewrite -!muleA [X in _ * X](_ : _ = 1) ?mule1// EFinM muleACA. rewrite (_ : _ * 'N_p%:E[f] = 1) ?mul1e; last first. - rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnormr_ge0. + rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnorm_ge0. by rewrite -EFinM mulVr ?unitfE ?gt_eqF// fine_gt0// fpos/= ltey. - rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnormr_ge0. + rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnorm_ge0. by rewrite -EFinM mulVr ?unitfE ?gt_eqF// fine_gt0// gpos/= ltey. -rewrite -(mul1e ('N_p%:E[f] * _)) -muleA lee_pmul ?mule_ge0 ?Lnormr_ge0//. +rewrite -(mul1e ('N_p%:E[f] * _)) -muleA lee_pmul ?mule_ge0 ?Lnorm_ge0//. rewrite [leRHS](_ : _ = \int[mu]_x (F x `^ p / p + G x `^ q / q)%:E). rewrite Lnorm1 ae_ge0_le_integral //. - do 2 apply: measurableT_comp => //. @@ -526,25 +532,25 @@ Lemma minkowski_EFin f g p : Proof. move=> mf mg; rewrite le_eqVlt => /predU1P[<-|p1]; first exact: minkowski1. have [->|Nfoo] := eqVneq 'N_p%:E[f] +oo. - by rewrite addye ?leey// -ltNye (lt_le_trans _ (Lnormr_ge0 _ _ _)). + by rewrite addye ?leey// -ltNye (lt_le_trans _ (Lnorm_ge0 _ _ _)). have [->|Ngoo] := eqVneq 'N_p%:E[g] +oo. - by rewrite addey ?leey// -ltNye (lt_le_trans _ (Lnormr_ge0 _ _ _)). + by rewrite addey ?leey// -ltNye (lt_le_trans _ (Lnorm_ge0 _ _ _)). have Nfgoo : 'N_p%:E[(f \+ g)%R] < +oo. by rewrite minkowski_lty// ?ltW// ltey; [exact: Nfoo|exact: Ngoo]. suff : 'N_p%:E[(f \+ g)%R] `^ p <= ('N_p%:E[f] + 'N_p%:E[g]) * 'N_p%:E[(f \+ g)%R] `^ p * (fine 'N_p%:E[(f \+ g)%R])^-1%:E. have [-> _|Nfg0] := eqVneq 'N_p%:E[(f \+ g)%R] 0. - by rewrite adde_ge0 ?Lnormr_ge0. - rewrite lee_pdivlMr ?fine_gt0// ?lt0e ?Nfg0 ?Lnormr_ge0//. + by rewrite adde_ge0 ?Lnorm_ge0. + rewrite lee_pdivlMr ?fine_gt0// ?lt0e ?Nfg0 ?Lnorm_ge0//. rewrite -{1}(@fineK _ ('N_p%:E[(f \+ g)%R] `^ p)); last first. - by rewrite fin_num_poweR// ge0_fin_numE// Lnormr_ge0. + by rewrite fin_num_poweR// ge0_fin_numE// Lnorm_ge0. rewrite -(invrK (fine _)) lee_pdivrMl; last first. rewrite invr_gt0 fine_gt0// (poweR_lty _ Nfgoo) andbT poweR_gt0//. - by rewrite lt0e Nfg0 Lnormr_ge0. - rewrite fineK ?ge0_fin_numE ?Lnormr_ge0// => /le_trans; apply. + by rewrite lt0e Nfg0 Lnorm_ge0. + rewrite fineK ?ge0_fin_numE ?Lnorm_ge0// => /le_trans; apply. rewrite lee_pdivrMl; last first. - by rewrite fine_gt0// poweR_lty// andbT poweR_gt0// lt0e Nfg0 Lnormr_ge0. - by rewrite fineK// 1?muleC// fin_num_poweR// ge0_fin_numE ?Lnormr_ge0. + by rewrite fine_gt0// poweR_lty// andbT poweR_gt0// lt0e Nfg0 Lnorm_ge0. + by rewrite fineK// 1?muleC// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. have p0 : (0 < p)%R by exact: (lt_trans _ p1). rewrite powR_Lnorm ?gt_eqF//. under eq_integral => x _ do rewrite -mulr_powRB1//. @@ -570,8 +576,8 @@ rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * (\int[mu]_x (`|f x + g x| `^ p)%:E) `^ `1-(p^-1)). rewrite muleDl; last 2 first. - rewrite fin_num_poweR// -powR_Lnorm ?gt_eqF// fin_num_poweR//. - by rewrite ge0_fin_numE ?Lnormr_ge0. - - by rewrite ge0_adde_def// inE Lnormr_ge0. + by rewrite ge0_fin_numE ?Lnorm_ge0. + - by rewrite ge0_adde_def// inE Lnorm_ge0. apply: leeD. - pose h := (@powR R ^~ (p - 1) \o normr \o (f \+ g))%R; pose i := (f \* h)%R. rewrite [leLHS](_ : _ = 'N_1[i]%R); last first. @@ -607,7 +613,7 @@ rewrite poweRD; last by rewrite poweRD_defE gt_eqF ?implyFb// subr_gt0 invf_lt1. rewrite poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. congr (_ * _); rewrite poweRN. - by rewrite unlock fine_poweR. -- by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnormr_ge0. +- by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. Qed. Lemma lerB_DLnorm f g p : @@ -632,7 +638,7 @@ move=> mf mg p1. set rhs := (leRHS); have [?|] := boolP (rhs \is a fin_num). by rewrite lee_subel_addr//; exact: lerB_DLnorm. rewrite fin_numEn => /orP[|/eqP ->]; last by rewrite leey. -by rewrite gt_eqF// (lt_le_trans _ (Lnormr_ge0 _ _ _)). +by rewrite gt_eqF// (lt_le_trans _ (Lnorm_ge0 _ _ _)). Qed. (* TODO: rename to minkowski after version 1.12.0 *) @@ -885,7 +891,7 @@ Let nm f := fine ('N[mu]_p[EFin \o f]). Lemma finite_norm_fine (f : ty) : (nm f)%:E = 'N[mu]_p[EFin \o f]%E. Proof. -rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnormr_ge0//=. +rewrite /nm fineK// fin_numElt (lt_le_trans ltNy0) ?Lnorm_ge0//=. exact: lfuny. Qed. @@ -913,8 +919,10 @@ HB.instance Definition _ := Lemma fine_Lnormr_eq0 (f : ty) : nm f = 0 -> f = 0 %[ae mu]. Proof. move=> /eqP; rewrite -eqe => /eqP. -rewrite finite_norm_fine => /Lnormr_eq0_eq0. -by apply; rewrite ?(lt_le_trans _ p1). +rewrite finite_norm_fine => /Lnorm_eq0_eq0. +have /measurable_EFinP : measurable_fun setT f by []. +move=> /[swap] /[apply] => /(_ (lt_le_trans lte01 p1)). +by apply: filterS => x /(_ I) []. Qed. End Lspace_norm. @@ -991,7 +999,7 @@ apply/andP; split. rewrite !inE/= /finite_norm. apply: le_lt_trans. by apply: (@hoelder _ _ _ _ _ _ 2 2) => //; rewrite [RHS]splitr !div1r. -rewrite lte_mul_pinfty// ?ge0_fin_numE ?Lnormr_ge0//. +rewrite lte_mul_pinfty// ?ge0_fin_numE ?Lnorm_ge0//. by move: l2f; rewrite inE => /andP[_]; rewrite inE/=. by move: l2g; rewrite inE => /andP[_]; rewrite inE/=. Qed. From 491aa52e1d79d5ae9f15f3c6df297738539c493a Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 1 May 2025 21:23:03 +0900 Subject: [PATCH 34/73] oppr_Lnorm not needed (?) --- CHANGELOG_UNRELEASED.md | 10 ++++----- theories/hoelder.v | 47 ++++++++++++++++++----------------------- 2 files changed, 25 insertions(+), 32 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index a46eccd8ec..15fe5b7611 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -75,7 +75,7 @@ + lemma `ae_eq_mul2l` - in `hoelder.v` - + lemmas `Lnorm0`, `oppr_Lnorm`, `Lnorm_cst1` + + lemmas `Lnorm0`, `Lnorm_cst1` + definition `conjugate` + lemma `conjugateE` + lemmas `lerB_DLnorm`, `lerB_LnormD`, `eminkowski` @@ -112,11 +112,6 @@ - in `simple_functions.v`: + lemma `mfunMn` -- in `measurable_realfun.v`: - + lemmas `ereal_inf_seq`, `ereal_sup_seq`, - `ereal_sup_cst`, `ereal_inf_cst`, `ereal_sup_pZl`, - `ereal_supZl`, `ereal_inf_pZl`, `ereal_infZl` - - in `measure.v`: + lemmas `seqDU_measurable`, `measure_gt0` + notation `\forall x \ae mu , P` @@ -237,6 +232,9 @@ + notations `measurable_fun_id`, `measurable_fun_cst`, `measurable_fun_comp` (deprecated since 0.6.3) + notation `measurable_funT_comp` (deprecated since 0.6.3) +- in `hoelder.v`: + + lemma `oppr_Lnorm` + ### Infrastructure ### Misc diff --git a/theories/hoelder.v b/theories/hoelder.v index 11f6ddf7a5..b33f8162e8 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -118,7 +118,7 @@ rewrite unlock /Lnorm NfE; case: p => /= [r|//|//]. by under eq_integral => x _ do rewrite abseN. Qed. -Lemma Lnorm_cst1 r : ('N_r%:E[cst 1] = (mu setT)`^(r^-1)). +Lemma Lnorm_cst1 r : 'N_r%:E[cst 1] = mu [set: T] `^ (r^-1). Proof. rewrite unlock /Lnorm; under eq_integral do rewrite /= normr1 powR1. by rewrite integral_cst// mul1e. @@ -143,8 +143,7 @@ case: p => [r||//]. have {H} : \int[mu]_x `| `|f x| `^ r | = 0%R. under eq_integral. move=> x _. - rewrite gee0_abs; last first. - by rewrite poweR_ge0. + rewrite gee0_abs; last by rewrite poweR_ge0. over. exact: H. have mp : measurable_fun [set: T] (fun x : T => `|f x| `^ r). @@ -157,30 +156,16 @@ case: p => [r||//]. by rewrite abse_eq0 => /eqP. - case: ifPn => [mu0 _|]. move=> /abs_sup_eq0_ae_eq/=. - apply: filterS => x/= /(_ I) /eqP + _. - by move=> /eqP. + by apply: filterS => x/= /(_ I) /eqP + _ => /eqP. rewrite ltNge => /negbNE mu0 _ _. suffices mueq0: mu setT = 0 by exact: ae_eq0. by apply/eqP; rewrite eq_le mu0/=. Qed. -End Lnorm_properties. - -Section Lnorm_properties. -Context d {T : measurableType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Local Open Scope ereal_scope. -Implicit Types (p : \bar R) (f g : T -> R) (r : R). - -Local Notation "'N_ p [ f ]" := (Lnorm mu p (EFin \o f)). - Lemma powR_Lnorm f r : r != 0%R -> - 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r)%:E. + 'N_r%:E[f] `^ r = \int[mu]_x `| f x | `^ r. Proof. by move=> r0; rewrite poweR_Lnorm. Qed. -Lemma oppr_Lnorm f p : 'N_p[\- f]%R = 'N_p[f]. -Proof. by rewrite -[RHS]oppe_Lnorm. Qed. - End Lnorm_properties. #[global] @@ -523,7 +508,9 @@ under eq_integral do rewrite EFinD. rewrite ge0_integralD//; last 2 first. - exact/measurable_EFinP/measurableT_comp_powR/measurableT_comp. - exact/measurable_EFinP/measurableT_comp_powR/measurableT_comp. -by rewrite lte_add_pinfty// -powR_Lnorm ?(gt_eqF (lt_trans _ p1))// poweR_lty. +by rewrite lte_add_pinfty//; + under eq_integral do rewrite -poweR_EFin -abse_EFin; + rewrite -powR_Lnorm// poweR_lty. Qed. Lemma minkowski_EFin f g p : @@ -553,7 +540,10 @@ suff : 'N_p%:E[(f \+ g)%R] `^ p <= ('N_p%:E[f] + 'N_p%:E[g]) * by rewrite fineK// 1?muleC// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. have p0 : (0 < p)%R by exact: (lt_trans _ p1). rewrite powR_Lnorm ?gt_eqF//. -under eq_integral => x _ do rewrite -mulr_powRB1//. +under eq_integral. + move=> x _. + rewrite abse_EFin poweR_EFin -mulr_powRB1//. + over. apply: (@le_trans _ _ (\int[mu]_x ((`|f x| + `|g x|) * `|f x + g x| `^ (p - 1))%:E)). rewrite ge0_le_integral//. @@ -575,7 +565,9 @@ rewrite ge0_integralD//; last 2 first. rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * (\int[mu]_x (`|f x + g x| `^ p)%:E) `^ `1-(p^-1)). rewrite muleDl; last 2 first. - - rewrite fin_num_poweR// -powR_Lnorm ?gt_eqF// fin_num_poweR//. + - rewrite fin_num_poweR//. + under eq_integral do rewrite -poweR_EFin -abse_EFin. + rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR//. by rewrite ge0_fin_numE ?Lnorm_ge0. - by rewrite ge0_adde_def// inE Lnorm_ge0. apply: leeD. @@ -613,7 +605,8 @@ rewrite poweRD; last by rewrite poweRD_defE gt_eqF ?implyFb// subr_gt0 invf_lt1. rewrite poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. congr (_ * _); rewrite poweRN. - by rewrite unlock fine_poweR. -- by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. +- under eq_integral do rewrite -poweR_EFin -abse_EFin. + by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. Qed. Lemma lerB_DLnorm f g p : @@ -625,7 +618,8 @@ rewrite (_ : f = ((f \+ g) \+ (-%R \o g))%R); last first. by apply: funext => x /=; rewrite -addrA subrr addr0. rewrite [X in _ <= 'N__[X] + _](_ : _ = (f \+ g)%R); last first. by apply: funext => x /=; rewrite -addrA [X in _ + _ + X]addrC subrr addr0. -rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last by rewrite oppr_Lnorm. +rewrite (_ : 'N__[g] = 'N_p%:E[-%R \o g]); last first. + by rewrite (_ : _ \o _ = \- (EFin \o g))// oppe_Lnorm. by apply: minkowski_EFin => //; [exact: measurable_funD|exact: measurableT_comp]. Qed. @@ -812,7 +806,8 @@ Proof. exact: valP. Qed. Lemma lfun_oppr_closed : oppr_closed lfun. Proof. move=> f /andP[mf /[!inE] lf]. -by rewrite rpredN/= mf/= inE/= /finite_norm oppr_Lnorm. +rewrite rpredN/= mf/= inE/= /finite_norm. +by rewrite (_ : _ \o _ = \- (EFin \o f))%E// oppe_Lnorm. Qed. HB.instance Definition _ := GRing.isOppClosed.Build _ lfun @@ -899,7 +894,7 @@ Lemma ler_LnormD (f g : ty) : nm (f + g) <= nm f + nm g. Proof. by rewrite -lee_fin EFinD !finite_norm_fine eminkowski. Qed. Lemma LnormrN (f : ty) : nm (\-f) = nm f. -Proof. by rewrite /nm oppr_Lnorm. Qed. +Proof. by rewrite /nm (_ : _ \o _ = \- (EFin \o f))%E// oppe_Lnorm. Qed. Lemma Lnormr_natmul (f : ty) k : nm (f *+ k) = nm f *+ k. Proof. From 03811d88d7bf90320712466e387f0a08ef312422 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Sun, 23 Mar 2025 17:50:13 +0100 Subject: [PATCH 35/73] interval instances - Improve interval instance for succn - Refine interval instances for natmul and intmul - Refine interval instance for exprn - Generalize lemmas exprz_ge0 and exprz_gt0 - Add interval instance for exprz - Add interval instance for factorial - Add lemma expR_le1 - Add interval instance for expR - Add interval instance for powR - Add interval instance for indic - Add interval instances for sin/cos --- classical/mathcomp_extra.v | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index 6245db399c..815f8ab8ca 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -260,6 +260,10 @@ Proof. by case: n => n; rewrite ?invr_ge0 exprn_ge0. Qed. Lemma exprz_gt0 [R : numDomainType] n (x : R) (hx : 0 < x) : (0 < x ^ n). Proof. by case: n => n; rewrite ?invr_gt0 exprn_gt0. Qed. +(**********************) +(* not yet backported *) +(**********************) + Section num_trunc_floor_ceil. Context {R : archiNumDomainType}. Implicit Type x : R. From 02b0f2abe0d36fa7c8f8af274f4e1e1bafefa788 Mon Sep 17 00:00:00 2001 From: affeldt-aist <33154536+affeldt-aist@users.noreply.github.com> Date: Sun, 16 Mar 2025 21:44:22 +0900 Subject: [PATCH 36/73] expectation of product - use bool instead of I_2 - complete thm 2.13 fixes #1527 (#1528) derive lemmas for shift (#1529) --- CHANGELOG_UNRELEASED.md | 248 ++++++++++++++++++++++++++++++++++ theories/Make | 1 + theories/measurable_realfun.v | 6 + theories/measure.v | 73 +++++++++- theories/numfun.v | 165 +++++++++++++++++++++- theories/probability.v | 20 ++- 6 files changed, 507 insertions(+), 6 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 15fe5b7611..f069f2182d 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -39,6 +39,138 @@ - in `realfun.v`: + lemma `cvge_ninftyP` +### Renamed + +- in `kernel.v`: + + `isFiniteTransition` -> `isFiniteTransitionKernel` + +### Generalized + +- file `Rstruct.v` + + lemma `Pos_to_natE` (from `mathcomp_extra.v`) + + lemmas `RabsE`, `RdistE`, `sum_f_R0E`, `factE` + +- new file `internal_Eqdep_dec.v` (don't use, internal, to be removed) + +- file `constructive_ereal.v`: + + definition `iter_mule` + + lemma `prodEFin` + +- file `exp.v`: + + lemma `expR_sum` + +- file `lebesgue_integral.v`: + + lemma `measurable_fun_le` + +- file `mathcomp_extra.v`: + + lemma `mulr_funEcomp` + +- in `numfun.v`: + + defintions `funrpos`, `funrneg` with notations `^\+` and `^\-` + + lemmas `funrpos_ge0`, `funrneg_ge0`, `funrposN`, `funrnegN`, `ge0_funrposE`, + `ge0_funrnegE`, `le0_funrposE`, `le0_funrnegE`, `ge0_funrposM`, `ge0_funrnegM`, + `le0_funrposM`, `le0_funrnegM`, `funr_normr`, `funrposneg`, `funrD_Dpos`, + `funrD_posD`, `funrpos_le`, `funrneg_le` + + lemmas `funerpos`, `funerneg` + +- in `measure.v`: + + lemma `preimage_class_comp` + + defintions `preimage_display`, `g_sigma_algebra_preimageType`, `g_sigma_algebra_preimage`, + notations `.-preimage`, `.-preimage.-measurable` + +- in `measurable_realfun.v`: + + lemmas `measurable_funrpos`, `measurable_funrneg` + +- new file `independence.v`: + + lemma `expectationM_ge0` + + definition `independent_events` + + definition `mutual_independence` + + definition `independent_RVs` + + definition `independent_RVs2` + + lemmas `g_sigma_algebra_preimage_comp`, `g_sigma_algebra_preimage_funrpos`, + `g_sigma_algebra_preimage_funrneg` + + lemmas `independent_RVs2_comp`, `independent_RVs_comp`, `independent_RVs_scale`, + `independent_RVs2_funrposneg`, + `independent_RVs2_funrnegpos`, `independent_RVs2_funrnegneg`, + `independent_RVs2_funrpospos` + + lemma `expectationM_ge0`, `integrable_expectationM`, `independent_integrableM`, + ` expectation_mul` + +- in `trigo.v`: + + lemma `integral0oo_atan` + +- in `measure.v`: + + lemmas `preimage_set_system0`, `preimage_set_systemU`, `preimage_set_system_comp` + + lemma `preimage_set_system_id` + +- in `Rstruct_topology.v`: + + lemma `RexpE` + +- in `derive.v`: + + lemmas `derive_shift`, `is_derive_shift` + +- in `interval_inference.v`: + + definitions `IntItv.exprz`, `Instances.natmul_itv` + + lemmas `Instances.num_spec_exprz`, `Instances.nat_spec_factorial` + + canonical instance `Instances.exprz_inum`, + `Instances.factorial_inum` + +- in `mathcomp_extra.v`: + + lemmas `exprz_ge0` and `exprz_gt0` + +- in `exp.v` + + lemmas `expR_le1`, `num_spec_expR`, `num_spec_powR` + + definitions `expR_itv_boundl`, `expR_itv_boundr`, `expR_itv`, + `powR_itv` + + canonical instance `expR_inum`, `powR_inum` + +- in `numfun.v`: + + lemma `num_spec_indic` + + canonical instance `indic_inum` + +- in `trigo.v`: + + lemmas `num_spec_sin`, `num_spec_cos` + + canonical instances `sin_inum`, `cos_inum` + +- in `mathcomp_extra.v`: + + lemmas `intrN`, `real_floor_itv`, `real_ge_floor`, `real_ceil_itv` +- in `lebesgue_integral.v`: + + lemma `dominated_cvg` (was previous `Local`) + +- in `ftc.v`: + + lemma `continuity_under_integral` + +- in `set_interval.v`: + + lemma `subset_itv` + +- in `mathcomp_extra.v`: + + lemmas `truncn_le`, `real_truncnS_gt`, `truncn_ge_nat`, + `truncn_gt_nat`, `truncn_lt_nat`, `real_truncn_le_nat`, + `truncn_eq`, `le_truncn`, `real_floorD1_gt`, + `real_floor_ge_int_tmp`, `real_floor_ge_int`, `real_floor_lt_int`, + `le_floor`, `real_floor_eq`, `real_floor_ge0`, `floor_lt0`, + `real_floor_le0`, `floor_gt0`, `floor_neq0`, + `real_ceil_le_int_tmp`, `real_ceil_le_int`, `real_ceil_gt_int`, + `real_ceil_eq`, `le_ceil_tmp`, `real_ceil_ge0`, `ceil_lt0`, + `real_ceil_le0`, `ceil_gt0`, `ceil_neq0`, `truncS_gt`, + `truncn_le_nat`, `floorD1_gt`, `floor_ge_int_tmp`, `floor_lt_int`, + `floor_eq`, `floor_ge0`, `floor_le0`, `ceil_le_int`, + `ceil_le_int_tmp`, `ceil_gt_int`, `ceil_eq`, `ceil_ge0`, + `ceil_le0`, `natr_int` + +- new directory `lebesgue_integral_theory` with new files: + + `simple_functions.v` + + `lebesgue_integral_definition.v` + + `lebesgue_integral_approximation.v` + + `lebesgue_integral_monotone_convergence.v` + + `lebesgue_integral_nonneg.v` + + `lebesgue_integrable.v` + + `lebesgue_integral_dominated_convergence.v` + + `lebesgue_integral_under.v` + + `lebesgue_Rintegral.v` + + `lebesgue_integral_fubini.v` + + `lebesgue_integral_differentiation.v` + + `lebesgue_integral.v` - in `boolp.v`: + lemmas `orW`, `or3W`, `or4W` @@ -146,6 +278,8 @@ + lemmas `poweR_Lnorm`, `oppe_Lnorm` - in `probability.v`: + lemma `lfun1_expectation_lty` +- in `derive.v`: + + lemmas `derive_shift`, `is_derive_shift` - in `hoelder.v`: + lemmas `Lnorm_eq0_eq0` @@ -177,6 +311,48 @@ + `emeasurable_fun_neq` -> `measurable_neqe` - file `lebesgue_integral_approximation.v` -> `measurable_fun_approximation.v` +- in `mathcomp_extra.v` + + `comparable_min_le_min` -> `comparable_le_min2` + + `comparable_max_le_max` -> `comparable_le_max2` + + `min_le_min` -> `le_min2` + + `max_le_max` -> `le_max2` + + `real_sqrtC` -> `sqrtC_real` +- in `measure.v` + + `preimage_class` -> `preimage_set_system` + + `image_class` -> `image_set_system` + + `preimage_classes` -> `g_sigma_preimageU` + + `preimage_class_measurable_fun` -> `preimage_set_system_measurable_fun` + + `sigma_algebra_preimage_class` -> `sigma_algebra_preimage` + + `sigma_algebra_image_class` -> `sigma_algebra_image` + + `sigma_algebra_preimage_classE` -> `g_sigma_preimageE` + + `preimage_classes_comp` -> `g_sigma_preimageU_comp` + +### Renamed + +- in `lebesgue_measure.v`: + + `measurable_fun_indic` -> `measurable_indic` + + `emeasurable_fun_sum` -> `emeasurable_sum` + + `emeasurable_fun_fsum` -> `emeasurable_fsum` + + `ge0_emeasurable_fun_sum` -> `ge0_emeasurable_sum` +- in `probability.v`: + + `expectationM` -> `expectationZl` + +- in `classical_sets.v`: + + `preimage_itv_o_infty` -> `preimage_itvoy` + + `preimage_itv_c_infty` -> `preimage_itvcy` + + `preimage_itv_infty_o` -> `preimage_itvNyo` + + `preimage_itv_infty_c` -> `preimage_itvNyc` + +- in `constructive_ereal.v`: + + `maxeMr` -> `maxe_pMr` + + `maxeMl` -> `maxe_pMl` + + `mineMr` -> `mine_pMr` + + `mineMl` -> `mine_pMl` + +- in `probability.v`: + + `integral_distribution` -> `ge0_integral_distribution` + +- file `homotopy_theory/path.v` -> `homotopy_theory/continuous_path.v` - in `ereal.v`: + `ereal_sup_le` -> `ereal_sup_ge` @@ -212,6 +388,78 @@ - in `functions.v`: + definitions `fct_zmodMixin`, `fct_ringMixin` (was only used in an `HB.instance`) +- file `mathcomp_extra.v` + + lemma `Pos_to_natE` (moved to `Rstruct.v`) + + lemma `deg_le2_ge0` (available as `deg_le2_poly_ge0` in `ssrnum.v` + since MathComp 2.1.0) + + definitions `monotonous`, `boxed`, `onem`, `inv_fun`, + `bound_side`, `swap`, `prodA`, `prodAr`, `map_pair`, `sigT_fun` + (moved to new file `unstable.v` that shouldn't be used outside of + Analysis) + + notations `` `1 - r ``, `f \^-1` (moved to new file `unstable.v` + that shouldn't be used outside of Analysis) + + lemmas `dependent_choice_Type`, `maxr_absE`, `minr_absE`, + `le_bigmax_seq`, `bigmax_sup_seq`, `leq_ltn_expn`, `last_filterP`, + `path_lt_filter0`, `path_lt_filterT`, `path_lt_head`, + `path_lt_last_filter`, `path_lt_le_last`, `sumr_le0`, + `fset_nat_maximum`, `image_nat_maximum`, `card_fset_sum1`, + `onem0`, `onem1`, `onemK`, `add_onemK`, `onem_gt0`, `onem_ge0`, + `onem_le1`, `onem_lt1`, `onemX_ge0`, `onemX_lt1`, `onemD`, + `onemMr`, `onemM`, `onemV`, `lez_abs2`, `ler_gtP`, `ler_ltP`, + `real_ltr_distlC`, `prodAK`, `prodArK`, `swapK`, `lt_min_lt`, + `intrD1`, `intr1D`, `floor_lt_int`, `floor_ge0`, `floor_le0`, + `floor_lt0`, `floor_eq`, `floor_neq0`, `ceil_gt_int`, `ceil_ge0`, + `ceil_gt0`, `ceil_le0`, `abs_ceil_ge`, `nat_int`, `bij_forall`, + `and_prop_in`, `mem_inc_segment`, `mem_dec_segment`, + `partition_disjoint_bigfcup`, `partition_disjoint_bigfcup`, + `prodr_ile1`, `size_filter_gt0`, `ltr_sum`, `ltr_sum_nat` (moved + to new file `unstable.v` that shouldn't be used outside of + Analysis) + +- in `reals.v`: + + lemmas `floor_le`, `le_floor` (deprecated since 1.3.0) + +- file `lebesgue_integral.v` (split in several files in the directory + `lebesgue_integral_theory`) + +- in `classical_sets.v`: + + notations `setvI`, `setIv`, `bigcup_set`, `bigcup_set_cond`, `bigcap_set`, + `bigcap_set_cond` +- in `sequences.v`: + + notations `nneseries_pred0`, `eq_nneseries`, `nneseries0`, + `ereal_cvgPpinfty`, `ereal_cvgPninfty` (were deprecated since 0.6.0) +- in `topology_structure.v`: + + lemma `closureC` + +- in file `lebesgue_integral.v`: + + lemma `approximation` + +### Removed + +- in `lebesgue_integral.v`: + + definition `cst_mfun` + + lemma `mfun_cst` + +- in `cardinality.v`: + + lemma `cst_fimfun_subproof` + +- in `lebesgue_integral.v`: + + lemma `cst_mfun_subproof` (use lemma `measurable_cst` instead) + + lemma `cst_nnfun_subproof` (turned into a `Let`) + + lemma `indic_mfun_subproof` (use lemma `measurable_fun_indic` instead) + +- in `lebesgue_integral.v`: + + lemma `measurable_indic` (was uselessly specializing `measurable_fun_indic` (now `measurable_indic`) from `lebesgue_measure.v`) + + notation `measurable_fun_indic` (deprecation since 0.6.3) +- in `constructive_ereal.v` + + notation `lee_opp` (deprecated since 0.6.5) + + notation `lte_opp` (deprecated since 0.6.5) +- in `measure.v`: + + `dynkin_setI_bigsetI` (use `big_ind` instead) + +- in `lebesgue_measurable.v`: + + notation `measurable_fun_power_pos` (deprecated since 0.6.3) + + notation `measurable_power_pos` (deprecated since 0.6.4) - in `measure.v`: + definition `almost_everywhere_notation` diff --git a/theories/Make b/theories/Make index 0f0d82304b..0e912a2290 100644 --- a/theories/Make +++ b/theories/Make @@ -78,6 +78,7 @@ lebesgue_integral_theory/lebesgue_integral.v ftc.v hoelder.v probability.v +independence.v lebesgue_stieltjes_measure.v convex.v charge.v diff --git a/theories/measurable_realfun.v b/theories/measurable_realfun.v index 1aad9e228d..67ea101aaa 100644 --- a/theories/measurable_realfun.v +++ b/theories/measurable_realfun.v @@ -1030,6 +1030,12 @@ by move=> mf mg mD; move: (mD); apply: measurable_fun_if => //; [exact: measurable_fun_ltr|exact: measurable_funS mg|exact: measurable_funS mf]. Qed. +Lemma measurable_funrpos D f : measurable_fun D f -> measurable_fun D f^\+. +Proof. by move=> mf; exact: measurable_maxr. Qed. + +Lemma measurable_funrneg D f : measurable_fun D f -> measurable_fun D f^\-. +Proof. by move=> mf; apply: measurable_maxr => //; exact: measurableT_comp. Qed. + Lemma measurable_minr D f g : measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \min g). Proof. diff --git a/theories/measure.v b/theories/measure.v index dddb4f030e..67343acabd 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -66,6 +66,11 @@ From mathcomp Require Import sequences esum numfun. (* G.-sigma.-measurable A == A is measurable for the sigma-algebra <> *) (* g_sigma_algebraType G == the measurableType corresponding to <> *) (* This is an HB alias. *) +(* g_sigma_algebra_preimage f == sigma-algebra generated by the function f *) +(* g_sigma_algebra_preimageType f == the measurableType corresponding to *) +(* g_sigma_algebra_preimage f *) +(* This is an HB alias. *) +(* f.-preimage.-measurable A == A measurable for g_sigma_algebra_preimage f *) (* mu .-cara.-measurable == sigma-algebra of Caratheodory measurable sets *) (* ``` *) (* *) @@ -293,6 +298,9 @@ Reserved Notation "'\d_' a" (at level 8, a at level 2, format "'\d_' a"). Reserved Notation "G .-sigma" (at level 1, format "G .-sigma"). Reserved Notation "G .-sigma.-measurable" (at level 2, format "G .-sigma.-measurable"). +Reserved Notation "f .-preimage" (at level 1, format "f .-preimage"). +Reserved Notation "f .-preimage.-measurable" + (at level 2, format "f .-preimage.-measurable"). Reserved Notation "d .-ring" (at level 1, format "d .-ring"). Reserved Notation "d .-ring.-measurable" (at level 2, format "d .-ring.-measurable"). @@ -1732,6 +1740,17 @@ 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 preimage_set_system_compS (aT : Type) + d (rT : measurableType d) d' (T : sigmaRingType d') + (g : rT -> T) (f : aT -> rT) (D : set aT) : + measurable_fun setT g -> + preimage_set_system D (g \o f) measurable `<=` + preimage_set_system D f measurable. +Proof. +move=> mg A; rewrite /preimage_set_system => -[B GB]; exists (g @^-1` B) => //. +by rewrite -[X in measurable X]setTI; exact: mg. +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) : @@ -1830,6 +1849,58 @@ 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). +Definition preimage_display {T T'} : (T -> T') -> measure_display. +Proof. exact. Qed. + +Definition g_sigma_algebra_preimageType d' (T : pointedType) + (T' : measurableType d') (f : T -> T') : Type := T. + +Definition g_sigma_algebra_preimage d' (T : pointedType) + (T' : measurableType d') (f : T -> T') := + preimage_set_system setT f (@measurable _ T'). + +Section preimage_generated_sigma_algebra. +Context {d'} (T : pointedType) (T' : measurableType d'). +Variable f : T -> T'. + +Let preimage_set0 : g_sigma_algebra_preimage f set0. +Proof. +rewrite /g_sigma_algebra_preimage /preimage_class/=. +by exists set0 => //; rewrite preimage_set0 setI0. +Qed. + +Let preimage_setC A : + g_sigma_algebra_preimage f A -> g_sigma_algebra_preimage f (~` A). +Proof. +rewrite /g_sigma_algebra_preimage /preimage_class/= => -[B mB] <-{A}. +by exists (~` B); [exact: measurableC|rewrite !setTI preimage_setC]. +Qed. + +Let preimage_bigcup (F : (set T)^nat) : + (forall i, g_sigma_algebra_preimage f (F i)) -> + g_sigma_algebra_preimage f (\bigcup_i (F i)). +Proof. +move=> mF; rewrite /g_sigma_algebra_preimage /preimage_class/=. +pose g := fun i => sval (cid2 (mF i)). +pose mg := fun i => svalP (cid2 (mF i)). +exists (\bigcup_i g i). + by apply: bigcup_measurable => k; case: (mg k). +rewrite setTI /g preimage_bigcup; apply: eq_bigcupr => k _. +by case: (mg k) => _; rewrite setTI. +Qed. + +HB.instance Definition _ := Pointed.on (g_sigma_algebra_preimageType f). + +HB.instance Definition _ := @isMeasurable.Build (preimage_display f) + (g_sigma_algebra_preimageType f) (g_sigma_algebra_preimage f) + preimage_set0 preimage_setC preimage_bigcup. + +End preimage_generated_sigma_algebra. + +Notation "f .-preimage" := (preimage_display f) : measure_display_scope. +Notation "f .-preimage.-measurable" := + (measurable : set (set (g_sigma_algebra_preimageType f))) : classical_set_scope. + Local Open Scope ereal_scope. Definition subset_sigma_subadditive {T} {R : numFieldType} @@ -4212,7 +4283,7 @@ Lemma ae_eq_comp2 U V (j : T -> U -> V) f g : 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^\-. + (ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-)%E. Proof. split=> [fg|[pfg nfg]]. by split; near=> x => Dx; rewrite !(funeposE,funenegE) (near fg). diff --git a/theories/numfun.v b/theories/numfun.v index c3083f2448..d75163bf45 100644 --- a/theories/numfun.v +++ b/theories/numfun.v @@ -15,12 +15,15 @@ From mathcomp Require Import sequences function_spaces. (* ``` *) (* {nnfun T >-> R} == type of non-negative functions *) (* f ^\+ == the function formed by the non-negative outputs *) -(* of f (from a type to the type of extended real *) -(* numbers) and 0 otherwise *) -(* rendered as f ⁺ with company-coq (U+207A) *) +(* of f and 0 otherwise *) +(* The codomain of f is the real numbers in scope *) +(* ring_scope and the extended real numbers in scope *) +(* ereal_scope. *) +(* It is rendered as f ⁺ with company-coq (U+207A). *) (* f ^\- == the function formed by the non-positive outputs *) (* of f and 0 o.w. *) -(* rendered as f ⁻ with company-coq (U+207B) *) +(* Similar to ^\+. *) +(* It is rendered as f ⁻ with company-coq (U+207B). *) (* \1_ A == indicator function 1_A *) (* ``` *) (* *) @@ -129,6 +132,149 @@ Proof. by apply/funext=> x; rewrite /patch/=; case: ifP; rewrite ?mule0. Qed. End erestrict_lemmas. +Section funrposneg. +Local Open Scope ring_scope. + +Definition funrpos T (R : realDomainType) (f : T -> R) := + fun x => maxr (f x) 0. +Definition funrneg T (R : realDomainType) (f : T -> R) := + fun x => maxr (- f x) 0. + +End funrposneg. + +Notation "f ^\+" := (funrpos f) : ring_scope. +Notation "f ^\-" := (funrneg f) : ring_scope. + +Section funrposneg_lemmas. +Local Open Scope ring_scope. +Variables (T : Type) (R : realDomainType) (D : set T). +Implicit Types (f g : T -> R) (r : R). + +Lemma funrpos_ge0 f x : 0 <= f^\+ x. +Proof. by rewrite /funrpos /= le_max lexx orbT. Qed. + +Lemma funrneg_ge0 f x : 0 <= f^\- x. +Proof. by rewrite /funrneg le_max lexx orbT. Qed. + +Lemma funrposN f : (\- f)^\+ = f^\-. Proof. exact/funext. Qed. + +Lemma funrnegN f : (\- f)^\- = f^\+. +Proof. by apply/funext => x; rewrite /funrneg opprK. Qed. + +(* TODO: the following lemmas require a pointed type and realDomainType does +not seem to be at this point + +Lemma funrpos_restrict f : (f \_ D)^\+ = (f^\+) \_ D. +Proof. +by apply/funext => x; rewrite /patch/_^\+; case: ifP; rewrite //= maxxx. +Qed. + +Lemma funrneg_restrict f : (f \_ D)^\- = (f^\-) \_ D. +Proof. +by apply/funext => x; rewrite /patch/_^\-; case: ifP; rewrite //= oppr0 maxxx. +Qed.*) + +Lemma ge0_funrposE f : (forall x, D x -> 0 <= f x) -> {in D, f^\+ =1 f}. +Proof. by move=> f0 x; rewrite inE => Dx; apply/max_idPl/f0. Qed. + +Lemma ge0_funrnegE f : (forall x, D x -> 0 <= f x) -> {in D, f^\- =1 cst 0}. +Proof. +by move=> f0 x; rewrite inE => Dx; apply/max_idPr; rewrite lerNl oppr0 f0. +Qed. + +Lemma le0_funrposE f : (forall x, D x -> f x <= 0) -> {in D, f^\+ =1 cst 0}. +Proof. by move=> f0 x; rewrite inE => Dx; exact/max_idPr/f0. Qed. + +Lemma le0_funrnegE f : (forall x, D x -> f x <= 0) -> {in D, f^\- =1 \- f}. +Proof. +by move=> f0 x; rewrite inE => Dx; apply/max_idPl; rewrite lerNr oppr0 f0. +Qed. + +Lemma ge0_funrposM r f : (0 <= r)%R -> + (fun x => r * f x)^\+ = (fun x => r * (f^\+ x)). +Proof. by move=> ?; rewrite funeqE => x; rewrite /funrpos maxr_pMr// mulr0. Qed. + +Lemma ge0_funrnegM r f : (0 <= r)%R -> + (fun x => r * f x)^\- = (fun x => r * (f^\- x)). +Proof. +by move=> r0; rewrite funeqE => x; rewrite /funrneg -mulrN maxr_pMr// mulr0. +Qed. + +Lemma le0_funrposM r f : (r <= 0)%R -> + (fun x => r * f x)^\+ = (fun x => - r * (f^\- x)). +Proof. +move=> r0; rewrite -[in LHS](opprK r); under eq_fun do rewrite mulNr. +by rewrite funrposN ge0_funrnegM ?oppr_ge0. +Qed. + +Lemma le0_funrnegM r f : (r <= 0)%R -> + (fun x => r * f x)^\- = (fun x => - r * (f^\+ x)). +Proof. +move=> r0; rewrite -[in LHS](opprK r); under eq_fun do rewrite mulNr. +by rewrite funrnegN ge0_funrposM ?oppr_ge0. +Qed. + +Lemma funr_normr f : normr \o f = f^\+ \+ f^\-. +Proof. +rewrite funeqE => x /=; have [fx0|/ltW fx0] := leP (f x) 0. +- rewrite ler0_norm// /funrpos /funrneg. + move/max_idPr : (fx0) => ->; rewrite add0r. + by move: fx0; rewrite -{1}oppr0 lerNr => /max_idPl ->. +- rewrite ger0_norm// /funrpos /funrneg; move/max_idPl : (fx0) => ->. + by move: fx0; rewrite -{1}oppr0 lerNl => /max_idPr ->; rewrite addr0. +Qed. + +Lemma funrposneg f : f = (fun x => f^\+ x - f^\- x). +Proof. +rewrite funeqE => x; rewrite /funrpos /funrneg; have [|/ltW] := leP (f x) 0. + by rewrite -{1}oppr0 -lerNr => /max_idPl ->; rewrite opprK add0r. +by rewrite -{1}oppr0 -lerNl => /max_idPr ->; rewrite subr0. +Qed. + +Lemma funrD_Dpos f g : f \+ g = (f \+ g)^\+ \- (f \+ g)^\-. +Proof. +apply/funext => x; rewrite /funrpos /funrneg/=; have [|/ltW] := lerP 0 (f x + g x). +- by rewrite -{1}oppr0 -lerNl => /max_idPr ->; rewrite subr0. +- by rewrite -{1}oppr0 -lerNr => /max_idPl ->; rewrite opprK add0r. +Qed. + +Lemma funrD_posD f g : f \+ g = (f^\+ \+ g^\+) \- (f^\- \+ g^\-). +Proof. +apply/funext => x; rewrite /funrpos /funrneg/=. +have [|fx0] := lerP 0 (f x); last rewrite add0r. +- rewrite -{1}oppr0 lerNl => /max_idPr ->; have [|/ltW] := lerP 0 (g x). + by rewrite -{1}oppr0 lerNl => /max_idPr ->; rewrite addr0 subr0. + by rewrite -{1}oppr0 -lerNr => /max_idPl ->; rewrite addr0 sub0r opprK. +- move/ltW : (fx0); rewrite -{1}oppr0 lerNr => /max_idPl ->. + have [|]/= := lerP 0 (g x); last rewrite add0r. + by rewrite -{1}oppr0 lerNl => /max_idPr ->; rewrite addr0 opprK addrC. + by rewrite -oppr0 ltrNr -{1}oppr0 => /ltW/max_idPl ->; rewrite opprD !opprK. +Qed. + +Lemma funrpos_le f g : + {in D, forall x, f x <= g x} -> {in D, forall x, f^\+ x <= g^\+ x}. +Proof. +move=> fg x Dx; rewrite /funrpos /maxr; case: ifPn => fx; case: ifPn => gx //. +- by rewrite leNgt. +- by move: fx; rewrite -leNgt => /(lt_le_trans gx); rewrite ltNge fg. +- exact: fg. +Qed. + +Lemma funrneg_le f g : + {in D, forall x, f x <= g x} -> {in D, forall x, g^\- x <= f^\- x}. +Proof. +move=> fg x Dx; rewrite /funrneg /maxr; case: ifPn => gx; case: ifPn => fx //. +- by rewrite leNgt. +- by move: gx; rewrite -leNgt => /(lt_le_trans fx); rewrite ltrN2 ltNge fg. +- by rewrite lerN2; exact: fg. +Qed. + +End funrposneg_lemmas. +#[global] +Hint Extern 0 (is_true (0%R <= _ ^\+ _)%R) => solve [apply: funrpos_ge0] : core. +#[global] +Hint Extern 0 (is_true (0%R <= _ ^\- _)%R) => solve [apply: funrneg_ge0] : core. + HB.lock Definition funepos T (R : realDomainType) (f : T -> \bar R) := fun x => maxe (f x) 0. @@ -294,6 +440,17 @@ Hint Extern 0 (is_true (0%R <= _ ^\+ _)%E) => solve [apply: funepos_ge0] : core. #[global] Hint Extern 0 (is_true (0%R <= _ ^\- _)%E) => solve [apply: funeneg_ge0] : core. +Section funrpos_funepos_lemmas. +Context {T : Type} {R : realDomainType}. + +Lemma funerpos (f : T -> R) : (EFin \o f)^\+%E = (EFin \o f^\+). +Proof. by apply/funext => x; rewrite funeposE /funrpos/= EFin_max. Qed. + +Lemma funerneg (f : T -> R) : (EFin \o f)^\-%E = (EFin \o f^\-). +Proof. by apply/funext => x; rewrite funenegE /funrneg/= EFin_max. Qed. + +End funrpos_funepos_lemmas. + Definition indic {T} {R : ringType} (A : set T) (x : T) : R := (x \in A)%:R. Reserved Notation "'\1_' A" (at level 8, A at level 2, format "'\1_' A") . Notation "'\1_' A" := (indic A) : ring_scope. diff --git a/theories/probability.v b/theories/probability.v index 0e00575f8c..b47427d91c 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -615,6 +615,24 @@ Qed. End variance. Notation "'V_ P [ X ]" := (variance P X). +(* TODO: move earlier *) +Section mfun_measurable_realType. +Context {d} {aT : measurableType d} {rT : realType}. + +HB.instance Definition _ (f : {mfun aT >-> rT}) := + @isMeasurableFun.Build d _ _ _ f^\+ + (measurable_funrpos (@measurable_funPT _ _ _ _ f)). + +HB.instance Definition _ (f : {mfun aT >-> rT}) := + @isMeasurableFun.Build d _ _ _ f^\- + (measurable_funrneg (@measurable_funPT _ _ _ _ f)). + +HB.instance Definition _ (f : {mfun aT >-> rT}) := + @isMeasurableFun.Build d _ _ _ (@normr _ _ \o f) + (measurableT_comp (@normr_measurable _ _) (@measurable_funPT _ _ _ _ f)). + +End mfun_measurable_realType. + Section markov_chebyshev_cantelli. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (P : probability T R). @@ -1422,7 +1440,7 @@ pose f_ := nnsfun_approx measurableT mf. transitivity (lim (\int[uniform_prob ab]_x (f_ n x)%:E @[n --> \oo])%E). rewrite -monotone_convergence//=. - apply: eq_integral => ? /[!inE] xD; apply/esym/cvg_lim => //=. - exact: cvg_nnsfun_approx. + exact/cvg_nnsfun_approx. - by move=> n; exact/measurable_EFinP/measurable_funTS. - by move=> n ? _; rewrite lee_fin. - by move=> ? _ ? ? mn; rewrite lee_fin; exact/lefP/nd_nnsfun_approx. From d4decf1919b46f81351c5087f2d18dfeb21ebf9b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 15 Mar 2025 01:56:49 +0900 Subject: [PATCH 37/73] remark 2.15 --- CHANGELOG_UNRELEASED.md | 34 ++++++++++------------------------ theories/Make | 1 - 2 files changed, 10 insertions(+), 25 deletions(-) diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index f069f2182d..a2ed0eec36 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -62,6 +62,16 @@ - file `lebesgue_integral.v`: + lemma `measurable_fun_le` +- in `trigo.v`: + + lemma `integral0oo_atan` + +- in `measure.v`: + + lemmas `preimage_set_system0`, `preimage_set_systemU`, `preimage_set_system_compS` + + lemma `preimage_set_system_id` + +- in `Rstruct_topology.v`: + + lemma `RexpE` + - file `mathcomp_extra.v`: + lemma `mulr_funEcomp` @@ -81,21 +91,6 @@ - in `measurable_realfun.v`: + lemmas `measurable_funrpos`, `measurable_funrneg` -- new file `independence.v`: - + lemma `expectationM_ge0` - + definition `independent_events` - + definition `mutual_independence` - + definition `independent_RVs` - + definition `independent_RVs2` - + lemmas `g_sigma_algebra_preimage_comp`, `g_sigma_algebra_preimage_funrpos`, - `g_sigma_algebra_preimage_funrneg` - + lemmas `independent_RVs2_comp`, `independent_RVs_comp`, `independent_RVs_scale`, - `independent_RVs2_funrposneg`, - `independent_RVs2_funrnegpos`, `independent_RVs2_funrnegneg`, - `independent_RVs2_funrpospos` - + lemma `expectationM_ge0`, `integrable_expectationM`, `independent_integrableM`, - ` expectation_mul` - - in `trigo.v`: + lemma `integral0oo_atan` @@ -317,15 +312,6 @@ + `min_le_min` -> `le_min2` + `max_le_max` -> `le_max2` + `real_sqrtC` -> `sqrtC_real` -- in `measure.v` - + `preimage_class` -> `preimage_set_system` - + `image_class` -> `image_set_system` - + `preimage_classes` -> `g_sigma_preimageU` - + `preimage_class_measurable_fun` -> `preimage_set_system_measurable_fun` - + `sigma_algebra_preimage_class` -> `sigma_algebra_preimage` - + `sigma_algebra_image_class` -> `sigma_algebra_image` - + `sigma_algebra_preimage_classE` -> `g_sigma_preimageE` - + `preimage_classes_comp` -> `g_sigma_preimageU_comp` ### Renamed diff --git a/theories/Make b/theories/Make index 0e912a2290..0f0d82304b 100644 --- a/theories/Make +++ b/theories/Make @@ -78,7 +78,6 @@ lebesgue_integral_theory/lebesgue_integral.v ftc.v hoelder.v probability.v -independence.v lebesgue_stieltjes_measure.v convex.v charge.v From c572e4e601c9487573fc359eb0ff161851a8d7ca Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 5 Nov 2024 11:35:42 +0900 Subject: [PATCH 38/73] a sampling theorem Co-authored-by: @affeldt-aist Co-authored-by: @t6s --- _CoqProject | 2 +- reals/Make | 1 - reals/signed.v | 1 + theories/Make | 1 + theories/probability.v | 359 +++++++++++++- theories/sampling.v | 1043 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 1391 insertions(+), 16 deletions(-) create mode 100644 theories/sampling.v diff --git a/_CoqProject b/_CoqProject index 4ce5662f31..a2b2d6530a 100644 --- a/_CoqProject +++ b/_CoqProject @@ -29,7 +29,6 @@ classical/filter.v reals/constructive_ereal.v reals/reals.v reals/real_interval.v -reals/signed.v reals/interval_inference.v reals/prodnormedzmodule.v reals/all_reals.v @@ -114,6 +113,7 @@ theories/lebesgue_integral_theory/lebesgue_integral.v theories/ftc.v theories/hoelder.v theories/probability.v +theories/sampling.v theories/convex.v theories/charge.v theories/kernel.v diff --git a/reals/Make b/reals/Make index f86bfb55db..f3b0b8fa33 100644 --- a/reals/Make +++ b/reals/Make @@ -10,7 +10,6 @@ constructive_ereal.v reals.v real_interval.v -signed.v interval_inference.v prodnormedzmodule.v all_reals.v diff --git a/reals/signed.v b/reals/signed.v index 6a4a59a144..b5429d00bc 100644 --- a/reals/signed.v +++ b/reals/signed.v @@ -126,6 +126,7 @@ Attributes deprecated(since="mathcomp-analysis 1.9.0", (* Canonical instances are also provided according to types, as a *) (* fallback when no known operator appears in the expression. Look to *) (* nat_snum below for an example on how to add your favorite type. *) +(* *) (******************************************************************************) Reserved Notation "{ 'compare' x0 & nz & cond }" diff --git a/theories/Make b/theories/Make index 0f0d82304b..61a9b5a52a 100644 --- a/theories/Make +++ b/theories/Make @@ -78,6 +78,7 @@ lebesgue_integral_theory/lebesgue_integral.v ftc.v hoelder.v probability.v +sampling.v lebesgue_stieltjes_measure.v convex.v charge.v diff --git a/theories/probability.v b/theories/probability.v index b47427d91c..02ef8a905e 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -93,6 +93,205 @@ Definition random_variable d d' (T : measurableType d) (T' : measurableType d') Notation "{ 'RV' P >-> T' }" := (@random_variable _ _ _ T' _ P) : form_scope. +Section move_to_somewhere. + +Lemma mulr_funEcomp (R : semiRingType) (T : Type) (x : R) (f : T -> R) : + x \o* f = *%R^~ x \o f. +Proof. by []. Qed. + +Lemma bounded_image (T : Type) (K : numFieldType) + (V : pseudoMetricNormedZmodType K) (E : T -> V) (A : set T) : + [bounded y | y in E @` A] = [bounded E x | x in A]. +Proof. +rewrite /bounded_near !nearE. +congr (+oo _); apply: funext=> M. +apply: propext; split => /=. + by move=> + x Ax => /(_ (E x)); apply; exists x. +by move=> H x [] y Ay <-; exact: H. +Qed. + +Lemma finite_bounded (K : realFieldType) (V : pseudoMetricNormedZmodType K) + (A : set V) : finite_set A -> bounded_set A. +Proof. +move=> fA. +exists (\big[Order.max/0]_(y <- fset_set A) normr y). +split=> //. + apply: (big_ind (fun x => x \is Num.real))=> //. + by move=> *; exact: max_real. +move=> x ltx v Av /=. +apply/ltW/(le_lt_trans _ ltx)/le_bigmax_seq=> //. +by rewrite in_fset_set// inE. +Qed. + +Arguments sub_countable [T U]. +Arguments card_le_finite [T U]. +(* naming inconsistency: there is also `sub_finite_set`: + sub_finite_set : + forall [T : Type] [A B : set T], A `<=` B -> finite_set B -> finite_set A *) + +Lemma countable_range_comp (T0 T1 T2 : Type) (f : T0 -> T1) (g : T1 -> T2) : + countable (range f) \/ countable (range g) -> countable (range (g \o f)). +Proof. +rewrite -(image_comp f g). +case. + move=> cf; apply: (sub_countable _ (range f))=> //. + exact: card_image_le. +move=> cg; apply: (sub_countable _ (range g))=> //. +exact/subset_card_le/image_subset. +Qed. + +Lemma finite_range_comp (T0 T1 T2 : Type) (f : T0 -> T1) (g : T1 -> T2) : + finite_set (range f) \/ finite_set (range g) -> finite_set (range (g \o f)). +Proof. +rewrite -(image_comp f g). +case. + move=> cf; apply: (card_le_finite _ (range f))=> //. + exact: card_image_le. +move=> cg; apply: (card_le_finite _ (range g))=> //. +exact/subset_card_le/image_subset. +Qed. + +(* generalizations with an additional predicate (m <= i)%N as in big_geq_mkord *) +Lemma lee_sum_fset_nat_geq (R : realDomainType) (f : sequence \bar R) + (F : {fset nat}) (m n : nat) (P : pred nat) : + (forall i : nat, P i -> (0%R <= f i)%E) -> + [set` F] `<=` `I_n -> + ((\sum_(i <- F | P i && (m <= i)%N) f i)%R + <= (\sum_(m <= i < n | P i) f i)%R)%E. +Proof. +move=> f0 Fn. +rewrite big_geq_mkord/= -(big_mkord (fun i => P i && (m <= i)%N)). +apply: lee_sum_fset_nat=> //. +by move=> ? /andP [] *; exact: f0. +Qed. +Arguments lee_sum_fset_nat_geq {R f} F m n P. + +Lemma lee_sum_fset_lim_geq (R : realType) (f : sequence \bar R) + (F : {fset nat}) m (P : pred nat) : + (forall i : nat, P i -> (0%R <= f i)%E) -> + ((\sum_(i <- F | P i && (m <= i)%N) f i)%R + <= \big[+%R/0%R]_(m <= i f0; pose n := (\max_(k <- F) k).+1. +rewrite (le_trans (lee_sum_fset_nat_geq F m n _ _ _))//; last first. + by apply: nneseries_lim_ge => // k _; exact: f0. +move=> k /= kF; rewrite /n big_seq_fsetE/=. +by rewrite -[k]/(val [`kF]%fset) ltnS leq_bigmax. +Qed. +Arguments lee_sum_fset_lim_geq {R f} F m P. + +Lemma nneseries_esum_geq (R : realType) (a : nat -> \bar R) m (P : pred nat) : + (forall n : nat, P n -> (0%R <= a n)%E) -> + \big[+%R/0]_(m <= i a0; apply/eqP; rewrite eq_le; apply/andP; split. + apply: lime_le. + by apply: is_cvg_nneseries_cond => n _; exact: a0. + apply: nearW=> n. + apply: ereal_sup_ubound; exists [set` [fset val i | i in 'I_n & P i && (m <= i)%N]%fset]. + split; first exact: finite_fset. + by move=> /= k /imfsetP[/= i]; rewrite inE => + ->. + rewrite fsbig_finite//= set_fsetK big_imfset/=; last first. + by move=> ? ? ? ? /val_inj. + by rewrite big_filter big_enum_cond/= big_geq_mkord. +apply: ub_ereal_sup => _ [/= F [finF PF] <-]. +rewrite fsbig_finite//= -(big_rmcond_in (fun i=> P i && (m <= i)%N))/=. + exact: lee_sum_fset_lim_geq. +by move=> k; rewrite in_fset_set// inE => /PF ->. +Qed. + +Lemma nneseriesID (R : realType) m (a P : pred nat) (f : nat -> \bar R): + (forall k : nat, P k -> (0%R <= f k)%E) -> + \big[+%R/0]_(m <= k nn. +rewrite nneseries_esum_geq//. +rewrite (esumID a)/=; last by move=> ? /andP [] *; exact: nn. +have->: [set x | P x && (m <= x)%N] `&` (fun x : nat => a x) = + [set x | (P x && a x) && (m <= x)%N]. + by apply: funext=> x /=; rewrite (propext (rwP andP)) andbAC. +have->: [set x | P x && (m <= x)%N] `&` ~` (fun x : nat => a x) = + [set x | (P x && ~~ a x) && (m <= x)%N]. + apply: funext=> x /=. + by rewrite (propext (rwP negP)) (propext (rwP andP)) andbAC. +by rewrite -!nneseries_esum_geq//; move=> ? /andP [] *; exact: nn. +Qed. + +(* TODO: this generalize subset_itv! *) +Lemma subset_itvW_bound (d : Order.disp_t) (T : porderType d) + (x y z u : itv_bound T) : + (x <= y)%O -> (z <= u)%O -> [set` Interval y z] `<=` [set` Interval x u]. +Proof. +move=> xy zu. +by apply: (@subset_trans _ [set` Interval x z]); + [exact: subset_itvr | exact: subset_itvl]. +Qed. + +Lemma gtr0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : + (forall x : R, x \in `]a, b[ -> derivable f x 1) -> + (forall x : R, x \in `]a, b[ -> 0 < 'D_1 f x) -> + {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> + {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x < y >-> x < y}}. +Proof. +move=> df dfgt0 cf x y + + xy. +rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. +have HMVT1: {within `[x, y], continuous f}%classic. + exact/(continuous_subspaceW _ cf)/subset_itvW_bound. +have zab z : z \in `]x, y[ -> z \in `]a, b[. + apply: subset_itvW_bound. + by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. + by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. +have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). + by move=> zxy; exact/derivableP/df/zab. +rewrite -subr_gt0. +have[z zxy ->]:= MVT xy HMVT0 HMVT1. +rewrite mulr_gt0// ?subr_gt0// dfgt0//. +exact: zab. +Qed. + +Lemma ger0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : + (forall x : R, x \in `]a, b[ -> derivable f x 1) -> + (forall x : R, x \in `]a, b[ -> 0 <= 'D_1 f x) -> + {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> + {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x <= y >-> x <= y}}. +Proof. +move=> df dfge0 cf x y + + xy. +rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. +have HMVT1: {within `[x, y], continuous f}%classic. + exact/(continuous_subspaceW _ cf)/subset_itvW_bound. +have zab z : z \in `]x, y[ -> z \in `]a, b[. + apply: subset_itvW_bound. + by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. + by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. +have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). + by move=> zxy; exact/derivableP/df/zab. +rewrite -subr_ge0. +move: (xy); rewrite le_eqVlt=> /orP [/eqP-> | xy']; first by rewrite subrr. +have[z zxy ->]:= MVT xy' HMVT0 HMVT1. +rewrite mulr_ge0// ?subr_ge0// dfge0//. +exact: zab. +Qed. + +Lemma memB_itv (R : numDomainType) (b0 b1 : bool) (x y z : R) : + (y - z \in Interval (BSide b0 x) (BSide b1 y)) = + (x + z \in Interval (BSide (~~ b1) x) (BSide (~~ b0) y)). +Proof. +rewrite !in_itv /= /Order.lteif !if_neg. +by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. +Qed. + +(* generalizes mem_1B_itvcc *) +Lemma memB_itv0 (R : numDomainType) (b0 b1 : bool) (x y : R) : + (y - x \in Interval (BSide b0 0) (BSide b1 y)) = + (x \in Interval (BSide (~~ b1) 0) (BSide (~~ b0) y)). +Proof. by rewrite memB_itv add0r. Qed. + +End move_to_somewhere. +Arguments countable_range_comp [T0 T1 T2]. +Arguments finite_range_comp [T0 T1 T2]. + Lemma notin_range_measure d d' (T : measurableType d) (T' : measurableType d') (R : realType) (P : {measure set T -> \bar R}) (X : T -> R) r : r \notin range X -> P (X @^-1` [set r]) = 0%E. @@ -153,6 +352,12 @@ Lemma integral_distribution (X : {RV P >-> T'}) (f : T' -> \bar R) : \int[distribution P X]_y f y = \int[P]_x (f \o X) x. Proof. by move=> mf intf; rewrite integral_pushforward. Qed. +Lemma probability_setC' A : d.-measurable A -> P A = 1 - P (~` A). +Proof. +move=> mA. rewrite -(@probability_setT _ _ _ P) -[in RHS](setTI (~` A)) -measureD ?setTD ?setCK//; first exact: measurableC. +by rewrite [ltLHS](@probability_setT _ _ _ P) ltry. +Qed. + End transfer_probability. Definition cdf d (T : measurableType d) (R : realType) (P : probability T R) @@ -320,10 +525,83 @@ rewrite !big_cons expectationD; last 2 first. by rewrite IHX//= => Xi XiX; rewrite intX// inE XiX orbT. Qed. +Lemma sum_RV_ge0 (X : seq {RV P >-> R}) x : + (forall Xi, Xi \in X -> 0 <= Xi x)%R -> + (0 <= (\sum_(Xi <- X) Xi) x)%R. +Proof. +elim: X => [|X0 X IHX] Xi_ge0; first by rewrite big_nil. +rewrite big_cons. +rewrite addr_ge0//=; first by rewrite Xi_ge0// in_cons eq_refl. +by rewrite IHX// => Xi XiX; rewrite Xi_ge0// in_cons XiX orbT. +Qed. + End expectation_lemmas. #[deprecated(since="mathcomp-analysis 1.8.0", note="renamed to `expectationZl`")] Notation expectationM := expectationZl (only parsing). + + + +(* Section product_lebesgue_measure. *) +(* Context {R : realType}. *) + +(* Definition p := [the sigma_finite_measure _ _ of *) +(* ([the sigma_finite_measure _ _ of (@lebesgue_measure R)] \x *) +(* [the sigma_finite_measure _ _ of (@lebesgue_measure R)])]%E. *) + +(* Fixpoint iter_mprod (n : nat) : {d & measurableType d} := *) +(* match n with *) +(* | 0%N => existT measurableType _ (salgebraType R.-ocitv.-measurable) *) +(* | n'.+1 => let t' := iter_mprod n' in *) +(* let a := existT measurableType _ (salgebraType R.-ocitv.-measurable) in *) +(* existT _ _ [the measurableType (projT1 a, projT1 t').-prod of *) +(* (projT2 a * projT2 t')%type] *) +(* end. *) + +(* Fixpoint measurable_of_typ (t : typ) : {d & measurableType d} := *) +(* match t with *) +(* | Unit => existT _ _ munit *) +(* | Bool => existT _ _ mbool *) +(* | Nat => existT _ _ (nat : measurableType _) *) +(* | Real => existT _ _ *) +(* [the measurableType _ of (@measurableTypeR R)] *) +(* end. *) + +(* Set Printing All. *) + +(* Fixpoint measurable_of_typ (d : nat) : {d & measurableType d} := *) +(* match d with *) +(* | O => existT _ _ (@lebesgue_measure R) *) +(* | d'.+1 => existT _ _ *) +(* [the measurableType (projT1 (@lebesgue_measure R), *) +(* projT1 (measurable_of_typ d')).-prod%mdisp of *) +(* ((@lebesgue_measure R) \x *) +(* projT2 (measurable_of_typ d'))%E] *) +(* end. *) + +(* Definition mtyp_disp t : measure_display := projT1 (measurable_of_typ t). *) + +(* Definition mtyp t : measurableType (mtyp_disp t) := *) +(* projT2 (measurable_of_typ t). *) + +(* Definition measurable_of_seq (l : seq typ) : {d & measurableType d} := *) +(* iter_mprod (map measurable_of_typ l). *) + + +(* Fixpoint leb_meas (d : nat) := *) +(* match d with *) +(* | 0%N => @lebesgue_measure R *) +(* | d'.+1 => *) +(* ((leb_meas d') \x (@lebesgue_measure R))%E *) +(* end. *) + + + + + +(* End product_lebesgue_measure. *) + + HB.lock Definition covariance {d} {T : measurableType d} {R : realType} (P : probability T R) (X Y : T -> R) := 'E_P[(X \- cst (fine 'E_P[X])) * (Y \- cst (fine 'E_P[Y]))]%E. @@ -633,6 +911,8 @@ HB.instance Definition _ (f : {mfun aT >-> rT}) := End mfun_measurable_realType. +Reserved Notation "'M_ X t" (format "''M_' X t", at level 5, t, X at next level). + Section markov_chebyshev_cantelli. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) (P : probability T R). @@ -657,6 +937,10 @@ Qed. Definition mmt_gen_fun (X : T -> R) (t : R) := 'E_P[expR \o t \o* X]. Local Notation "'M_ X t" := (mmt_gen_fun X t). +Local Notation "'M_ X t" := (mmt_gen_fun X t). + +Definition nth_mmt (X : {RV P >-> R}) (n : nat) := 'E_P[X^+n]. + Lemma chernoff (X : {RV P >-> R}) (r a : R) : (0 < r)%R -> P [set x | X x >= a]%R <= 'M_X r * (expR (- (r * a)))%:E. Proof. @@ -762,6 +1046,7 @@ by rewrite -mulrDl -mulrDr (addrC u0) [in RHS](mulrAC u0) -exprnP expr2 !mulrA. Qed. End markov_chebyshev_cantelli. +Notation "'M_ X t" := (mmt_gen_fun X t) : ereal_scope. HB.mixin Record MeasurableFun_isDiscrete d d' (T : measurableType d) (T' : measurableType d') (X : T -> T') of @MeasurableFun d d' T T' X := { @@ -783,6 +1068,22 @@ Definition discrete_random_variable d d' (T : measurableType d) Notation "{ 'dRV' P >-> T }" := (@discrete_random_variable _ _ _ T _ P) : form_scope. +Section dRV_comp. +Context d1 d2 d3 (T1 : measurableType d1) (T2 : measurableType d2) (T3 : measurableType d3). +Context (R : realType) (P : probability T1 R) (X : {dRV P >-> T2}) (f : {mfun T2 >-> T3}). + +Let countable_range_comp_dRV : countable (range (f \o X)). +Proof. apply: countable_range_comp; left; exact: countable_range. Qed. + +(* +HB.instance Definition _ := + MeasurableFun_isDiscrete.Build _ _ _ _ _ countable_range_comp_dRV. +*) + +Definition dRV_comp (* : {dRV P >-> T3} *) := f \o X. + +End dRV_comp. + Section dRV_definitions. Context {d} {d'} {T : measurableType d} {T' : measurableType d'} {R : realType} (P : probability T R). @@ -866,11 +1167,12 @@ End distribution_dRV. Section discrete_distribution. Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType) (P : probability T R). +Context d d' (T : measurableType d) (U : measurableType d') (R : realType) (P : probability T R). +Hypothesis mx : forall x : U, measurable [set x]. -Lemma dRV_expectation (X : {dRV P >-> R}) : - P.-integrable [set: T] (EFin \o X) -> - 'E_P[X] = \sum_(n -> U}) (f : {mfun U >-> R}) : + P.-integrable [set: T] (EFin \o f \o X) -> + 'E_P[f \o X] = \sum_(n ix; rewrite unlock. rewrite -[in LHS](_ : \bigcup_k (if k \in dRV_dom X then @@ -888,32 +1190,61 @@ have {tA}/trivIset_mkcond tXA : move/trivIsetP : tA => /(_ i j iX jX) Aij. by rewrite -preimage_setI Aij ?preimage_set0. rewrite integral_bigcup //; last 2 first. - - by move=> k; case: ifPn. + - move=> k; case: ifPn => // k_domX. + rewrite -[X in _ X]setTI. + exact: measurable_funP. - apply: (integrableS measurableT) => //. - by rewrite -bigcup_mkcond; exact: bigcup_measurable. + rewrite -bigcup_mkcond. apply: bigcup_measurable => k k_domX. + rewrite -[X in _ X]setTI. + exact: measurable_funP. transitivity (\sum_(i i _; case: ifPn => iX. by apply: eq_integral => t; rewrite in_setE/= => ->. by rewrite !integral_set0. -transitivity (\sum_(i i _; rewrite -integralZl//; last 2 first. - - by case: ifPn. + - case: ifPn => // i_domX. + rewrite -[X in _ X]setTI. + exact: measurable_funP. - apply/integrableP; split => //. rewrite (eq_integral (cst 1%E)); last by move=> x _; rewrite abse1. - rewrite integral_cst//; last by case: ifPn. + rewrite integral_cst//; last first. + case: ifPn => // i_domX. + rewrite -[X in _ X]setTI. + exact: measurable_funP. rewrite mul1e (@le_lt_trans _ _ 1%E) ?ltey//. - by case: ifPn => // _; exact: probability_le1. + case: ifPn => // _; apply: probability_le1 => //. + rewrite -[X in _ X]setTI. + exact: measurable_funP. by apply: eq_integral => y _; rewrite mule1. apply: eq_eseriesr => k _; case: ifPn => kX. - rewrite /= integral_cst//= mul1e probability_distribution muleC. - by rewrite distribution_dRV_enum. + rewrite /= integral_cst//=; last first. + rewrite -[X in _ X]setTI. + exact: measurable_funP. + by rewrite mul1e probability_distribution muleC distribution_dRV_enum. by rewrite integral_set0 mule0 /enum_prob patchE (negbTE kX) mul0e. Qed. +End discrete_distribution. + +Section discrete_distribution. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma dRV_expectation (X : {dRV P >-> R}) : + P.-integrable [set: T] (EFin \o X) -> + 'E_P[X] = \sum_(n iX. +have := @dRV_expectation_comp _ _ T R R P (@measurable_set1 R) X. +Admitted. + +(* check that expecation_bernoulli is recoverable by bernoulli_pmf *) + Definition pmf (X : {RV P >-> R}) (r : R) : R := fine (P (X @^-1` [set r])). Lemma expectation_pmf (X : {dRV P >-> R}) : @@ -924,7 +1255,7 @@ move=> iX; rewrite dRV_expectation// [in RHS]eseries_mkcond. apply: eq_eseriesr => k _. rewrite /enum_prob patchE; case: ifPn => kX; last by rewrite mul0e. by rewrite /pmf fineK// fin_num_measure. -Qed. +Abort. End discrete_distribution. diff --git a/theories/sampling.v b/theories/sampling.v new file mode 100644 index 0000000000..e24bd6f977 --- /dev/null +++ b/theories/sampling.v @@ -0,0 +1,1043 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect. +From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop. +From HB Require Import structures. +From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. +From mathcomp Require Import reals ereal interval_inference topology normedtype sequences. +From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. +From mathcomp Require Import lebesgue_integral kernel probability. +From mathcomp Require Import independence. + +Reserved Notation "' P [ A | B ]". + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Section independent_events. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Lemma sub_independent_events (I : choiceType) (A B : set I) (E : I -> set T) : + A `<=` B -> independent_events P B E -> independent_events P A E. +Proof. +by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. +Qed. + +Definition kwise_independent (I : choiceType) (A : set I) (E : I -> set T) k := + (forall i, A i -> measurable (E i)) /\ + forall B : {fset I}, [set` B] `<=` A -> (#|` B | <= k)%nat -> + P (\bigcap_(i in [set` B]) E i) = \prod_(i <- B) P (E i). + +Lemma sub_kwise_independent (I : choiceType) (A B : set I) (E : I -> set T) k : + A `<=` B -> kwise_independent B E k -> kwise_independent A E k. +Proof. +by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. +Qed. + +Lemma mutual_indep_is_kwise_indep (I : choiceType) (A : set I) (E : I -> set T) k : + independent_events P A E -> kwise_independent A E k. +Proof. +rewrite /independent_events /kwise_independent. +move=> [mE miE]; split=> // B BleA _. +exact: miE. +Qed. + +Lemma nwise_indep_is_mutual_indep (I : choiceType) (A : {fset I}) (E : I -> set T) n : + #|` A | = n -> kwise_independent [set` A] E n -> independent_events P [set` A] E. +Proof. +rewrite /independent_events /kwise_independent. +move=> nA [mE miE]; split=> // B BleA. +apply: miE => //; rewrite -nA fsubset_leq_card//. +by apply/fsubsetP => x xB; exact: (BleA x). +Qed. + +Lemma mutually_independent_weak (I : choiceType) (E : I -> set T) (B : set I) : + (forall b, ~ B b -> E b = setT) -> + independent_events P [set: I] E <-> + independent_events P B E. +Proof. +move=> BE; split; first exact: sub_independent_events. +move=> [mE h]; split=> [i _|C _]. + by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. +have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. +rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. +rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. +have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. + exists (fset_set ([set` C] `&` B)). + by rewrite fset_setK//; exact: finite_setIl. +rewrite CBD h; last first. + rewrite -CBD; exact: subIsetr. +rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. +rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. + by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. +by rewrite CBD -fsbig_seq. +Qed. + +Lemma kwise_independent_weak (I : choiceType) (E : I -> set T) (B : set I) k : + (forall b, ~ B b -> E b = setT) -> + kwise_independent [set: I] E k <-> + kwise_independent B E k. +Proof. +move=> BE; split; first exact: sub_kwise_independent. +move=> [mE h]; split=> [i _|C _ Ck]. + by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. +have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. +rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. +rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. +have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. + exists (fset_set ([set` C] `&` B)). + by rewrite fset_setK//; exact: finite_setIl. +rewrite CBD h; last 2 first. + - rewrite -CBD; exact: subIsetr. + - rewrite (leq_trans _ Ck)// fsubset_leq_card// -(set_fsetK D) -(set_fsetK C). + by rewrite -fset_set_sub// -CBD; exact: subIsetl. +rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. +rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. + by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. +by rewrite CBD -fsbig_seq. +Qed. + +Lemma kwise_independent_weak01 E1 E2 : + kwise_independent [set: nat] (bigcap2 E1 E2) 2%N <-> + kwise_independent [set 0%N; 1%N] (bigcap2 E1 E2) 2%N. +Proof. +apply: kwise_independent_weak. +by move=> n /= /not_orP[/eqP /negbTE -> /eqP /negbTE ->]. +Qed. + +Lemma independent_events_weak' (I : choiceType) (E : I -> set T) (B : set I) : + (forall b, ~ B b -> E b = setT) -> + independent_events P [set: I] E <-> + independent_events P B E. +Proof. +move=> BE; split; first exact: sub_independent_events. +move=> [mE h]; split=> [i _|C CI]. + by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. +have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. +rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. +rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. +have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. + exists (fset_set ([set` C] `&` B)). + by rewrite fset_setK//; exact: finite_setIl. +rewrite CBD h; last first. + - rewrite -CBD; exact: subIsetr. +rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. +rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. + by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. +by rewrite CBD -fsbig_seq. +Qed. + +Definition pairwise_independent E1 E2 := + kwise_independent [set 0; 1]%N (bigcap2 E1 E2) 2. + +Lemma pairwise_independentM_old (E1 E2 : set T) : + pairwise_independent E1 E2 <-> + [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. +Proof. +split. +- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. + rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. + + by rewrite set_fsetU !set_fset1; exact: subset_refl. + + rewrite cardfs2//. + split => //. + + by apply: (mE1E2 0%N) => /=; left. + + by apply: (mE1E2 1%N) => /=; right. +- move=> [mE1 mE2 E1E2M]. + split => //=. + + by move=> [| [| [|]]]//=. + + move=> B _; have [B0|B0] := boolP (0%N \in B); last first. + have [B1|B1] := boolP (1%N \in B); last first. + rewrite big1_fset; last first. + move=> k kB _; rewrite /bigcap2. + move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. + move: kB B1; case: ifPn => [/eqP -> ->//|_ _ _]. + by rewrite probability_setT. + rewrite bigcapT ?probability_setT// => k/= kB. + move: kB B0 B1; case: ifPn => [/eqP -> ->//|k0]. + by case: ifPn => [/eqP -> ->|]. + rewrite (bigcap_setD1 1%N _ [set` B])//=. + rewrite bigcapT ?setIT; last first. + move=> k [/= kB /eqP /negbTE ->]. + by move: kB B0; case: ifPn => [/eqP -> ->|]. + rewrite (big_fsetD1 1%N)//= big1_fset ?mule1// => k. + rewrite !inE => /andP[/negbTE -> kB] _. + move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. + by rewrite probability_setT. + rewrite (bigcap_setD1 0%N _ [set` B])//. + have [B1|B1] := boolP (1%N \in B); last first. + rewrite bigcapT ?setIT; last first. + move=> k [/= kB /eqP /negbTE ->]. + by move: kB B1; case: ifPn => [/eqP -> ->|]. + rewrite (big_fsetD1 0%N)//= big1_fset ?mule1// => k. + rewrite !inE => /andP[/negbTE -> kB] _. + move: kB B1; case: ifPn => [/eqP -> ->//|k1 kB B1]. + by rewrite probability_setT. + rewrite (bigcap_setD1 1%N _ ([set` B] `\ 0%N))// bigcapT ?setIT; last first. + by move=> n/= [[nB]/eqP/negbTE -> /eqP/negbTE ->]. + rewrite E1E2M (big_fsetD1 0%N)//= (big_fsetD1 1%N)/=; last by rewrite !inE B1. + rewrite big1_fset ?mule1//= => k. + rewrite !inE => -/and3P[/negbTE -> /negbTE -> kB] _; + by rewrite probability_setT. +Qed. + +Lemma pairwise_independentM (E1 E2 : set T) : + pairwise_independent E1 E2 <-> + [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. +Proof. +split. +- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. + rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. + + by rewrite set_fsetU !set_fset1; exact: subset_refl. + + by rewrite cardfs2. + split => //. + + by apply: (mE1E2 0%N) => /=; left. + + by apply: (mE1E2 1%N) => /=; right. +- move=> [mE1 mE2 E1E2M]. + rewrite /pairwise_independent. + split. + + by move=> [| [| [|]]]//=. + + move=> B B01 B2. + have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. + * rewrite B_set0. + move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. + by rewrite big_nil bigcap_set0 probability_setT. + * rewrite B_set0 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set0 fsbig_set1/=. + * rewrite B_set1 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set1 fsbig_set1/=. + * rewrite B_set01 bigcap_setU1 bigcap_set1/=. + rewrite fsbig_seq//= B_set01. + rewrite fsbigU//=; last first. + by move=> n [/= ->]. + by rewrite !fsbig_set1//=. +Qed. + +Lemma pairwise_independent_setC (E1 E2 : set T) : + pairwise_independent E1 E2 -> pairwise_independent E1 (~` E2). +Proof. +rewrite/pairwise_independent. +move/pairwise_independentM=> [mE1 mE2 h]. +apply/pairwise_independentM; split=> //. +- exact: measurableC. +- rewrite -setDE measureD//; last first. + exact: (le_lt_trans (probability_le1 P mE1) (ltry _)). + rewrite probability_setC// muleBr// ?mule1 -?h//. + by rewrite fin_num_measure. +Qed. + +Lemma pairwise_independentC (E1 E2 : set T) : + pairwise_independent E1 E2 -> pairwise_independent E2 E1. +Proof. +rewrite/pairwise_independent/kwise_independent; move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. +rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => h. +split. +- case=> [_|[_|]]//=. + + by apply: (mE1E2 1%N) => /=; right. + + by apply: (mE1E2 0%N) => /=; left. +- move=> B B01 B2. + have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. + + rewrite B_set0. + move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. + by rewrite big_nil bigcap_set0 probability_setT. + + rewrite B_set0 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set0 fsbig_set1/=. + + rewrite B_set1 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set1 fsbig_set1/=. + + rewrite B_set01 bigcap_setU1 bigcap_set1/=. + rewrite fsbig_seq//= B_set01. + rewrite fsbigU//=; last first. + by move=> n [/= ->]. + rewrite !fsbig_set1//= muleC setIC. + apply: h. + * by rewrite set_fsetU !set_fset1; exact: subset_refl. + * by rewrite cardfs2. +Qed. +(* ale: maybe interesting is thm 8.3 and exercise 8.6 from shoup/ntb at this point *) + +End independent_events. + +Section conditional_probability. +Context d (T : measurableType d) (R : realType). +Local Open Scope ereal_scope. + +Definition conditional_probability (P : probability T R) E1 E2 := (fine (P (E1 `&` E2)) / fine (P E2))%:E. +Local Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). + +Lemma conditional_independence (P : probability T R) E1 E2 : + P E2 != 0 -> pairwise_independent P E1 E2 -> 'P [ E1 | E2 ] = P E1. +Proof. +move=> PE2ne0 iE12. +have /= mE1 := (iE12.1 0%N). +have /= mE2 := (iE12.1 1%N). +rewrite/conditional_probability. +have [_ _ ->] := (pairwise_independentM _ _ _).1 iE12. +rewrite fineM ?fin_num_measure//; [|apply: mE1; left=>//|apply: mE2; right=>//]. +rewrite -mulrA mulfV ?mulr1 ?fineK// ?fin_num_measure//; first by apply: mE1; left. +by rewrite fine_eq0// fin_num_measure//; apply: mE2; right. +Qed. + +(* TODO (klenke thm 8.4): if P B > 0 then 'P[.|B] is a probability measure *) + +Lemma conditional_independent_is_pairwise_independent (P : probability T R) E1 E2 : + d.-measurable E1 -> d.-measurable E2 -> + P E2 != 0 -> + 'P[E1 | E2] = P E1 -> pairwise_independent P E1 E2. +Proof. +rewrite /conditional_probability/pairwise_independent=> mE1 mE2 pE20 pE1E2. +split. +- by case=> [|[|]]//=. +- move=> B B01 B2; have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. + + rewrite B_set0. + move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. + by rewrite big_nil bigcap_set0 probability_setT. + + rewrite B_set0 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set0 fsbig_set1/=. + + rewrite B_set1 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set1 fsbig_set1/=. + + rewrite B_set01 bigcap_setU1 bigcap_set1/=. + rewrite fsbig_seq//= B_set01. + rewrite fsbigU//=; last first. + by move=> n [/= ->]. + rewrite !fsbig_set1//= -pE1E2 -{2}(@fineK _ (P E2)). + rewrite -EFinM -mulrA mulVf ?mulr1 ?fine_eq0// ?fineK//. + all: by apply: fin_num_measure => //; apply: measurableI. +Qed. + +Lemma conditional_independentC (P : probability T R) E1 E2 : + d.-measurable E1 -> d.-measurable E2 -> + P E1 != 0 -> P E2 != 0 -> + reflect ('P[E1 | E2] == P E1) ('P[E2 | E1] == P E2). +Proof. +move=> mE1 mE2 pE10 pE20. +apply/(iffP idP)=>/eqP. ++ move/(@conditional_independent_is_pairwise_independent _ _ _ mE2 mE1 pE10). + move/pairwise_independentC. + by move/(conditional_independence pE20)/eqP. ++ move/(@conditional_independent_is_pairwise_independent _ _ _ mE1 mE2 pE20). + move/pairwise_independentC. + by move/(conditional_independence pE10)/eqP. +Qed. + +(* Lemma summation (I : choiceType) (A : {fset I}) E F (P : probability T R) : *) +(* (* the sets are disjoint *) *) +(* P (\bigcap_(i in [set` A]) F i) = 1 -> P E = \prod_(i <- A) ('P [E | F i] * P (F i)). *) +(* Proof. *) +(* move=> pF1. *) + +Lemma bayes (P : probability T R) E F : + d.-measurable E -> d.-measurable F -> + 'P[ E | F ] = ((fine ('P[F | E] * P E)) / (fine (P F)))%:E. +Proof. +rewrite /conditional_probability => mE mF. +have [PE0|PE0] := eqVneq (P E) 0. + have -> : P (E `&` F) = 0. + by apply/eqP; rewrite eq_le -{1}PE0 (@measureIl _ _ _ P E F mE mF)/= measure_ge0. + by rewrite PE0 fine0 invr0 mulr0 mule0 mul0r. +by rewrite -{2}(@fineK _ (P E)) -?EFinM -?(mulrA (fine _)) ?mulVf ?fine_eq0 ?fin_num_measure// mul1r setIC//. +Qed. + +End conditional_probability. +Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). + +From mathcomp Require Import real_interval. + +Section independent_RVs. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Definition pairwise_independent_RV (X Y : {RV P >-> R}) := + forall s t, pairwise_independent P (X @^-1` s) (Y @^-1` t). + +Lemma conditional_independent_RV (X Y : {RV P >-> R}) : + pairwise_independent_RV X Y -> + forall s t, P (Y @^-1` t) != 0 -> 'P [X @^-1` s | Y @^-1` t] = P (X @^-1` s). +Proof. +move=> iRVXY s t PYtne0. +exact: conditional_independence. +Qed. + +Definition mutually_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := + forall x_ : I -> R, independent_events P A (fun i => X i @^-1` `[(x_ i), +oo[%classic). + +Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := + forall x_ : I -> R, kwise_independent P A (fun i => X i @^-1` `[(x_ i), +oo[%classic) k. + +Lemma nwise_indep_is_mutual_indep_RV (I : choiceType) (A : {fset I}) (X : I -> {RV P >-> R}) n : + #|` A | = n -> kwise_independent_RV [set` A] X n -> mutually_independent_RV [set` A] X. +Proof. +rewrite/mutually_independent_RV/kwise_independent_RV=> nA kwX s. +by apply: nwise_indep_is_mutual_indep; rewrite ?nA. +Qed. + +(* alternative formalization +Definition inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := + forall (s : I -> set R), mutually_independent P A (fun i => X i @^-1` s i). + +Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := + forall (s : I -> set R), kwise_independent P A (fun i => X i @^-1` s i) k. + +this should be equivalent according to wikipedia https://en.wikipedia.org/wiki/Independence_(probability_theory)#For_real_valued_random_variables +*) + +(* Remark 2.15 (i) *) +Lemma prob_inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) : + mutually_independent_RV A X -> + forall J : {fset I}, [set` J] `<=` A -> + forall x_ : I -> R, + P (\bigcap_(i in [set` J]) X i @^-1` `[(x_ i), +oo[%classic) = + \prod_(i <- J) P (X i @^-1` `[(x_ i), +oo[%classic). +Proof. +move=> iRVX J JleA x_. +apply: (iRVX _).2 => //. +Qed. + +(* +Lemma mutually_independent_RV' (I : choiceType) (A : set I) + (X : I -> {RV P >-> R}) (S : I -> set R) : + mutually_independent_RV A X -> + (forall i, A i -> measurable (S i)) -> + mutually_independent P A (fun i => X i @^-1` S i). +Proof. +move=> miX mS. +split; first by move=> i Ai; exact/measurable_sfunP/(mS i Ai). +move=> B BA. +Abort. +*) + +Lemma inde_expectation (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) : + mutually_independent_RV A X -> + forall B : {fset I}, [set` B] `<=` A -> + 'E_P[\prod_(i <- B) X i] = \prod_(i <- B) 'E_P[X i]. +Proof. +move=> AX B BA. +rewrite [in LHS]unlock. +rewrite /mutually_independent_RV in AX. +rewrite /independent_events in AX. +Abort. + +End independent_RVs. + +Section bool_to_real. +Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). +Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). + +Lemma measurable_bool_to_real : measurable_fun [set: T] bool_to_real. +Proof. +rewrite /bool_to_real. +apply: measurableT_comp => //=. +exact: (@measurable_funP _ _ _ _ f). +Qed. +(* HB.about isMeasurableFun.Build. *) +HB.instance Definition _ := + isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. + +Definition btr : {RV P >-> R} := bool_to_real. + +End bool_to_real. + +Section bernoulli. + +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Variable p : R. +Hypothesis p01 : (0 <= p <= 1)%R. + +Definition bernoulli_RV (X : {dRV P >-> bool}) := + distribution P X = bernoulli p. + +Lemma bernoulli_RV1 (X : {dRV P >-> bool}) : bernoulli_RV X -> + P [set i | X i == 1%R] = p%:E. +Proof. +move=> [[/(congr1 (fun f => f [set 1%:R]))]]. +rewrite bernoulliE//. +rewrite /mscale/=. +rewrite diracE/= mem_set// mule1// diracE/= memNset//. +rewrite mule0 adde0. +rewrite /distribution /= => <-. +congr (P _). +rewrite /preimage/=. +by apply/seteqP; split => [x /eqP H//|x /eqP]. +Qed. + +Lemma bernoulli_RV2 (X : {dRV P >-> bool}) : bernoulli_RV X -> + P [set i | X i == 0%R] = (`1-p)%:E. +Proof. +move=> [[/(congr1 (fun f => f [set 0%:R]))]]. +rewrite bernoulliE//. +rewrite /mscale/=. +rewrite diracE/= memNset//. +rewrite mule0// diracE/= mem_set// add0e mule1. +rewrite /distribution /= => <-. +congr (P _). +rewrite /preimage/=. +by apply/seteqP; split => [x /eqP H//|x /eqP]. +Qed. + +Lemma bernoulli_expectation (X : {dRV P >-> bool}) : + bernoulli_RV X -> 'E_P[btr P X] = p%:E. +Proof. +move=> bX. +rewrite unlock /btr. +rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. + by move=> y //=. +rewrite /bernoulli/=. +rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. + by move=> A mA _/=; rewrite (_ : distribution P X = bernoulli p). +rewrite integral_bernoulli//=. +by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. +Qed. + +Lemma integrable_bernoulli (X : {dRV P >-> bool}) : + bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). +Proof. +move=> bX. +apply/integrableP; split; first by apply: measurableT_comp => //; exact: measurable_bool_to_real. +have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. + rewrite unlock /expectation. + apply: eq_integral => x _. + by rewrite gee0_abs //= lee_fin. +by rewrite bernoulli_expectation// ltry. +Qed. + +Lemma bool_RV_sqr (X : {dRV P >-> bool}) : + ((btr P X ^+ 2) = btr P X :> (T -> R))%R. +Proof. +apply: funext => x /=. +rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. +by case: (X x) => /=; rewrite ?mulr1 ?mulr0. +Qed. + +Lemma bernoulli_variance (X : {dRV P >-> bool}) : + bernoulli_RV X -> 'V_P[btr P X] = (p * (`1-p))%:E. +Proof. +move=> b. +rewrite (@varianceE _ _ _ _ (btr P X)); + [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. +rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. +by rewrite expe2 -EFinD onemMr. +Qed. + +Definition is_bernoulli_trial n (X : {dRV P >-> bool}^nat) := + (forall i, (i < n)%nat -> bernoulli_RV (X i)) /\ independent_RVs P `I_n X. + +Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV P >-> R} := + (\sum_(i-> bool}^nat) n : + is_bernoulli_trial n X -> 'E_P[@bernoulli_trial n X] = (n%:R * p)%:E. +Proof. +move=> bRV. rewrite /bernoulli_trial. +transitivity ('E_P[\sum_(s <- map (btr P \o X) (iota 0 n)) s]). + by rewrite big_map -[in RHS](subn0 n) big_mkord. +rewrite expectation_sum; last first. + by move=> Xi; move/mapP=> [k kn] ->; apply: integrable_bernoulli; apply bRV; rewrite mem_iota leq0n in kn. +rewrite big_map -[in LHS](subn0 n) big_mkord. +transitivity (\sum_(i < n) p%:E). + apply: eq_bigr => k _. + rewrite bernoulli_expectation//. + apply bRV. + by []. +by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. +Qed. + +Definition sumrfct (s : seq {mfun T >-> R}) := (fun x => \sum_(f <- s) f x)%R. + +Lemma measurable_sumrfct s : measurable_fun setT (sumrfct s). +Proof. +rewrite /sumrfct. +pose n := size s. +apply/measurable_EFinP => /=. +have -> : (EFin \o (fun x : T => (\sum_(f <- s) f x)%R)) = (fun x : T => \sum_(i < n) (s`_i x)%:E)%R. + apply: funext => x /=. + rewrite sumEFin. + congr (_%:E). + rewrite big_tnth//. + apply: eq_bigr => i _ /=. + by rewrite (tnth_nth 0%R). +apply: emeasurable_sum => i. +by apply/measurable_EFinP. +Qed. + +HB.about isMeasurableFun.Build. +HB.instance Definition _ s := + isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). + +Lemma sumrfctE' (s : seq {mfun T >-> R}) x : + ((\sum_(f <- s) f) x = sumrfct s x)%R. +Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. + +Lemma bernoulli_trial_ge0 (X : {dRV P >-> bool}^nat) n : is_bernoulli_trial n X -> + (forall t, 0 <= bernoulli_trial n X t)%R. +Proof. +move=> [bRV Xn] t. +rewrite /bernoulli_trial. +have -> : (\sum_(i < n) btr P (X i))%R = (\sum_(s <- map (btr P \o X) (iota 0 n)) s)%R. + by rewrite big_map -[in RHS](subn0 n) big_mkord. +have -> : (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s)%R t = (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s t)%R. + by rewrite sumrfctE'. +rewrite big_map. +by apply: sumr_ge0 => i _/=; rewrite /bool_to_real/= ler0n. +Qed. + +(* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 *) +Axiom taylor_ln_le : forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. + +Lemma expR_prod d' {U : measurableType d'} (X : seq {mfun U >-> R}) (f : {mfun U >-> R} -> R) : + (\prod_(x <- X) expR (f x) = expR (\sum_(x <- X) f x))%R. +Proof. +elim: X => [|h t ih]; first by rewrite !big_nil expR0. +by rewrite !big_cons ih expRD. +Qed. + +Lemma expR_sum U l Q (f : U -> R) : (expR (\sum_(i <- l | Q i) f i) = \prod_(i <- l | Q i) expR (f i))%R. +Proof. +elim: l; first by rewrite !big_nil expR0. +move=> a l ih. +rewrite !big_cons. +case: ifP => //= aQ. +by rewrite expRD ih. +Qed. + +Lemma sumr_map U d' (V : measurableType d') (l : seq U) Q (f : U -> {mfun V >-> R}) (x : V) : + ((\sum_(i <- l | Q i) f i) x = \sum_(i <- l | Q i) f i x)%R. +Proof. +elim: l; first by rewrite !big_nil. +move=> a l ih. +rewrite !big_cons. +case: ifP => aQ//=. +by rewrite -ih. +Qed. + +Lemma prodr_map U d' (V : measurableType d') (l : seq U) Q (f : U -> {mfun V >-> R}) (x : V) : + ((\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x)%R. +Proof. +elim: l; first by rewrite !big_nil. +move=> a l ih. +rewrite !big_cons. +case: ifP => aQ//=. +by rewrite -ih. +Qed. + +Lemma independent_mmt_gen_fun (X : {dRV P >-> bool}^nat) n t : + let mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X i)) in + independent_RVs P `I_n X -> independent_RVs P `I_n mmtX. +Proof. +Admitted. (* from Reynald's PR, independent_RVs2_comp, "when applying a function, the sigma algebra only gets smaller" *) + +Lemma expectation_prod_independent_RVs (X : {RV P >-> R}^nat) n : + independent_RVs P `I_n X -> + 'E_P[\prod_(i < n) (X i)] = \prod_(i < n) 'E_P[X i]. +Proof. +Admitted. + +Lemma bernoulli_trial_mmt_gen_fun (X_ : {dRV P >-> bool}^nat) n (t : R) : + is_bernoulli_trial n X_ -> + let X := bernoulli_trial n X_ in + 'M_X t = \prod_(i < n) 'M_(btr P (X_ i)) t. +Proof. +move=> []bRVX iRVX /=. +rewrite /bernoulli_trial/mmt_gen_fun. +pose mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X_ i)). +have iRV_mmtX : independent_RVs P `I_n mmtX. + exact: independent_mmt_gen_fun. +transitivity ('E_P[\prod_(i < n) mmtX i])%R. + congr ('E_P[_]). + apply: funext => x/=. + rewrite sumr_map mulr_suml expR_sum prodr_map. + exact: eq_bigr. +exact: expectation_prod_independent_RVs. +Qed. + +Arguments sub_countable [T U]. +Arguments card_le_finite [T U]. + +Lemma bernoulli_mmt_gen_fun (X : {dRV P >-> bool}) (t : R) : + bernoulli_RV X -> 'M_(btr P X : {RV P >-> R}) t = (p * expR t + (1-p))%:E. +Proof. +move=> bX. rewrite/mmt_gen_fun. +pose mmtX : {RV P >-> R} := expR \o t \o* (btr P X). +set A := X @^-1` [set true]. +set B := X @^-1` [set false]. +have mA: measurable A by exact: measurable_sfunP. +have mB: measurable B by exact: measurable_sfunP. +have dAB: [disjoint A & B] + by rewrite /disj_set /A /B preimage_true preimage_false setICr. +have TAB: setT = A `|` B by rewrite -preimage_setU -setT_bool preimage_setT. +rewrite unlock. +rewrite TAB integral_setU_EFin -?TAB//. +under eq_integral. + move=> x /=. + rewrite /A inE /bool_to_real /= => ->. + rewrite mul1r. + over. +rewrite integral_cst//. +under eq_integral. + move=> x /=. + rewrite /B inE /bool_to_real /= => ->. + rewrite mul0r. + over. +rewrite integral_cst//. +rewrite /A /B /preimage /=. +under eq_set do rewrite (propext (rwP eqP)). +rewrite (bernoulli_RV1 bX). +under eq_set do rewrite (propext (rwP eqP)). +rewrite (bernoulli_RV2 bX). +rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. +by rewrite expR0 mulr1. +Qed. + +Lemma iter_mule (n : nat) (x y : \bar R) : iter n ( *%E x) y = (x ^+ n * y)%E. +Proof. by elim: n => [|n ih]; rewrite ?mul1e// [LHS]/= ih expeS muleA. Qed. + +Lemma binomial_mmt_gen_fun (X_ : {dRV P >-> bool}^nat) n (t : R) : + is_bernoulli_trial n X_ -> + let X := bernoulli_trial n X_ : {RV P >-> R} in + 'M_X t = ((p * expR t + (1-p))`^(n%:R))%:E. +Proof. +move: p01 => /andP[p0 p1] bX/=. +rewrite bernoulli_trial_mmt_gen_fun//. +under eq_bigr => i _. + rewrite bernoulli_mmt_gen_fun; last exact: bX.1. + over. +rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. +by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. +Qed. + +(* TODO: add to the PR by reynald that adds the \prod notation to master *) +Lemma prod_EFin U l Q (f : U -> R) : \prod_(i <- l | Q i) ((f i)%:E) = (\prod_(i <- l | Q i) f i)%:E. +Proof. +elim: l; first by rewrite !big_nil. +move=> a l ih. +rewrite !big_cons. +case: ifP => //= aQ. +by rewrite EFinM ih. +Qed. + +Lemma mmt_gen_fun_expectation (X_ : {dRV P >-> bool}^nat) (t : R) n : + (0 <= t)%R -> + is_bernoulli_trial n X_ -> + let X := bernoulli_trial n X_ : {RV P >-> R} in + 'M_X t <= (expR (fine 'E_P[X] * (expR t - 1)))%:E. +Proof. +move=> t0 bX/=. +have /andP[p0 p1] := p01. +rewrite binomial_mmt_gen_fun// lee_fin. +rewrite expectation_bernoulli_trial//. +rewrite addrCA -{2}(mulr1 p) -mulrN -mulrDr. +rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. + by rewrite addr_ge0// mulr_ge0// subr_ge0 -expR0 ler_expR. +exact: expR_ge1Dx. +Qed. + +Lemma end_thm24 (X_ : {dRV P >-> bool}^nat) n (t delta : R) : + is_bernoulli_trial n X_ -> + (0 < delta)%R -> + let X := @bernoulli_trial n X_ in + let mu := 'E_P[X] in + let t := ln (1 + delta) in + (expR (expR t - 1) `^ fine mu)%:E * + (expR (- t * (1 + delta)) `^ fine mu)%:E <= + ((expR delta / (1 + delta) `^ (1 + delta)) `^ fine mu)%:E. +Proof. +move=> bX d0 /=. +rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. +- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). +- by rewrite mulr_ge0// expR_ge0. +- by rewrite divr_ge0 ?expR_ge0// powR_ge0. +- rewrite lnK ?posrE ?addr_gt0// addrAC subrr add0r ler_wpM2l ?expR_ge0//. + by rewrite -powRN mulNr -mulrN expRM lnK// posrE addr_gt0. +Qed. + +(* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) +Theorem bernoulli_trial_inequality1 (X_ : {dRV P >-> bool}^nat) n (delta : R) : + is_bernoulli_trial n X_ -> + (0 < delta)%R -> + let X := @bernoulli_trial n X_ in + let mu := 'E_P[X] in + P [set i | X i >= (1 + delta) * fine mu]%R <= + ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. +Proof. +rewrite /= => bX delta0. +set X := @bernoulli_trial n X_. +set mu := 'E_P[X]. +set t := ln (1 + delta). +have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. +apply: (le_trans (chernoff _ _ t0)). +apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * + (expR (- (t * ((1 + delta) * fine mu))))%:E)). + rewrite lee_pmul2r ?lte_fin ?expR_gt0//. + by apply: (mmt_gen_fun_expectation _ bX); rewrite le_eqVlt t0 orbT. +rewrite mulrC expRM -mulNr mulrA expRM. +exact: (end_thm24 _ bX). +Qed. + +(* theorem 2.5 *) +Theorem bernoulli_trial_inequality2 (X : {dRV P >-> bool}^nat) (delta : R) n : + is_bernoulli_trial n X -> + let X' := @bernoulli_trial n X in + let mu := 'E_P[X'] in + (0 < n)%nat -> + (0 < delta < 1)%R -> + P [set i | X' i >= (1 + delta) * fine mu]%R <= + (expR (- (fine mu * delta ^+ 2) / 3))%:E. +Proof. +move=> bX X' mu n0 /andP[delta0 _]. +apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). + rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. + apply: (bernoulli_trial_inequality1 bX) => //. +apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). + rewrite lee_fin ler_expR ler_wpM2r//. + by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: (bernoulli_trial_ge0 bX). + rewrite lerB//. + exact: taylor_ln_le. +rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. +by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. +Qed. + +(* TODO: move *) +Lemma ln_div : {in Num.pos &, {morph ln (R:=R) : x y / (x / y)%R >-> (x - y)%R}}. +Proof. +by move=> x y; rewrite !posrE => x0 y0; rewrite lnM ?posrE ?invr_gt0// lnV ?posrE. +Qed. + +Lemma norm_expR : normr \o expR = (expR : R -> R). +Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. + +(* Rajani thm 2.6 / mu-book thm 4.5.(2) *) +Theorem bernoulli_trial_inequality3 (X : {dRV P >-> bool}^nat) (delta : R) n : + is_bernoulli_trial n X -> (0 < delta < 1)%R -> + let X' := @bernoulli_trial n X : {RV P >-> R} in + let mu := 'E_P[X'] in + P [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. +Proof. +move=> bX /andP[delta0 delta1] /=. +set X' := @bernoulli_trial n X : {RV P >-> R}. +set mu := 'E_P[X']. +have /andP[p0 p1] := p01. +apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). + (* using Markov's inequality somewhere, see mu's book page 66 *) + have H1 t : (t < 0)%R -> + P [set i | (X' i <= (1 - delta) * fine mu)%R] = P [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. + move=> t0; apply: congr1; apply: eq_set => x /=. + rewrite lee_fin ger0_norm ?expR_ge0// ler_expR (mulrC _ t) -mulrA. + by rewrite -[in RHS]ler_ndivrMl// mulrA mulVf ?lt_eqF// mul1r. + set t := ln (1 - delta). + have ln1delta : (t < 0)%R. + (* TODO: lacking a lemma here *) + rewrite -oppr0 ltrNr -lnV ?posrE ?subr_gt0// ln_gt0//. + by rewrite invf_gt1// ?subr_gt0// ltrBlDr ltrDl. + have {H1}-> := H1 _ ln1delta. + apply: (@le_trans _ _ (((fine 'E_P[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). + rewrite EFinM lee_pdivl_mulr ?expR_gt0// muleC fineK. + apply: (@markov _ _ _ P (expR \o t \o* X' : {RV P >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + - apply: expR_gt0. + - rewrite norm_expR. + have -> : 'E_P[expR \o t \o* X'] = 'M_X' t by []. + by rewrite (binomial_mmt_gen_fun _ bX). + apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). + rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. + have -> : 'E_P[expR \o t \o* X'] = 'M_X' t by []. + rewrite (binomial_mmt_gen_fun _ bX)/=. + rewrite /mu /X' (expectation_bernoulli_trial bX)/=. + rewrite !lnK ?posrE ?subr_gt0//. + rewrite expRM powRrM powRAC. + rewrite ge0_ler_powR ?ler0n// ?nnegrE ?powR_ge0//. + by rewrite addr_ge0 ?mulr_ge0// subr_ge0// ltW. + rewrite addrAC subrr sub0r -expRM. + rewrite addrCA -{2}(mulr1 p) -mulrBr addrAC subrr sub0r mulrC mulNr. + by apply: expR_ge1Dx. + rewrite !lnK ?posrE ?subr_gt0//. + rewrite -addrAC subrr sub0r -mulrA [X in (_ / X)%R]expRM lnK ?posrE ?subr_gt0//. + rewrite -[in leRHS]powR_inv1 ?powR_ge0// powRM// ?expR_ge0 ?invr_ge0 ?powR_ge0//. + by rewrite powRAC powR_inv1 ?powR_ge0// powRrM expRM. +rewrite lee_fin. +rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. +- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). +- by rewrite divr_ge0 ?expR_ge0// powR_ge0. +- by rewrite expR_ge0. +- rewrite -ler_ln ?posrE ?divr_gt0 ?expR_gt0 ?powR_gt0 ?subr_gt0//. + rewrite expRK// ln_div ?posrE ?expR_gt0 ?powR_gt0 ?subr_gt0//. + rewrite expRK//. + rewrite /powR (*TODO: lemma ln of powR*) gt_eqF ?subr_gt0// expRK. + (* requires analytical argument: see p.66 of mu's book *) + Local Open Scope ring_scope. + rewrite -(@ler_pM2r _ 2)// -mulrA mulVf// mulr1 mulrDl. + rewrite -subr_le0 mulNr opprK. + rewrite addrC !addrA. + have->: delta ^+ 2 - delta * 2 = (1 - delta)^+2 - 1. + rewrite sqrrB expr1n mul1r [RHS]addrC !addrA addNr add0r addrC -mulNrn. + by rewrite -(mulr_natr (- delta) 2) mulNr. + rewrite addrAC subr_le0. + set f := fun (x : R) => x ^+ 2 + - (x * ln x) * 2. + have @idf (x : R^o) : 0 < x -> {df | is_derive x 1 (f : R^o -> R^o) df}. + move=> x0; evar (df : (R : Type)); exists df. + apply: is_deriveD; first by []. + apply: is_deriveM; last by []. + apply: is_deriveN. + apply: is_deriveM; first by []. + exact: is_derive1_ln. + suff: forall x : R, x \in `]0, 1[ -> f x <= 1. + by apply; rewrite memB_itv0 in_itv /= delta0 delta1. + move=> x x01. + have->: 1 = f 1 by rewrite /f expr1n ln1 mulr0 oppr0 mul0r addr0. + apply: (@ger0_derive1_homo _ f 0 1 false false)=> //. + - move=> t /[!in_itv] /= /andP [] + _. + by case/idf=> ? /@ex_derive. + - move=> t /[!in_itv] /= /andP [] t0 t1. + Local Arguments derive_val {R V W a v f df}. + rewrite (derive_val (svalP (idf _ t0))) /=. + clear idf. + rewrite exp_derive derive_cst derive_id . + rewrite scaler0 add0r /GRing.scale /= !mulr1 expr1. + rewrite -mulrDr mulr_ge0// divff ?lt0r_neq0//. + rewrite opprD addrA subr_ge0 -ler_expR. + have:= t0; rewrite -lnK_eq => /eqP ->. + by rewrite -[leLHS]addr0 -(subrr 1) addrCA expR_ge1Dx. + - apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _. + by case/idf=> ? /@ex_derive. + - by apply: (subset_itvW_bound _ _ x01); rewrite bnd_simp. + - by rewrite in_itv /= ltr01 lexx. + - by move: x01; rewrite in_itv=> /= /andP [] _ /ltW. +Qed. +Local Open Scope ereal_scope. + +Lemma measurable_fun_le D (f g : T -> R) : d.-measurable D -> measurable_fun D f -> + measurable_fun D g -> measurable (D `&` [set x | f x <= g x]%R). +Proof. +move=> mD mf mg. +under eq_set => x do rewrite -lee_fin. +apply: emeasurable_fun_le => //; apply: measurableT_comp => //. +Qed. + +(* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) +Corollary bernoulli_trial_inequality4 (X : {dRV P >-> bool}^nat) (delta : R) n : + is_bernoulli_trial n X -> (0 < delta < 1)%R -> + (0 < n)%nat -> + (0 < p)%R -> + let X' := @bernoulli_trial n X in + let mu := 'E_P[X'] in + P [set i | `|X' i - fine mu | >= delta * fine mu]%R <= + (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. +Proof. +move=> bX /andP[d0 d1] n0 p0 /=. +set X' := @bernoulli_trial n X. +set mu := 'E_P[X']. +under eq_set => x. + rewrite ler_normr. + rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. + rewrite -lerBDr -(lerN2 (- _)%R) opprK opprB. + rewrite -{2}(mul1r (fine mu)) -mulrBl. + rewrite -!lee_fin. + over. +rewrite /=. +rewrite set_orb. +rewrite measureU; last 3 first. +- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. + apply: emeasurable_fun_le => //. + apply: measurableT_comp => //. +- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. + apply: emeasurable_fun_le => //. + apply: measurableT_comp => //. +- rewrite disjoints_subset => x /=. + rewrite /mem /in_mem/= => X0; apply/negP. + rewrite -ltNge. + apply: (@lt_le_trans _ _ _ _ _ _ X0). + rewrite !EFinM. + rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. + by rewrite fineK /mu/X' (expectation_bernoulli_trial bX)// lte_fin mulr_gt0 ?ltr0n. +rewrite mulr2n EFinD lee_add//=. +- by apply: (bernoulli_trial_inequality2 bX); rewrite //d0 d1. +- apply: (le_trans (@bernoulli_trial_inequality3 _ delta _ bX _)); first by rewrite d0 d1. + rewrite lee_fin ler_expR !mulNr lerN2. + rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. + rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. + rewrite /mu unlock /expectation integral_ge0// => x _. + by rewrite /X' lee_fin; apply: (bernoulli_trial_ge0 bX). +Qed. + +(* Rajani thm 3.1 / mu-book thm 4.7 *) +Theorem sampling (X : {dRV P >-> bool}^nat) n (theta delta : R) : + let X_sum := bernoulli_trial n X in + let X' x := (X_sum x) / n%:R in + (0 < p)%R -> + is_bernoulli_trial n X -> + (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> + (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> + P [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. +Proof. +move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. +have E_X_sum: 'E_P[X_sum] = (p * n%:R)%:E. + by rewrite /X_sum expectation_bernoulli_trial// mulrC. +have /andP[_ p1] := p01. +set epsilon := theta / p. +have epsilon01 : (0 < epsilon < 1)%R. + by rewrite /epsilon ?ltr_pdivrMr ?divr_gt0 ?mul1r. +have thetaE : theta = (epsilon * p)%R. + by rewrite /epsilon -mulrA mulVf ?mulr1// gt_eqF. +have step1 : P [set i | `| X' i - p | >= epsilon * p]%R <= + ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. + rewrite [X in P X <= _](_ : _ = + [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. + apply/seteqP; split => [t|t]/=. + move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. + rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R)// -normrM mulrBl. + by rewrite -mulrA mulVf ?mulr1// gt_eqF ?ltr0n. + move/(@ler_wpM2r _ n%:R^-1); rewrite invr_ge0// ler0n => /(_ erefl). + rewrite -(mulrA _ _ n%:R^-1) divff ?mulr1 ?gt_eqF ?ltr0n//. + move=> /le_trans; apply. + rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R^-1)// -normrM mulrBl. + by rewrite -mulrA divff ?mulr1// gt_eqF// ltr0n. + rewrite -mulrA. + have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. + rewrite -E_X_sum. + by apply: (@bernoulli_trial_inequality4 X epsilon _ bX). +have step2 : P [set i | `| X' i - p | >= theta]%R <= + ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. + rewrite thetaE; move/le_trans : step1; apply. + rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. + rewrite -2![in leRHS]mulrA [in leRHS]mulrCA. + rewrite /epsilon -mulrA mulVf ?gt_eqF// mulr1 -!mulrA !ler_wpM2l ?(ltW theta0)//. + rewrite mulrCA ler_wpM2l ?(ltW theta0)//. + rewrite [X in (_ * X)%R]mulrA mulVf ?gt_eqF// -[leLHS]mul1r [in leRHS]mul1r. + by rewrite ler_wpM2r// invf_ge1. +suff : delta%:E >= P [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. + rewrite [X in P X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. + apply/seteqP; split => [t|t]/=. + by rewrite leNgt => /negP. + by rewrite ltNge => /negP/negPn. + have ? : measurable [set i | (`|X' i - p| < theta)%R]. + under eq_set => x do rewrite -lte_fin. + rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. + by apply: emeasurable_fun_lt => //; apply: measurableT_comp => //; + apply: measurableT_comp => //; apply: measurable_funD => //; + apply: measurable_funM. + rewrite probability_setC// lee_subel_addr//. + rewrite -lee_subel_addl//; last by rewrite fin_num_measure. + move=> /le_trans; apply. + rewrite le_measure ?inE//. + under eq_set => x do rewrite -lee_fin. + rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. + by apply: emeasurable_fun_le => //; apply: measurableT_comp => //; + apply: measurableT_comp => //; apply: measurable_funD => //; + apply: measurable_funM. + by move=> t/= /ltW. +(* NB: last step in the pdf *) +apply: (le_trans step2). +rewrite lee_fin -(mulr_natr _ 2) -ler_pdivlMr//. +rewrite -(@lnK _ (delta / 2)); last by rewrite posrE divr_gt0. +rewrite ler_expR mulNr lerNl -lnV; last by rewrite posrE divr_gt0. +rewrite invf_div ler_pdivlMr// mulrC. +rewrite -ler_pdivrMr; last by rewrite exprn_gt0. +by rewrite mulrAC. +Qed. + +End bernoulli. From 3ce2f9c238d54f7c977e6d5a4e7b640b76a06c5f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 25 Feb 2025 17:27:38 +0900 Subject: [PATCH 39/73] axiom about composition of RVs proved --- theories/sampling.v | 160 +++++++++++++++++++------------------------- 1 file changed, 69 insertions(+), 91 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index e24bd6f977..7fe4ad4186 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -440,10 +440,73 @@ Qed. HB.instance Definition _ := isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. +HB.instance Definition _ := MeasurableFun.on bool_to_real. + Definition btr : {RV P >-> R} := bool_to_real. End bool_to_real. +Section independent_RVs_btr. +Context {R : realType} d (T : measurableType d). +Variable P : probability T R. +Local Open Scope ring_scope. + +Lemma independent_RVs_btr + (I : set nat) (X : nat -> {mfun T >-> bool}) : + independent_RVs P I X -> independent_RVs P I (fun i : nat => btr P (X i)). +Proof. +move=> PIX; split. +- move=> i Ii. + rewrite /g_sigma_algebra_preimage/= /preimage_set_system/= => _ [A mA <-]. + by rewrite setTI; exact/measurable_sfunP. +- move=> J JI E/= JEfX; apply PIX => // j jJ. + have := JEfX _ jJ; rewrite !inE. + rewrite /g_sigma_algebra_preimage /preimage_set_system/= => -[A mA <-]. + by exists ((fun x => x%:R) @^-1` A). +Qed. + +End independent_RVs_btr. + +Section mfunM. +Context {d} (T : measurableType d) {R : realType}. + +HB.instance Definition _ (f g : {mfun T >-> R}) := + @isMeasurableFun.Build d _ _ _ (f \* g)%R (measurable_funM (@measurable_funP _ _ _ _ f) ((@measurable_funP _ _ _ _ g))). + +End mfunM. + +Section move. + +Lemma sumr_map {R : realType} U d (T : measurableType d) (l : seq U) Q + (f : U -> {mfun T >-> R}) (x : T) : + (\sum_(i <- l | Q i) f i) x = \sum_(i <- l | Q i) f i x. +Proof. by elim/big_ind2 : _ => //= _ g _ h <- <-. Qed. + +Lemma prodr_map {R : realType} U d (T : measurableType d) (l : seq U) Q + (f : U -> {mfun T >-> R}) (x : T) : + (\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x. +Proof. by elim/big_ind2 : _ => //= _ h _ g <- <-. Qed. + +Definition sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : T -> R := + fun x => \sum_(f <- s) f x. + +Lemma measurable_sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : + measurable_fun setT (sumrfct s). +Proof. +apply/measurable_EFinP => /=; apply/measurableT_comp => //. +exact: measurable_sum. +Qed. + +HB.instance Definition _ {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). + +Lemma sum_mfunE {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) x : + ((\sum_(f <- s) f) x = sumrfct s x)%R. +Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. + + +End move. + Section bernoulli. Local Open Scope ereal_scope. @@ -549,32 +612,6 @@ transitivity (\sum_(i < n) p%:E). by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. Qed. -Definition sumrfct (s : seq {mfun T >-> R}) := (fun x => \sum_(f <- s) f x)%R. - -Lemma measurable_sumrfct s : measurable_fun setT (sumrfct s). -Proof. -rewrite /sumrfct. -pose n := size s. -apply/measurable_EFinP => /=. -have -> : (EFin \o (fun x : T => (\sum_(f <- s) f x)%R)) = (fun x : T => \sum_(i < n) (s`_i x)%:E)%R. - apply: funext => x /=. - rewrite sumEFin. - congr (_%:E). - rewrite big_tnth//. - apply: eq_bigr => i _ /=. - by rewrite (tnth_nth 0%R). -apply: emeasurable_sum => i. -by apply/measurable_EFinP. -Qed. - -HB.about isMeasurableFun.Build. -HB.instance Definition _ s := - isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). - -Lemma sumrfctE' (s : seq {mfun T >-> R}) x : - ((\sum_(f <- s) f) x = sumrfct s x)%R. -Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. - Lemma bernoulli_trial_ge0 (X : {dRV P >-> bool}^nat) n : is_bernoulli_trial n X -> (forall t, 0 <= bernoulli_trial n X t)%R. Proof. @@ -583,7 +620,7 @@ rewrite /bernoulli_trial. have -> : (\sum_(i < n) btr P (X i))%R = (\sum_(s <- map (btr P \o X) (iota 0 n)) s)%R. by rewrite big_map -[in RHS](subn0 n) big_mkord. have -> : (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s)%R t = (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s t)%R. - by rewrite sumrfctE'. + by rewrite sum_mfunE. rewrite big_map. by apply: sumr_ge0 => i _/=; rewrite /bool_to_real/= ler0n. Qed. @@ -591,47 +628,15 @@ Qed. (* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 *) Axiom taylor_ln_le : forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. -Lemma expR_prod d' {U : measurableType d'} (X : seq {mfun U >-> R}) (f : {mfun U >-> R} -> R) : - (\prod_(x <- X) expR (f x) = expR (\sum_(x <- X) f x))%R. -Proof. -elim: X => [|h t ih]; first by rewrite !big_nil expR0. -by rewrite !big_cons ih expRD. -Qed. - -Lemma expR_sum U l Q (f : U -> R) : (expR (\sum_(i <- l | Q i) f i) = \prod_(i <- l | Q i) expR (f i))%R. -Proof. -elim: l; first by rewrite !big_nil expR0. -move=> a l ih. -rewrite !big_cons. -case: ifP => //= aQ. -by rewrite expRD ih. -Qed. - -Lemma sumr_map U d' (V : measurableType d') (l : seq U) Q (f : U -> {mfun V >-> R}) (x : V) : - ((\sum_(i <- l | Q i) f i) x = \sum_(i <- l | Q i) f i x)%R. -Proof. -elim: l; first by rewrite !big_nil. -move=> a l ih. -rewrite !big_cons. -case: ifP => aQ//=. -by rewrite -ih. -Qed. - -Lemma prodr_map U d' (V : measurableType d') (l : seq U) Q (f : U -> {mfun V >-> R}) (x : V) : - ((\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x)%R. -Proof. -elim: l; first by rewrite !big_nil. -move=> a l ih. -rewrite !big_cons. -case: ifP => aQ//=. -by rewrite -ih. -Qed. - Lemma independent_mmt_gen_fun (X : {dRV P >-> bool}^nat) n t : let mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X i)) in independent_RVs P `I_n X -> independent_RVs P `I_n mmtX. Proof. -Admitted. (* from Reynald's PR, independent_RVs2_comp, "when applying a function, the sigma algebra only gets smaller" *) +rewrite /= => PnX. +apply: independent_RVs_comp => //. +apply: independent_RVs_scale => //=. +exact: independent_RVs_btr. +Qed. Lemma expectation_prod_independent_RVs (X : {RV P >-> R}^nat) n : independent_RVs P `I_n X -> @@ -695,9 +700,6 @@ rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. by rewrite expR0 mulr1. Qed. -Lemma iter_mule (n : nat) (x y : \bar R) : iter n ( *%E x) y = (x ^+ n * y)%E. -Proof. by elim: n => [|n ih]; rewrite ?mul1e// [LHS]/= ih expeS muleA. Qed. - Lemma binomial_mmt_gen_fun (X_ : {dRV P >-> bool}^nat) n (t : R) : is_bernoulli_trial n X_ -> let X := bernoulli_trial n X_ : {RV P >-> R} in @@ -712,16 +714,6 @@ rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. Qed. -(* TODO: add to the PR by reynald that adds the \prod notation to master *) -Lemma prod_EFin U l Q (f : U -> R) : \prod_(i <- l | Q i) ((f i)%:E) = (\prod_(i <- l | Q i) f i)%:E. -Proof. -elim: l; first by rewrite !big_nil. -move=> a l ih. -rewrite !big_cons. -case: ifP => //= aQ. -by rewrite EFinM ih. -Qed. - Lemma mmt_gen_fun_expectation (X_ : {dRV P >-> bool}^nat) (t : R) n : (0 <= t)%R -> is_bernoulli_trial n X_ -> @@ -803,12 +795,6 @@ rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. -(* TODO: move *) -Lemma ln_div : {in Num.pos &, {morph ln (R:=R) : x y / (x / y)%R >-> (x - y)%R}}. -Proof. -by move=> x y; rewrite !posrE => x0 y0; rewrite lnM ?posrE ?invr_gt0// lnV ?posrE. -Qed. - Lemma norm_expR : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. @@ -910,14 +896,6 @@ rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. Qed. Local Open Scope ereal_scope. -Lemma measurable_fun_le D (f g : T -> R) : d.-measurable D -> measurable_fun D f -> - measurable_fun D g -> measurable (D `&` [set x | f x <= g x]%R). -Proof. -move=> mD mf mg. -under eq_set => x do rewrite -lee_fin. -apply: emeasurable_fun_le => //; apply: measurableT_comp => //. -Qed. - (* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) Corollary bernoulli_trial_inequality4 (X : {dRV P >-> bool}^nat) (delta : R) n : is_bernoulli_trial n X -> (0 < delta < 1)%R -> From 100fe5457977dd4318be150ac4b6bb0267855b77 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 26 Feb 2025 14:07:00 +0900 Subject: [PATCH 40/73] wip --- theories/probability.v | 9 +- theories/sampling.v | 255 ++++++++++++++++++++++++++++------------- 2 files changed, 183 insertions(+), 81 deletions(-) diff --git a/theories/probability.v b/theories/probability.v index 02ef8a905e..c5299067af 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -934,9 +934,9 @@ apply: (le_trans (@le_integral_comp_abse _ _ _ P _ measurableT (EFin \o X) - by rewrite unlock. Qed. -Definition mmt_gen_fun (X : T -> R) (t : R) := 'E_P[expR \o t \o* X]. -Local Notation "'M_ X t" := (mmt_gen_fun X t). +Definition mmt_gen_fun0 (X : {RV P >-> R}) (t : R) := [the {mfun T >-> R} of expR \o t \o* X]. +Definition mmt_gen_fun (X : {RV P >-> R}) (t : R) := 'E_P[mmt_gen_fun0 X t]. Local Notation "'M_ X t" := (mmt_gen_fun X t). Definition nth_mmt (X : {RV P >-> R}) (n : nat) := 'E_P[X^+n]. @@ -945,7 +945,8 @@ Lemma chernoff (X : {RV P >-> R}) (r a : R) : (0 < r)%R -> P [set x | X x >= a]%R <= 'M_X r * (expR (- (r * a)))%:E. Proof. move=> t0; rewrite /mmt_gen_fun. -have -> : expR \o r \o* X = (normr \o normr) \o (expR \o r \o* X). +have -> : mmt_gen_fun0 X r = (normr \o normr) \o (expR \o r \o* X) :> (T -> R). + (* TODO: lemmas *) by apply: funext => t /=; rewrite normr_id ger0_norm ?expR_ge0. rewrite expRN lee_pdivlMr ?expR_gt0//. rewrite (le_trans _ (markov _ (expR_gt0 (r * a)) _ _ _))//; last first. @@ -1049,7 +1050,7 @@ End markov_chebyshev_cantelli. Notation "'M_ X t" := (mmt_gen_fun X t) : ereal_scope. HB.mixin Record MeasurableFun_isDiscrete d d' (T : measurableType d) - (T' : measurableType d') (X : T -> T') of @MeasurableFun d d' T T' X := { + (T' : measurableType d') (X : T -> T') (*of @MeasurableFun d d' T T' X*) := { countable_range : countable (range X) }. diff --git a/theories/sampling.v b/theories/sampling.v index 7fe4ad4186..c0c4f47b66 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -507,6 +507,55 @@ Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. End move. +Definition measure_tuple_display : measure_display -> measure_display. +Proof. exact. Qed. + +Definition g_sigma_preimage d (rT : semiRingOfSetsType d) (aT : Type) + (n : nat) (f : 'I_n -> aT -> rT) : set (set aT). +Admitted. + +HB.instance Definition _ (n : nat) (T : pointedType) := + isPointed.Build (n.-tuple T) (nseq n point). + +Definition mtuple (n : nat) d (T : measurableType d) : Type := n.-tuple T. + +HB.instance Definition _ (n : nat) d (T : measurableType d) := Pointed.on (mtuple n T). + + + +Lemma countable_range_bool d (T : measurableType d) (b : bool) + : countable (range (@cst T _ b)). +Admitted. + +HB.instance Definition _ d (T : measurableType d) b := + MeasurableFun_isDiscrete.Build d _ T _ (cst b) (countable_range_bool T b). + + +Section measurable_tuple. +Context {d} {T : measurableType d}. +Variable n : nat. + +Let coors := (fun i x => @tnth n T x i). + +Let prod_salgebra_set0 : g_sigma_preimage coors set0. +Admitted. + +Let prod_salgebra_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). +Admitted. + +Let prod_salgebra_bigcup (F : _^nat) : + (forall i, g_sigma_preimage coors (F i)) -> + g_sigma_preimage coors (\bigcup_i (F i)). +Admitted. + +HB.instance Definition _ := + @isMeasurable.Build (measure_tuple_display d) + (mtuple n T) (g_sigma_preimage coors) + (prod_salgebra_set0) (prod_salgebra_setC) (prod_salgebra_bigcup). + +End measurable_tuple. + + Section bernoulli. Local Open Scope ereal_scope. @@ -589,19 +638,57 @@ rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. by rewrite expe2 -EFinD onemMr. Qed. -Definition is_bernoulli_trial n (X : {dRV P >-> bool}^nat) := - (forall i, (i < n)%nat -> bernoulli_RV (X i)) /\ independent_RVs P `I_n X. +(* TODO: define a mixin *) +Program Definition is_bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) := + (forall i : 'I_n, bernoulli_RV (tnth X i)) /\ + independent_RVs P `I_n (fun i => nth _ X i). +Next Obligation. +move=> n X i. +have @h : {RV P >-> bool}. + exact: (cst false). +exact: h. +Defined. + +Axiom pro : forall (n : nat) (P : probability T R), + probability (mtuple n T) R. + +Definition sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := + (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. + +Lemma measurable_sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (sumrfct_tuple s). +Admitted. + +HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (sumrfct_tuple s) (measurable_sumrfct_tuple s). + +Definition prodrfct_tuple n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := + (fun x => \prod_(i < n) (tnth s i) (tnth x i))%R. + +Lemma measurable_prodrfct_tuple n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (prodrfct_tuple s). +Admitted. + +HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (prodrfct_tuple s) (measurable_prodrfct_tuple s). + +Definition bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) : {RV (pro n P) >-> R} := + sumrfct_tuple [the n.-tuple _ of (map (btr P) + (map (fun t : {dRV P >-> bool} => t : {mfun T >-> bool}) X))]. -Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV P >-> R} := +(* +was wrong +Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := (\sum_(i-> bool}^nat) n : - is_bernoulli_trial n X -> 'E_P[@bernoulli_trial n X] = (n%:R * p)%:E. +Lemma expectation_bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) : + is_bernoulli_trial X -> 'E_(pro n P)[bernoulli_trial X] = (n%:R * p)%:E. Proof. move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_P[\sum_(s <- map (btr P \o X) (iota 0 n)) s]). - by rewrite big_map -[in RHS](subn0 n) big_mkord. -rewrite expectation_sum; last first. +(*transitivity ('E_(pro n P)[\sum_(s <- map (btr P \o X) (iota 0 n)) s]). + by rewrite big_map -[in RHS](subn0 n) big_mkord.*) (* TODO *) +(*rewrite expectation_sum; last first. by move=> Xi; move/mapP=> [k kn] ->; apply: integrable_bernoulli; apply bRV; rewrite mem_iota leq0n in kn. rewrite big_map -[in LHS](subn0 n) big_mkord. transitivity (\sum_(i < n) p%:E). @@ -610,20 +697,20 @@ transitivity (\sum_(i < n) p%:E). apply bRV. by []. by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. -Qed. +Qed.*) Admitted. -Lemma bernoulli_trial_ge0 (X : {dRV P >-> bool}^nat) n : is_bernoulli_trial n X -> - (forall t, 0 <= bernoulli_trial n X t)%R. +Lemma bernoulli_trial_ge0 n (X : n.-tuple {dRV P >-> bool}) : is_bernoulli_trial X -> + (forall t, 0 <= bernoulli_trial X t)%R. Proof. move=> [bRV Xn] t. rewrite /bernoulli_trial. -have -> : (\sum_(i < n) btr P (X i))%R = (\sum_(s <- map (btr P \o X) (iota 0 n)) s)%R. +(*have -> : (\sum_(i < n) btr P (X i))%R = (\sum_(s <- map (btr P \o X) (iota 0 n)) s)%R. by rewrite big_map -[in RHS](subn0 n) big_mkord. have -> : (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s)%R t = (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s t)%R. by rewrite sum_mfunE. rewrite big_map. by apply: sumr_ge0 => i _/=; rewrite /bool_to_real/= ler0n. -Qed. +Qed.*) Admitted. (* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 *) Axiom taylor_ln_le : forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. @@ -638,29 +725,41 @@ apply: independent_RVs_scale => //=. exact: independent_RVs_btr. Qed. -Lemma expectation_prod_independent_RVs (X : {RV P >-> R}^nat) n : - independent_RVs P `I_n X -> - 'E_P[\prod_(i < n) (X i)] = \prod_(i < n) 'E_P[X i]. +Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : + independent_RVs P `I_n (fun i => nth (@cst T R 0%R : {mfun T >-> R}) + (map (fun x : {RV P >-> R} => x : {mfun T >-> R}) X) + i) -> + 'E_(pro n P)[ prodrfct_tuple X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. Admitted. -Lemma bernoulli_trial_mmt_gen_fun (X_ : {dRV P >-> bool}^nat) n (t : R) : - is_bernoulli_trial n X_ -> - let X := bernoulli_trial n X_ in - 'M_X t = \prod_(i < n) 'M_(btr P (X_ i)) t. +(* wrong lemma *) +Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {dRV P >-> bool}) (t : R) : + is_bernoulli_trial X_ -> + let X := bernoulli_trial X_ in + 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. move=> []bRVX iRVX /=. rewrite /bernoulli_trial/mmt_gen_fun. -pose mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X_ i)). -have iRV_mmtX : independent_RVs P `I_n mmtX. - exact: independent_mmt_gen_fun. -transitivity ('E_P[\prod_(i < n) mmtX i])%R. - congr ('E_P[_]). +pose mmtX : n.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) + (map (fun x : {dRV P >-> bool} => btr P x : {RV P >-> R} ) X_). +(*pose mmtX (i : 'I_n) : {RV P >-> R} := expR \o t \o* (btr P (tnth X_ i)).*) +have iRV_mmtX : independent_RVs P setT (fun i => tnth mmtX i). + (*exact: independent_mmt_gen_fun.*) admit. +transitivity ('E_(pro n P)[ prodrfct_tuple mmtX ])%R. + (*congr ('E_P[_]). apply: funext => x/=. rewrite sumr_map mulr_suml expR_sum prodr_map. - exact: eq_bigr. -exact: expectation_prod_independent_RVs. -Qed. + exact: eq_bigr.*) admit. +rewrite /mmtX. +rewrite expectation_prod_independent_RVs; last first. + admit. +apply: eq_bigr => /= i _. +congr expectation. +rewrite /=. +rewrite tnth_map/=. +by rewrite tnth_map/=. +Admitted. Arguments sub_countable [T U]. Arguments card_le_finite [T U]. @@ -700,9 +799,10 @@ rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. by rewrite expR0 mulr1. Qed. -Lemma binomial_mmt_gen_fun (X_ : {dRV P >-> bool}^nat) n (t : R) : - is_bernoulli_trial n X_ -> - let X := bernoulli_trial n X_ : {RV P >-> R} in +(* wrong lemma *) +Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {dRV P >-> bool}) (t : R) : + is_bernoulli_trial X_ -> + let X := bernoulli_trial X_ : {RV pro n P >-> R} in 'M_X t = ((p * expR t + (1-p))`^(n%:R))%:E. Proof. move: p01 => /andP[p0 p1] bX/=. @@ -714,11 +814,11 @@ rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. Qed. -Lemma mmt_gen_fun_expectation (X_ : {dRV P >-> bool}^nat) (t : R) n : +Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {dRV P >-> bool}) (t : R) : (0 <= t)%R -> - is_bernoulli_trial n X_ -> - let X := bernoulli_trial n X_ : {RV P >-> R} in - 'M_X t <= (expR (fine 'E_P[X] * (expR t - 1)))%:E. + is_bernoulli_trial X_ -> + let X := bernoulli_trial X_ : {RV pro n P >-> R} in + 'M_X t <= (expR (fine 'E_(pro n P)[X] * (expR t - 1)))%:E. Proof. move=> t0 bX/=. have /andP[p0 p1] := p01. @@ -730,11 +830,11 @@ rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. exact: expR_ge1Dx. Qed. -Lemma end_thm24 (X_ : {dRV P >-> bool}^nat) n (t delta : R) : - is_bernoulli_trial n X_ -> +Lemma end_thm24 n (X_ : n.-tuple {dRV P >-> bool}) (t delta : R) : + is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in - let mu := 'E_P[X] in + let mu := 'E_(pro n P)[X] in let t := ln (1 + delta) in (expR (expR t - 1) `^ fine mu)%:E * (expR (- t * (1 + delta)) `^ fine mu)%:E <= @@ -750,17 +850,17 @@ rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. Qed. (* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) -Theorem bernoulli_trial_inequality1 (X_ : {dRV P >-> bool}^nat) n (delta : R) : - is_bernoulli_trial n X_ -> +Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {dRV P >-> bool}) (delta : R) : + is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in - let mu := 'E_P[X] in - P [set i | X i >= (1 + delta) * fine mu]%R <= + let mu := 'E_(pro n P)[X] in + (pro n P) [set i | X i >= (1 + delta) * fine mu]%R <= ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. Proof. rewrite /= => bX delta0. set X := @bernoulli_trial n X_. -set mu := 'E_P[X]. +set mu := 'E_(pro n P)[X]. set t := ln (1 + delta). have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. apply: (le_trans (chernoff _ _ t0)). @@ -773,13 +873,13 @@ exact: (end_thm24 _ bX). Qed. (* theorem 2.5 *) -Theorem bernoulli_trial_inequality2 (X : {dRV P >-> bool}^nat) (delta : R) n : - is_bernoulli_trial n X -> +Theorem bernoulli_trial_inequality2 n (X : n.-tuple {dRV P >-> bool}) (delta : R) : + is_bernoulli_trial X -> let X' := @bernoulli_trial n X in - let mu := 'E_P[X'] in + let mu := 'E_(pro n P)[X'] in (0 < n)%nat -> (0 < delta < 1)%R -> - P [set i | X' i >= (1 + delta) * fine mu]%R <= + (pro n P) [set i | X' i >= (1 + delta) * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3))%:E. Proof. move=> bX X' mu n0 /andP[delta0 _]. @@ -799,20 +899,20 @@ Lemma norm_expR : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) -Theorem bernoulli_trial_inequality3 (X : {dRV P >-> bool}^nat) (delta : R) n : - is_bernoulli_trial n X -> (0 < delta < 1)%R -> - let X' := @bernoulli_trial n X : {RV P >-> R} in - let mu := 'E_P[X'] in - P [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. +Theorem bernoulli_trial_inequality3 n (X : n.-tuple {dRV P >-> bool}) (delta : R) : + is_bernoulli_trial X -> (0 < delta < 1)%R -> + let X' := @bernoulli_trial n X : {RV pro n P >-> R} in + let mu := 'E_(pro n P)[X'] in + (pro n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. Proof. move=> bX /andP[delta0 delta1] /=. -set X' := @bernoulli_trial n X : {RV P >-> R}. -set mu := 'E_P[X']. +set X' := @bernoulli_trial n X : {RV pro n P >-> R}. +set mu := 'E_(pro n P)[X']. have /andP[p0 p1] := p01. apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). (* using Markov's inequality somewhere, see mu's book page 66 *) have H1 t : (t < 0)%R -> - P [set i | (X' i <= (1 - delta) * fine mu)%R] = P [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. + (pro n P) [set i | (X' i <= (1 - delta) * fine mu)%R] = (pro n P) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. move=> t0; apply: congr1; apply: eq_set => x /=. rewrite lee_fin ger0_norm ?expR_ge0// ler_expR (mulrC _ t) -mulrA. by rewrite -[in RHS]ler_ndivrMl// mulrA mulVf ?lt_eqF// mul1r. @@ -822,16 +922,16 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine rewrite -oppr0 ltrNr -lnV ?posrE ?subr_gt0// ln_gt0//. by rewrite invf_gt1// ?subr_gt0// ltrBlDr ltrDl. have {H1}-> := H1 _ ln1delta. - apply: (@le_trans _ _ (((fine 'E_P[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). + apply: (@le_trans _ _ (((fine 'E_(pro n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite EFinM lee_pdivl_mulr ?expR_gt0// muleC fineK. - apply: (@markov _ _ _ P (expR \o t \o* X' : {RV P >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + apply: (@markov _ _ _ (pro n P) (expR \o t \o* X' : {RV (pro n P) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. - apply: expR_gt0. - rewrite norm_expR. - have -> : 'E_P[expR \o t \o* X'] = 'M_X' t by []. + have -> : 'E_(pro n P)[expR \o t \o* X'] = 'M_X' t by []. by rewrite (binomial_mmt_gen_fun _ bX). apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. - have -> : 'E_P[expR \o t \o* X'] = 'M_X' t by []. + have -> : 'E_(pro n P)[expR \o t \o* X'] = 'M_X' t by []. rewrite (binomial_mmt_gen_fun _ bX)/=. rewrite /mu /X' (expectation_bernoulli_trial bX)/=. rewrite !lnK ?posrE ?subr_gt0//. @@ -897,18 +997,18 @@ Qed. Local Open Scope ereal_scope. (* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) -Corollary bernoulli_trial_inequality4 (X : {dRV P >-> bool}^nat) (delta : R) n : - is_bernoulli_trial n X -> (0 < delta < 1)%R -> +Corollary bernoulli_trial_inequality4 n (X : n.-tuple {dRV P >-> bool}) (delta : R) : + is_bernoulli_trial X -> (0 < delta < 1)%R -> (0 < n)%nat -> (0 < p)%R -> let X' := @bernoulli_trial n X in - let mu := 'E_P[X'] in - P [set i | `|X' i - fine mu | >= delta * fine mu]%R <= + let mu := 'E_(pro n P)[X'] in + (pro n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. Proof. move=> bX /andP[d0 d1] n0 p0 /=. set X' := @bernoulli_trial n X. -set mu := 'E_P[X']. +set mu := 'E_(pro n P)[X']. under eq_set => x. rewrite ler_normr. rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. @@ -934,7 +1034,8 @@ rewrite measureU; last 3 first. by rewrite fineK /mu/X' (expectation_bernoulli_trial bX)// lte_fin mulr_gt0 ?ltr0n. rewrite mulr2n EFinD lee_add//=. - by apply: (bernoulli_trial_inequality2 bX); rewrite //d0 d1. -- apply: (le_trans (@bernoulli_trial_inequality3 _ delta _ bX _)); first by rewrite d0 d1. +- have d01 : (0 < delta < 1)%R by rewrite d0. + apply: (le_trans (@bernoulli_trial_inequality3 _ X delta bX d01)). rewrite lee_fin ler_expR !mulNr lerN2. rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. @@ -943,17 +1044,17 @@ rewrite mulr2n EFinD lee_add//=. Qed. (* Rajani thm 3.1 / mu-book thm 4.7 *) -Theorem sampling (X : {dRV P >-> bool}^nat) n (theta delta : R) : - let X_sum := bernoulli_trial n X in +Theorem sampling n (X : n.-tuple {dRV P >-> bool}) (theta delta : R) : + let X_sum := bernoulli_trial X in let X' x := (X_sum x) / n%:R in (0 < p)%R -> - is_bernoulli_trial n X -> + is_bernoulli_trial X -> (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> - P [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. + (pro n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. Proof. move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. -have E_X_sum: 'E_P[X_sum] = (p * n%:R)%:E. +have E_X_sum: 'E_(pro n P)[X_sum] = (p * n%:R)%:E. by rewrite /X_sum expectation_bernoulli_trial// mulrC. have /andP[_ p1] := p01. set epsilon := theta / p. @@ -961,9 +1062,9 @@ have epsilon01 : (0 < epsilon < 1)%R. by rewrite /epsilon ?ltr_pdivrMr ?divr_gt0 ?mul1r. have thetaE : theta = (epsilon * p)%R. by rewrite /epsilon -mulrA mulVf ?mulr1// gt_eqF. -have step1 : P [set i | `| X' i - p | >= epsilon * p]%R <= +have step1 : (pro n P) [set i | `| X' i - p | >= epsilon * p]%R <= ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. - rewrite [X in P X <= _](_ : _ = + rewrite [X in (pro n P) X <= _](_ : _ = [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. apply/seteqP; split => [t|t]/=. move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. @@ -977,8 +1078,8 @@ have step1 : P [set i | `| X' i - p | >= epsilon * p]%R <= rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -E_X_sum. - by apply: (@bernoulli_trial_inequality4 X epsilon _ bX). -have step2 : P [set i | `| X' i - p | >= theta]%R <= +(* by apply: (@bernoulli_trial_inequality4 X epsilon _ bX).*) admit. +have step2 : (pro n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. @@ -987,8 +1088,8 @@ have step2 : P [set i | `| X' i - p | >= theta]%R <= rewrite mulrCA ler_wpM2l ?(ltW theta0)//. rewrite [X in (_ * X)%R]mulrA mulVf ?gt_eqF// -[leLHS]mul1r [in leRHS]mul1r. by rewrite ler_wpM2r// invf_ge1. -suff : delta%:E >= P [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. - rewrite [X in P X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. +suff : delta%:E >= (pro n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. + rewrite [X in (pro n P) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. apply/seteqP; split => [t|t]/=. by rewrite leNgt => /negP. by rewrite ltNge => /negP/negPn. @@ -1016,6 +1117,6 @@ rewrite ler_expR mulNr lerNl -lnV; last by rewrite posrE divr_gt0. rewrite invf_div ler_pdivlMr// mulrC. rewrite -ler_pdivrMr; last by rewrite exprn_gt0. by rewrite mulrAC. -Qed. +Admitted. End bernoulli. From d5083d5c99adb033eb1cbf31cb15c21f39fce395 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Wed, 26 Feb 2025 17:09:33 +0900 Subject: [PATCH 41/73] wip --- theories/sampling.v | 74 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 59 insertions(+), 15 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index c0c4f47b66..70c7fe3d3f 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -649,8 +649,7 @@ have @h : {RV P >-> bool}. exact: h. Defined. -Axiom pro : forall (n : nat) (P : probability T R), - probability (mtuple n T) R. +Axiom pro : forall (n : nat) (P : probability T R), probability (mtuple n T) R. Definition sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. @@ -682,22 +681,67 @@ Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} : (\sum_(i-> R}) : + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_(pro n P)[sumrfct_tuple X] = \sum_(i < n) ('E_P[(tnth X i)]). +Proof. +move: n X. +elim => [X|n IH X] /= intX. +- rewrite /sumrfct_tuple. + under eq_fun do rewrite big_ord0. + by rewrite big_ord0 expectation_cst. +pose X0 := tnth X ord0. +have intX0 : P.-integrable [set: T] (EFin \o X0). + by apply: intX; rewrite mem_tnth. +have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). + by move=> XiX; exact: intX. +rewrite big_ord_recr/=. +rewrite /sumrfct_tuple/=. +under eq_fun do rewrite big_ord_recr/=. +Set Printing Coercions. +pose X1 := fun x : mtuple n.+1 T => + (\sum_(i < n) MeasurableFun.sort (tnth X (widen_ord (leqnSn n) i)) (tnth x (widen_ord (leqnSn n) i)))%R. +have mX1 : measurable_fun setT X1. admit. +pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. +pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. +pose X2 := fun x : mtuple n.+1 T => + MeasurableFun.sort (tnth X ord_max) (tnth x ord_max). +have mX2 : measurable_fun setT X2. admit. +pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. +pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. +rewrite [X in 'E__[X]](_ : _ = Y1 \+ Y2)//. +rewrite expectationD; last 2 first. admit. admit. +Unset Printing Coercions. +congr (_ + _); last first. +- rewrite /Y1/X1/=. + rewrite unlock /expectation. + pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord_max). + have mphi : measurable_fun setT phi. admit. + rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ (fun w => (tnth X ord_max w)%:E)); last 2 first. + admit. admit. + congr (\int[_]__ _). + rewrite /pushforward. + apply: funext => x. + admit. +rewrite /Y2/X2/=. +Admitted. + Lemma expectation_bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) : is_bernoulli_trial X -> 'E_(pro n P)[bernoulli_trial X] = (n%:R * p)%:E. Proof. -move=> bRV. rewrite /bernoulli_trial. -(*transitivity ('E_(pro n P)[\sum_(s <- map (btr P \o X) (iota 0 n)) s]). - by rewrite big_map -[in RHS](subn0 n) big_mkord.*) (* TODO *) -(*rewrite expectation_sum; last first. - by move=> Xi; move/mapP=> [k kn] ->; apply: integrable_bernoulli; apply bRV; rewrite mem_iota leq0n in kn. -rewrite big_map -[in LHS](subn0 n) big_mkord. -transitivity (\sum_(i < n) p%:E). - apply: eq_bigr => k _. - rewrite bernoulli_expectation//. - apply bRV. - by []. -by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. -Qed.*) Admitted. +rewrite /is_bernoulli_trial /bernoulli_RV. +move=> [bRV iRV]. +rewrite /bernoulli_trial. +rewrite expectation_sum_pro; last first. + move=> /= Xi. + rewrite map_f. + move/mapP => []Xj /=+ ->. + rewrite /mem/=/in_mem/=. + apply: integrable_bernoulli. + admit. +under eq_bigr do rewrite !tnth_map/= bernoulli_expectation//. +by rewrite sumr_const card_ord EFinM mule_natl. +Qed. Lemma bernoulli_trial_ge0 n (X : n.-tuple {dRV P >-> bool}) : is_bernoulli_trial X -> (forall t, 0 <= bernoulli_trial X t)%R. From 26a8ec0d039eb6138391c2b8bdbda77b089b16d6 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 26 Feb 2025 18:24:10 +0900 Subject: [PATCH 42/73] rm dRV --- theories/sampling.v | 127 ++++++++++++++++++++++++++++---------------- 1 file changed, 82 insertions(+), 45 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 70c7fe3d3f..15709aeef8 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -511,8 +511,8 @@ Definition measure_tuple_display : measure_display -> measure_display. Proof. exact. Qed. Definition g_sigma_preimage d (rT : semiRingOfSetsType d) (aT : Type) - (n : nat) (f : 'I_n -> aT -> rT) : set (set aT). -Admitted. + (n : nat) (f : 'I_n -> aT -> rT) : set (set aT) := + <>. HB.instance Definition _ (n : nat) (T : pointedType) := isPointed.Build (n.-tuple T) (nseq n point). @@ -521,16 +521,13 @@ Definition mtuple (n : nat) d (T : measurableType d) : Type := n.-tuple T. HB.instance Definition _ (n : nat) d (T : measurableType d) := Pointed.on (mtuple n T). - - -Lemma countable_range_bool d (T : measurableType d) (b : bool) - : countable (range (@cst T _ b)). -Admitted. +Lemma countable_range_bool d (T : measurableType d) (b : bool) : + countable (range (@cst T _ b)). +Proof. exact: countableP. Qed. HB.instance Definition _ d (T : measurableType d) b := MeasurableFun_isDiscrete.Build d _ T _ (cst b) (countable_range_bool T b). - Section measurable_tuple. Context {d} {T : measurableType d}. Variable n : nat. @@ -538,15 +535,15 @@ Variable n : nat. Let coors := (fun i x => @tnth n T x i). Let prod_salgebra_set0 : g_sigma_preimage coors set0. -Admitted. +Proof. exact: sigma_algebra0. Qed. Let prod_salgebra_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). -Admitted. +Proof. exact: sigma_algebraC. Qed. Let prod_salgebra_bigcup (F : _^nat) : (forall i, g_sigma_preimage coors (F i)) -> g_sigma_preimage coors (\bigcup_i (F i)). -Admitted. +Proof. exact: sigma_algebra_bigcup. Qed. HB.instance Definition _ := @isMeasurable.Build (measure_tuple_display d) @@ -555,7 +552,6 @@ HB.instance Definition _ := End measurable_tuple. - Section bernoulli. Local Open Scope ereal_scope. @@ -563,10 +559,10 @@ Context d (T : measurableType d) (R : realType) (P : probability T R). Variable p : R. Hypothesis p01 : (0 <= p <= 1)%R. -Definition bernoulli_RV (X : {dRV P >-> bool}) := +Definition bernoulli_RV (X : {RV P >-> bool}) := distribution P X = bernoulli p. -Lemma bernoulli_RV1 (X : {dRV P >-> bool}) : bernoulli_RV X -> +Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> P [set i | X i == 1%R] = p%:E. Proof. move=> [[/(congr1 (fun f => f [set 1%:R]))]]. @@ -580,7 +576,7 @@ rewrite /preimage/=. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. -Lemma bernoulli_RV2 (X : {dRV P >-> bool}) : bernoulli_RV X -> +Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> P [set i | X i == 0%R] = (`1-p)%:E. Proof. move=> [[/(congr1 (fun f => f [set 0%:R]))]]. @@ -594,7 +590,7 @@ rewrite /preimage/=. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. -Lemma bernoulli_expectation (X : {dRV P >-> bool}) : +Lemma bernoulli_expectation (X : {RV P >-> bool}) : bernoulli_RV X -> 'E_P[btr P X] = p%:E. Proof. move=> bX. @@ -608,7 +604,7 @@ rewrite integral_bernoulli//=. by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. Qed. -Lemma integrable_bernoulli (X : {dRV P >-> bool}) : +Lemma integrable_bernoulli (X : {RV P >-> bool}) : bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). Proof. move=> bX. @@ -639,7 +635,7 @@ by rewrite expe2 -EFinD onemMr. Qed. (* TODO: define a mixin *) -Program Definition is_bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) := +Program Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := (forall i : 'I_n, bernoulli_RV (tnth X i)) /\ independent_RVs P `I_n (fun i => nth _ X i). Next Obligation. @@ -656,6 +652,7 @@ Definition sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := Lemma measurable_sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : measurable_fun setT (sumrfct_tuple s). +Proof. Admitted. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := @@ -671,9 +668,24 @@ Admitted. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := isMeasurableFun.Build _ _ _ _ (prodrfct_tuple s) (measurable_prodrfct_tuple s). -Definition bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) : {RV (pro n P) >-> R} := +Lemma measurable_tnth n (i : 'I_n.+1) : + measurable_fun [set: mtuple n.+1 T] (@tnth _ T ^~ i). +Proof. +move=> _ Y mY. +rewrite setTI. +have -> : (@tnth _ T)^~ i @^-1` Y + = \bigcup_(t in [set t : n.+1.-tuple T| @tnth n.+1 T t i \in Y]) [set t]. + apply/seteqP; split=> [t/= Yti|t]. + - exists t => //=. + by rewrite inE. + - move=> [t' /= t'iY] tt'. + subst t'. + by move/set_mem in t'iY. +Abort. + +Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (pro n P) >-> R} := sumrfct_tuple [the n.-tuple _ of (map (btr P) - (map (fun t : {dRV P >-> bool} => t : {mfun T >-> bool}) X))]. + (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. (* was wrong @@ -698,27 +710,34 @@ have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). rewrite big_ord_recr/=. rewrite /sumrfct_tuple/=. under eq_fun do rewrite big_ord_recr/=. -Set Printing Coercions. pose X1 := fun x : mtuple n.+1 T => (\sum_(i < n) MeasurableFun.sort (tnth X (widen_ord (leqnSn n) i)) (tnth x (widen_ord (leqnSn n) i)))%R. -have mX1 : measurable_fun setT X1. admit. +have mX1 : measurable_fun setT X1. + apply: measurable_sum => /= i. + admit. pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. pose X2 := fun x : mtuple n.+1 T => MeasurableFun.sort (tnth X ord_max) (tnth x ord_max). -have mX2 : measurable_fun setT X2. admit. +have mX2 : measurable_fun setT X2. + rewrite /X2 /=. + admit. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = Y1 \+ Y2)//. -rewrite expectationD; last 2 first. admit. admit. -Unset Printing Coercions. +rewrite expectationD; last 2 first. + admit. + admit. congr (_ + _); last first. - rewrite /Y1/X1/=. rewrite unlock /expectation. pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord_max). - have mphi : measurable_fun setT phi. admit. + have mphi : measurable_fun setT phi. + rewrite /phi. + admit. rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ (fun w => (tnth X ord_max w)%:E)); last 2 first. - admit. admit. + admit. + admit. congr (\int[_]__ _). rewrite /pushforward. apply: funext => x. @@ -726,10 +745,28 @@ congr (_ + _); last first. rewrite /Y2/X2/=. Admitted. -Lemma expectation_bernoulli_trial n (X : n.-tuple {dRV P >-> bool}) : +Lemma expectation_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> 'E_(pro n P)[bernoulli_trial X] = (n%:R * p)%:E. Proof. -rewrite /is_bernoulli_trial /bernoulli_RV. +move=> bRV. rewrite /bernoulli_trial. +transitivity ('E_(pro n P)[sumrfct_tuple (map (btr P) X)]). + (*by rewrite big_map -[in RHS](subn0 n) big_mkord.*) admit. +rewrite expectation_sum_pro; last first. + move=> Xi. + move=> /mapP[/= k kn] ->. + have [i ki] : exists i : 'I_n, k = tnth X i. + by apply/tnthP. + apply: integrable_bernoulli. + rewrite ki. + by apply bRV. +(*rewrite big_map -[in LHS](subn0 n) big_mkord.*) +transitivity (\sum_(i < n) p%:E). + apply: eq_bigr => k _. + (*rewrite bernoulli_expectation//. + apply bRV. + by [].*) admit. +by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. +(*rewrite /is_bernoulli_trial /bernoulli_RV. move=> [bRV iRV]. rewrite /bernoulli_trial. rewrite expectation_sum_pro; last first. @@ -740,10 +777,10 @@ rewrite expectation_sum_pro; last first. apply: integrable_bernoulli. admit. under eq_bigr do rewrite !tnth_map/= bernoulli_expectation//. -by rewrite sumr_const card_ord EFinM mule_natl. -Qed. +by rewrite sumr_const card_ord EFinM mule_natl.*) +Admitted. -Lemma bernoulli_trial_ge0 n (X : n.-tuple {dRV P >-> bool}) : is_bernoulli_trial X -> +Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> (forall t, 0 <= bernoulli_trial X t)%R. Proof. move=> [bRV Xn] t. @@ -759,7 +796,7 @@ Qed.*) Admitted. (* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 *) Axiom taylor_ln_le : forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. -Lemma independent_mmt_gen_fun (X : {dRV P >-> bool}^nat) n t : +Lemma independent_mmt_gen_fun (X : {RV P >-> bool}^nat) n t : let mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X i)) in independent_RVs P `I_n X -> independent_RVs P `I_n mmtX. Proof. @@ -778,7 +815,7 @@ Proof. Admitted. (* wrong lemma *) -Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {dRV P >-> bool}) (t : R) : +Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> let X := bernoulli_trial X_ in 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. @@ -786,7 +823,7 @@ Proof. move=> []bRVX iRVX /=. rewrite /bernoulli_trial/mmt_gen_fun. pose mmtX : n.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) - (map (fun x : {dRV P >-> bool} => btr P x : {RV P >-> R} ) X_). + (map (btr P) X_). (*pose mmtX (i : 'I_n) : {RV P >-> R} := expR \o t \o* (btr P (tnth X_ i)).*) have iRV_mmtX : independent_RVs P setT (fun i => tnth mmtX i). (*exact: independent_mmt_gen_fun.*) admit. @@ -808,7 +845,7 @@ Admitted. Arguments sub_countable [T U]. Arguments card_le_finite [T U]. -Lemma bernoulli_mmt_gen_fun (X : {dRV P >-> bool}) (t : R) : +Lemma bernoulli_mmt_gen_fun (X : {RV P >-> bool}) (t : R) : bernoulli_RV X -> 'M_(btr P X : {RV P >-> R}) t = (p * expR t + (1-p))%:E. Proof. move=> bX. rewrite/mmt_gen_fun. @@ -844,7 +881,7 @@ by rewrite expR0 mulr1. Qed. (* wrong lemma *) -Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {dRV P >-> bool}) (t : R) : +Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> let X := bernoulli_trial X_ : {RV pro n P >-> R} in 'M_X t = ((p * expR t + (1-p))`^(n%:R))%:E. @@ -858,7 +895,7 @@ rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. Qed. -Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {dRV P >-> bool}) (t : R) : +Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : (0 <= t)%R -> is_bernoulli_trial X_ -> let X := bernoulli_trial X_ : {RV pro n P >-> R} in @@ -874,7 +911,7 @@ rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. exact: expR_ge1Dx. Qed. -Lemma end_thm24 n (X_ : n.-tuple {dRV P >-> bool}) (t delta : R) : +Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in @@ -894,7 +931,7 @@ rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. Qed. (* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) -Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {dRV P >-> bool}) (delta : R) : +Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in @@ -917,7 +954,7 @@ exact: (end_thm24 _ bX). Qed. (* theorem 2.5 *) -Theorem bernoulli_trial_inequality2 n (X : n.-tuple {dRV P >-> bool}) (delta : R) : +Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> let X' := @bernoulli_trial n X in let mu := 'E_(pro n P)[X'] in @@ -943,7 +980,7 @@ Lemma norm_expR : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) -Theorem bernoulli_trial_inequality3 n (X : n.-tuple {dRV P >-> bool}) (delta : R) : +Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> (0 < delta < 1)%R -> let X' := @bernoulli_trial n X : {RV pro n P >-> R} in let mu := 'E_(pro n P)[X'] in @@ -1041,7 +1078,7 @@ Qed. Local Open Scope ereal_scope. (* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) -Corollary bernoulli_trial_inequality4 n (X : n.-tuple {dRV P >-> bool}) (delta : R) : +Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> (0 < delta < 1)%R -> (0 < n)%nat -> (0 < p)%R -> @@ -1088,7 +1125,7 @@ rewrite mulr2n EFinD lee_add//=. Qed. (* Rajani thm 3.1 / mu-book thm 4.7 *) -Theorem sampling n (X : n.-tuple {dRV P >-> bool}) (theta delta : R) : +Theorem sampling n (X : n.-tuple {RV P >-> bool}) (theta delta : R) : let X_sum := bernoulli_trial X in let X' x := (X_sum x) / n%:R in (0 < p)%R -> @@ -1122,7 +1159,7 @@ have step1 : (pro n P) [set i | `| X' i - p | >= epsilon * p]%R <= rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -E_X_sum. -(* by apply: (@bernoulli_trial_inequality4 X epsilon _ bX).*) admit. + exact: (@bernoulli_trial_inequality4 _ X epsilon bX). have step2 : (pro n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. From 5dccffca0aa9db2e06b2b23b656371f6b0cdac88 Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Wed, 26 Feb 2025 12:18:57 +0900 Subject: [PATCH 43/73] reduce Axiom taylor_ln_le to Axiom expR2_le8 --- theories/sampling.v | 71 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 66 insertions(+), 5 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 15709aeef8..5724fccdb5 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -6,6 +6,7 @@ From mathcomp Require Import cardinality fsbigop. From HB Require Import structures. From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. From mathcomp Require Import reals ereal interval_inference topology normedtype sequences. +From mathcomp Require Import realfun convex. From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral kernel probability. From mathcomp Require Import independence. @@ -17,7 +18,7 @@ Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Import numFieldTopology.Exports. +Import numFieldTopology.Exports numFieldNormedType.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. @@ -793,8 +794,67 @@ rewrite big_map. by apply: sumr_ge0 => i _/=; rewrite /bool_to_real/= ler0n. Qed.*) Admitted. -(* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 *) -Axiom taylor_ln_le : forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. +(* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 +taylor_ln_le : + forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. *) +Section taylor_ln_le. +Local Open Scope ring_scope. + +Axiom expR2_lt8 : expR 2 <= 8 :> R. + +Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. +Proof. +move=> x01; rewrite -subr_ge0. +pose f (x : R) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). +have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. +rewrite [leRHS](_ : _ = f x) // -f0. +evar (df0 : R -> R); evar (df : R -> R). +have idf (y : R) : 0 < 1 + y -> is_derive y (1:R) f (df y). + move=> y1. + rewrite (_ : df y = df0 y). + apply: is_deriveB; last exact: is_deriveD. + apply: is_deriveM=> //. + apply: is_derive1_comp=> //. + exact: is_derive1_ln. + rewrite /df0. + rewrite deriveD// derive_cst derive_id. + rewrite /GRing.scale /= !(mulr0,add0r,mulr1). + rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. + instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). + reflexivity. +clear df0. +have y1cc y : y \in `[0, 1] -> 0 < 1 + y. + rewrite in_itv /= => /andP [] y0 ?. + by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. +have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. +have dfge0 y : y \in `]0, 1[ -> 0 <= df y. + move=> y01. + have:= y01. + rewrite /df in_itv /= => /andP [] y0 y1. + rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. + rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. + pose iy:= Itv01 (ltW y0) (ltW y1). + have y1E: 1 + y = @convex.conv _ R^o iy 1 2. + rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. + by rewrite addrACA (addrC (- y)) subrr addr0. + rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. + rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. + rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. + rewrite ler_pdivrMr//. + rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. + rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. + rewrite !exprS expr0 mulr1 -!natrM mulnE /=. + by rewrite expR2_lt8. +apply: (@ger0_derive1_homo R f 0 1 true false). +- by move=> y /y1oo /idf /@ex_derive. +- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. +- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. +- by rewrite bound_itvE. +- exact: subset_itv_oo_cc. +- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. +Qed. + +End taylor_ln_le. Lemma independent_mmt_gen_fun (X : {RV P >-> bool}^nat) n t : let mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X i)) in @@ -963,7 +1023,7 @@ Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) (pro n P) [set i | X' i >= (1 + delta) * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3))%:E. Proof. -move=> bX X' mu n0 /andP[delta0 _]. +move=> bX X' mu n0 /[dup] delta01 /andP[delta0 _]. apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. apply: (bernoulli_trial_inequality1 bX) => //. @@ -971,7 +1031,8 @@ apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). rewrite lee_fin ler_expR ler_wpM2r//. by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: (bernoulli_trial_ge0 bX). rewrite lerB//. - exact: taylor_ln_le. + apply: taylor_ln_le. + by rewrite in_itv /=. rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. From 49499ce02e8187296b287fc20c45c55031179736 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 27 Feb 2025 12:32:13 +0900 Subject: [PATCH 44/73] measurable_tnth, pro --- theories/sampling.v | 217 ++++++++++++++++++++++---------------------- 1 file changed, 111 insertions(+), 106 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 5724fccdb5..11de3764a1 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -535,13 +535,13 @@ Variable n : nat. Let coors := (fun i x => @tnth n T x i). -Let prod_salgebra_set0 : g_sigma_preimage coors set0. +Let tuple_set0 : g_sigma_preimage coors set0. Proof. exact: sigma_algebra0. Qed. -Let prod_salgebra_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). +Let tuple_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). Proof. exact: sigma_algebraC. Qed. -Let prod_salgebra_bigcup (F : _^nat) : +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. @@ -549,10 +549,38 @@ Proof. exact: sigma_algebra_bigcup. Qed. HB.instance Definition _ := @isMeasurable.Build (measure_tuple_display d) (mtuple n T) (g_sigma_preimage coors) - (prod_salgebra_set0) (prod_salgebra_setC) (prod_salgebra_bigcup). + (tuple_set0) (tuple_setC) (tuple_bigcup). End measurable_tuple. +Definition cylinder d {T : measurableType d} m (A : set (m.-tuple T)) + (J : {fset 'I_m}%fset) : set (m.-tuple T) := + \big[setI/setT]_(i <- J) (@tnth _ T ^~ i) @^-1` + ((@tnth _ T ^~ i) @` A). + +Definition Z d {T : measurableType d} m + (J : {fset 'I_m}%fset) : set_system (m.-tuple T) := + [set B | exists A, B = cylinder A J]. + +Section pro. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Definition mpro (n : nat) : set (mtuple n T) -> \bar R. +induction n. + apply: @dirac _ (mtuple 0 T) _ R. + exact: [::]. +move=> A. +pose A' := (fun x => (thead x, [tuple of behead x])) @` A. +apply: (@product_measure1 _ _ _ _ _ P IHn). +exact: A'. +Defined. + +Definition pro (n : nat) : probability (mtuple n T) R. +Admitted. + +End pro. +Arguments pro {d T R} P n. + Section bernoulli. Local Open Scope ereal_scope. @@ -646,46 +674,42 @@ have @h : {RV P >-> bool}. exact: h. Defined. -Axiom pro : forall (n : nat) (P : probability T R), probability (mtuple n T) R. - -Definition sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := +Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. -Lemma measurable_sumrfct_tuple n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (sumrfct_tuple s). +Lemma measurable_tnth n (i : 'I_n) : + measurable_fun [set: mtuple n T] (@tnth _ T ^~ i). Proof. -Admitted. +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. + +Lemma measurable_tuple_sum n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (tuple_sum s). +Proof. +apply: measurable_sum => i/=; apply/measurableT_comp => //. +exact: measurable_tnth. +Qed. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (sumrfct_tuple s) (measurable_sumrfct_tuple s). + isMeasurableFun.Build _ _ _ _ (tuple_sum s) (measurable_tuple_sum s). -Definition prodrfct_tuple n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := +Definition tuple_prod n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := (fun x => \prod_(i < n) (tnth s i) (tnth x i))%R. -Lemma measurable_prodrfct_tuple n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (prodrfct_tuple s). -Admitted. +Lemma measurable_tuple_prod n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (tuple_prod s). +Proof. +apply: measurable_prod => /= i _; apply/measurableT_comp => //. +exact: measurable_tnth. +Qed. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (prodrfct_tuple s) (measurable_prodrfct_tuple s). + isMeasurableFun.Build _ _ _ _ (tuple_prod s) (measurable_tuple_prod s). -Lemma measurable_tnth n (i : 'I_n.+1) : - measurable_fun [set: mtuple n.+1 T] (@tnth _ T ^~ i). -Proof. -move=> _ Y mY. -rewrite setTI. -have -> : (@tnth _ T)^~ i @^-1` Y - = \bigcup_(t in [set t : n.+1.-tuple T| @tnth n.+1 T t i \in Y]) [set t]. - apply/seteqP; split=> [t/= Yti|t]. - - exists t => //=. - by rewrite inE. - - move=> [t' /= t'iY] tt'. - subst t'. - by move/set_mem in t'iY. -Abort. - -Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (pro n P) >-> R} := - sumrfct_tuple [the n.-tuple _ of (map (btr P) +Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (pro P n) >-> R} := + tuple_sum [the n.-tuple _ of (map (btr P) (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. (* @@ -696,11 +720,11 @@ Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} : Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) : (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_(pro n P)[sumrfct_tuple X] = \sum_(i < n) ('E_P[(tnth X i)]). + 'E_(pro P n)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). Proof. move: n X. elim => [X|n IH X] /= intX. -- rewrite /sumrfct_tuple. +- rewrite /tuple_sum. under eq_fun do rewrite big_ord0. by rewrite big_ord0 expectation_cst. pose X0 := tnth X ord0. @@ -709,20 +733,20 @@ have intX0 : P.-integrable [set: T] (EFin \o X0). have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). by move=> XiX; exact: intX. rewrite big_ord_recr/=. -rewrite /sumrfct_tuple/=. +rewrite /tuple_sum/=. under eq_fun do rewrite big_ord_recr/=. pose X1 := fun x : mtuple n.+1 T => (\sum_(i < n) MeasurableFun.sort (tnth X (widen_ord (leqnSn n) i)) (tnth x (widen_ord (leqnSn n) i)))%R. have mX1 : measurable_fun setT X1. - apply: measurable_sum => /= i. - admit. + apply: measurable_sum => /= i; apply: measurableT_comp => //. + exact: measurable_tnth. pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. pose X2 := fun x : mtuple n.+1 T => MeasurableFun.sort (tnth X ord_max) (tnth x ord_max). have mX2 : measurable_fun setT X2. - rewrite /X2 /=. - admit. +rewrite /X2 /=. + by apply: measurableT_comp => //; exact: measurable_tnth. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = Y1 \+ Y2)//. @@ -734,24 +758,24 @@ congr (_ + _); last first. rewrite unlock /expectation. pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord_max). have mphi : measurable_fun setT phi. - rewrite /phi. - admit. + exact: measurable_tnth. rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ (fun w => (tnth X ord_max w)%:E)); last 2 first. - admit. + exact/measurable_EFinP. admit. congr (\int[_]__ _). rewrite /pushforward. apply: funext => x. - admit. + admit. (* priority? *) rewrite /Y2/X2/=. Admitted. Lemma expectation_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : - is_bernoulli_trial X -> 'E_(pro n P)[bernoulli_trial X] = (n%:R * p)%:E. + is_bernoulli_trial X -> 'E_(pro P n)[bernoulli_trial X] = (n%:R * p)%:E. Proof. move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(pro n P)[sumrfct_tuple (map (btr P) X)]). - (*by rewrite big_map -[in RHS](subn0 n) big_mkord.*) admit. +transitivity ('E_(pro P n)[tuple_sum (map (btr P) X)]). + congr expectation; apply/funext => t. + by apply: eq_bigr => /= i _; rewrite !tnth_map. rewrite expectation_sum_pro; last first. move=> Xi. move=> /mapP[/= k kn] ->. @@ -760,39 +784,21 @@ rewrite expectation_sum_pro; last first. apply: integrable_bernoulli. rewrite ki. by apply bRV. -(*rewrite big_map -[in LHS](subn0 n) big_mkord.*) transitivity (\sum_(i < n) p%:E). apply: eq_bigr => k _. - (*rewrite bernoulli_expectation//. - apply bRV. - by [].*) admit. + rewrite tnth_map bernoulli_expectation//. + by apply bRV. by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. -(*rewrite /is_bernoulli_trial /bernoulli_RV. -move=> [bRV iRV]. -rewrite /bernoulli_trial. -rewrite expectation_sum_pro; last first. - move=> /= Xi. - rewrite map_f. - move/mapP => []Xj /=+ ->. - rewrite /mem/=/in_mem/=. - apply: integrable_bernoulli. - admit. -under eq_bigr do rewrite !tnth_map/= bernoulli_expectation//. -by rewrite sumr_const card_ord EFinM mule_natl.*) -Admitted. +Qed. Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> (forall t, 0 <= bernoulli_trial X t)%R. Proof. move=> [bRV Xn] t. rewrite /bernoulli_trial. -(*have -> : (\sum_(i < n) btr P (X i))%R = (\sum_(s <- map (btr P \o X) (iota 0 n)) s)%R. - by rewrite big_map -[in RHS](subn0 n) big_mkord. -have -> : (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s)%R t = (\sum_(s <- [seq (btr P \o X) i | i <- iota 0 n]) s t)%R. - by rewrite sum_mfunE. -rewrite big_map. -by apply: sumr_ge0 => i _/=; rewrite /bool_to_real/= ler0n. -Qed.*) Admitted. +apply/sumr_ge0 => /= i _. +by rewrite !tnth_map. +Qed. (* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 taylor_ln_le : @@ -870,7 +876,7 @@ Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : independent_RVs P `I_n (fun i => nth (@cst T R 0%R : {mfun T >-> R}) (map (fun x : {RV P >-> R} => x : {mfun T >-> R}) X) i) -> - 'E_(pro n P)[ prodrfct_tuple X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. + 'E_(pro P n)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. Admitted. @@ -887,11 +893,10 @@ pose mmtX : n.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) (*pose mmtX (i : 'I_n) : {RV P >-> R} := expR \o t \o* (btr P (tnth X_ i)).*) have iRV_mmtX : independent_RVs P setT (fun i => tnth mmtX i). (*exact: independent_mmt_gen_fun.*) admit. -transitivity ('E_(pro n P)[ prodrfct_tuple mmtX ])%R. - (*congr ('E_P[_]). - apply: funext => x/=. - rewrite sumr_map mulr_suml expR_sum prodr_map. - exact: eq_bigr.*) admit. +transitivity ('E_(pro P n)[ tuple_prod mmtX ])%R. + congr expectation => /=; apply: funext => x/=. + rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. + by rewrite !tnth_map. rewrite /mmtX. rewrite expectation_prod_independent_RVs; last first. admit. @@ -943,7 +948,7 @@ Qed. (* wrong lemma *) Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV pro n P >-> R} in + let X := bernoulli_trial X_ : {RV pro P n >-> R} in 'M_X t = ((p * expR t + (1-p))`^(n%:R))%:E. Proof. move: p01 => /andP[p0 p1] bX/=. @@ -958,8 +963,8 @@ Qed. Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : (0 <= t)%R -> is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV pro n P >-> R} in - 'M_X t <= (expR (fine 'E_(pro n P)[X] * (expR t - 1)))%:E. + let X := bernoulli_trial X_ : {RV pro P n >-> R} in + 'M_X t <= (expR (fine 'E_(pro P n)[X] * (expR t - 1)))%:E. Proof. move=> t0 bX/=. have /andP[p0 p1] := p01. @@ -975,7 +980,7 @@ Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in - let mu := 'E_(pro n P)[X] in + let mu := 'E_(pro P n)[X] in let t := ln (1 + delta) in (expR (expR t - 1) `^ fine mu)%:E * (expR (- t * (1 + delta)) `^ fine mu)%:E <= @@ -995,13 +1000,13 @@ Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {RV P >-> bool}) (delta : R is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in - let mu := 'E_(pro n P)[X] in - (pro n P) [set i | X i >= (1 + delta) * fine mu]%R <= + let mu := 'E_(pro P n)[X] in + (pro P n) [set i | X i >= (1 + delta) * fine mu]%R <= ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. Proof. rewrite /= => bX delta0. set X := @bernoulli_trial n X_. -set mu := 'E_(pro n P)[X]. +set mu := 'E_(pro P n)[X]. set t := ln (1 + delta). have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. apply: (le_trans (chernoff _ _ t0)). @@ -1017,10 +1022,10 @@ Qed. Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> let X' := @bernoulli_trial n X in - let mu := 'E_(pro n P)[X'] in + let mu := 'E_(pro P n)[X'] in (0 < n)%nat -> (0 < delta < 1)%R -> - (pro n P) [set i | X' i >= (1 + delta) * fine mu]%R <= + (pro P n) [set i | X' i >= (1 + delta) * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3))%:E. Proof. move=> bX X' mu n0 /[dup] delta01 /andP[delta0 _]. @@ -1043,18 +1048,18 @@ Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> (0 < delta < 1)%R -> - let X' := @bernoulli_trial n X : {RV pro n P >-> R} in - let mu := 'E_(pro n P)[X'] in - (pro n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. + let X' := @bernoulli_trial n X : {RV pro P n >-> R} in + let mu := 'E_(pro P n)[X'] in + (pro P n) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. Proof. move=> bX /andP[delta0 delta1] /=. -set X' := @bernoulli_trial n X : {RV pro n P >-> R}. -set mu := 'E_(pro n P)[X']. +set X' := @bernoulli_trial n X : {RV pro P n >-> R}. +set mu := 'E_(pro P n)[X']. have /andP[p0 p1] := p01. apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). (* using Markov's inequality somewhere, see mu's book page 66 *) have H1 t : (t < 0)%R -> - (pro n P) [set i | (X' i <= (1 - delta) * fine mu)%R] = (pro n P) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. + (pro P n) [set i | (X' i <= (1 - delta) * fine mu)%R] = (pro P n) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. move=> t0; apply: congr1; apply: eq_set => x /=. rewrite lee_fin ger0_norm ?expR_ge0// ler_expR (mulrC _ t) -mulrA. by rewrite -[in RHS]ler_ndivrMl// mulrA mulVf ?lt_eqF// mul1r. @@ -1064,16 +1069,16 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine rewrite -oppr0 ltrNr -lnV ?posrE ?subr_gt0// ln_gt0//. by rewrite invf_gt1// ?subr_gt0// ltrBlDr ltrDl. have {H1}-> := H1 _ ln1delta. - apply: (@le_trans _ _ (((fine 'E_(pro n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). + apply: (@le_trans _ _ (((fine 'E_(pro P n)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite EFinM lee_pdivl_mulr ?expR_gt0// muleC fineK. - apply: (@markov _ _ _ (pro n P) (expR \o t \o* X' : {RV (pro n P) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + apply: (@markov _ _ _ (pro P n) (expR \o t \o* X' : {RV (pro P n) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. - apply: expR_gt0. - rewrite norm_expR. - have -> : 'E_(pro n P)[expR \o t \o* X'] = 'M_X' t by []. + have -> : 'E_(pro P n)[expR \o t \o* X'] = 'M_X' t by []. by rewrite (binomial_mmt_gen_fun _ bX). apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. - have -> : 'E_(pro n P)[expR \o t \o* X'] = 'M_X' t by []. + have -> : 'E_(pro P n)[expR \o t \o* X'] = 'M_X' t by []. rewrite (binomial_mmt_gen_fun _ bX)/=. rewrite /mu /X' (expectation_bernoulli_trial bX)/=. rewrite !lnK ?posrE ?subr_gt0//. @@ -1144,13 +1149,13 @@ Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : (0 < n)%nat -> (0 < p)%R -> let X' := @bernoulli_trial n X in - let mu := 'E_(pro n P)[X'] in - (pro n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= + let mu := 'E_(pro P n)[X'] in + (pro P n) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. Proof. move=> bX /andP[d0 d1] n0 p0 /=. set X' := @bernoulli_trial n X. -set mu := 'E_(pro n P)[X']. +set mu := 'E_(pro P n)[X']. under eq_set => x. rewrite ler_normr. rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. @@ -1193,10 +1198,10 @@ Theorem sampling n (X : n.-tuple {RV P >-> bool}) (theta delta : R) : is_bernoulli_trial X -> (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> - (pro n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. + (pro P n) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. Proof. move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. -have E_X_sum: 'E_(pro n P)[X_sum] = (p * n%:R)%:E. +have E_X_sum: 'E_(pro P n)[X_sum] = (p * n%:R)%:E. by rewrite /X_sum expectation_bernoulli_trial// mulrC. have /andP[_ p1] := p01. set epsilon := theta / p. @@ -1204,9 +1209,9 @@ have epsilon01 : (0 < epsilon < 1)%R. by rewrite /epsilon ?ltr_pdivrMr ?divr_gt0 ?mul1r. have thetaE : theta = (epsilon * p)%R. by rewrite /epsilon -mulrA mulVf ?mulr1// gt_eqF. -have step1 : (pro n P) [set i | `| X' i - p | >= epsilon * p]%R <= +have step1 : (pro P n) [set i | `| X' i - p | >= epsilon * p]%R <= ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. - rewrite [X in (pro n P) X <= _](_ : _ = + rewrite [X in (pro P n) X <= _](_ : _ = [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. apply/seteqP; split => [t|t]/=. move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. @@ -1221,7 +1226,7 @@ have step1 : (pro n P) [set i | `| X' i - p | >= epsilon * p]%R <= have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -E_X_sum. exact: (@bernoulli_trial_inequality4 _ X epsilon bX). -have step2 : (pro n P) [set i | `| X' i - p | >= theta]%R <= +have step2 : (pro P n) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. @@ -1230,8 +1235,8 @@ have step2 : (pro n P) [set i | `| X' i - p | >= theta]%R <= rewrite mulrCA ler_wpM2l ?(ltW theta0)//. rewrite [X in (_ * X)%R]mulrA mulVf ?gt_eqF// -[leLHS]mul1r [in leRHS]mul1r. by rewrite ler_wpM2r// invf_ge1. -suff : delta%:E >= (pro n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. - rewrite [X in (pro n P) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. +suff : delta%:E >= (pro P n) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. + rewrite [X in (pro P n) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. apply/seteqP; split => [t|t]/=. by rewrite leNgt => /negP. by rewrite ltNge => /negP/negPn. From bd77f482334b7bf193a13b8a811ccba4620c201c Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Thu, 27 Feb 2025 15:47:10 +0900 Subject: [PATCH 45/73] mprod --- theories/sampling.v | 69 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 59 insertions(+), 10 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 11de3764a1..e32de7df4a 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -565,19 +565,68 @@ Definition Z d {T : measurableType d} m Section pro. Context d (T : measurableType d) (R : realType) (P : probability T R). -Definition mpro (n : nat) : set (mtuple n T) -> \bar R. -induction n. - apply: @dirac _ (mtuple 0 T) _ R. - exact: [::]. -move=> A. -pose A' := (fun x => (thead x, [tuple of behead x])) @` A. -apply: (@product_measure1 _ _ _ _ _ P IHn). -exact: A'. -Defined. +Fixpoint mpro (n : nat) : set (mtuple n T) -> \bar R := + match n with + | 0%N => \d_([::] : mtuple 0 T) + | m.+1 => fun A => (P \x^ @mpro m)%E [set (thead x, [tuple of behead x]) | x in A] + end. -Definition pro (n : nat) : probability (mtuple n T) R. +Lemma mpro_measure n : @mpro n set0 = 0 /\ (forall A, (0 <= @mpro n A)%E) /\ semi_sigma_additive (@mpro n). +Proof. +elim: n => //= [|n ih]; first by repeat split => //; exact: measure_semi_sigma_additive. +pose build_Mpro := isMeasure.Build _ _ _ (@mpro n) ih.1 ih.2.1 ih.2.2. +pose Mpro : measure _ R := HB.pack (@mpro n) build_Mpro. +pose ppro : measure _ R := (P \x^ Mpro)%E. +split. + rewrite image_set0 /product_measure2/=. + under eq_fun => x do rewrite ysection0 measure0 (_ : 0 = cst 0 x)//. + rewrite (_ : @mpro n = Mpro)//. + by rewrite integral_cst// mul0e. +split. + by move => A; rewrite (_ : @mpro n = Mpro). +rewrite (_ : @mpro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. +move=> F mF dF mUF. +rewrite image_bigcup. +apply: measure_semi_sigma_additive. +- move=> i. + admit. +- apply/trivIsetP => i j _ _ ineqj. + have := dF. + move/trivIsetP/(_ i j Logic.I Logic.I ineqj). + admit. +apply: bigcup_measurable => j _. +admit. Admitted. +HB.instance Definition _ n := + isMeasure.Build _ _ _ (@mpro n) (@mpro_measure n).1 (@mpro_measure n).2.1 (@mpro_measure n).2.2. + +Lemma mpro_setT n : @mpro n setT = 1%E. +Proof. +elim: n => //=; first by rewrite diracT. +move=> n ih. +rewrite /product_measure2/ysection/=. +under eq_fun => x. + rewrite [X in P X](_ : _ = [set: T]); last first. + under eq_fun => y. rewrite [X in _ \in X](_ : _ = setT); last first. + apply: funext=> z/=. + apply: propT. + exists (z.1 :: z.2) => //=. + case: z => z1 z2/=. + congr pair. + exact/val_inj. + over. + by apply: funext => y/=; rewrite in_setT trueE. + rewrite probability_setT. + over. +by rewrite integral_cst// mul1e. +Qed. + +HB.instance Definition _ n := + Measure_isProbability.Build _ _ _ (@mpro n) (@mpro_setT n). + +Definition pro (n : nat) : probability (mtuple n T) R := @mpro n. + End pro. Arguments pro {d T R} P n. From 335d8c8edeca320c0c3497c98390f951f65057b5 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 2 Mar 2025 19:59:48 +0900 Subject: [PATCH 46/73] cons is measurable - rm warnings, \X notation --- theories/sampling.v | 320 +++++++++++++++++++++++++++++++++----------- 1 file changed, 243 insertions(+), 77 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index e32de7df4a..5bc6f04795 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -520,7 +520,8 @@ HB.instance Definition _ (n : nat) (T : pointedType) := Definition mtuple (n : nat) d (T : measurableType d) : Type := n.-tuple T. -HB.instance Definition _ (n : nat) d (T : measurableType d) := Pointed.on (mtuple n T). +HB.instance Definition _ (n : nat) d (T : measurableType d) := + Pointed.on (mtuple n T). Lemma countable_range_bool d (T : measurableType d) (b : bool) : countable (range (@cst T _ b)). @@ -562,23 +563,152 @@ Definition Z d {T : measurableType d} m (J : {fset 'I_m}%fset) : set_system (m.-tuple T) := [set B | exists A, B = cylinder A J]. +Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : + measurable_fun [set: mtuple n 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. + +Lemma g_sigma_preimage_comp + [d1 : measure_display] [T1 : semiRingOfSetsType d1] n + [T : pointedType] (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : +g_sigma_preimage (fun i => (f1 i \o g)) = +preimage_set_system [set: T3] g (g_sigma_preimage f1). +Proof. +rewrite {1}/g_sigma_preimage. +rewrite -g_sigma_preimageE; congr (<>). +rewrite predeqE => C; split. +- (*move=> [i A mA <-{C}]. + + by exists (f1 @^-1` A) => //; left; exists A => //; rewrite setTI. + + by exists (f2 @^-1` A) => //; right; exists A => //; rewrite setTI.*) admit. +- move=> [A mA <-{C}]. +(* [A [[B mB <-{A} <-{C}]]]. + + by left; rewrite !setTI; exists B => //; rewrite setTI. + + by right; rewrite !setTI; exists B => //; rewrite setTI. +*) +Admitted. + +Section prod_measurable_fun. +Context d d1 (T : measurableType d) (T1 : measurableType d1). + +Lemma prod_measurable_funP (n : nat) (h : T -> mtuple n T1) : measurable_fun setT h <-> + forall i : 'I_n, measurable_fun setT ((@tnth _ T1 ^~ i) \o h). +Proof. +apply: (@iff_trans _ (g_sigma_preimage + (fun i : 'I_n => (@tnth _ T1 ^~ i) \o h) `<=` measurable)). +- rewrite g_sigma_preimage_comp; split=> [mf A [C HC <-]|f12]. + by apply: mf => //. + by move=> _ A mA; apply: f12; exists A => //. +- split=> [h12|mh]. + move=> i _ A mA. + apply: h12. + apply: sub_sigma_algebra. + suff: + (\bigcup_(i0 < n) preimage_set_system [set: T] + ((nth point (T:=T1))^~ i0 \o h) d1.-measurable) + ([set: T] `&` ((tnth (T:=T1))^~ i \o h) @^-1` A). + admit. + exists i => //. + by red. + exists A => //. + rewrite !setTI. + rewrite /tnth. + congr (_ @^-1` A). + apply/funext => x. + rewrite /=. + apply: set_nth_default => //. + by rewrite size_tuple. + apply: smallest_sub; first exact: sigma_algebra_measurable. + suff: + \bigcup_(i < n) preimage_set_system [set: T] + ((nth point (T:=T1))^~ i \o h) d1.-measurable + `<=` d.-measurable. + admit. + apply: bigcup_sub => i Ii. + move=> A [C mC <-]. + have := mh (Ordinal Ii). + rewrite /measurable_fun. + admit. +Admitted. + +Lemma measurable_fun_prod (f : T -> T1) n (g : T -> mtuple n T1) : + measurable_fun setT f -> measurable_fun setT g -> + measurable_fun setT (fun x : T => [the mtuple n.+1 T1 of (f x) :: (g x)]). +Proof. +move=> mf mg. +apply/prod_measurable_funP => /= i. +have [->|i0] := eqVneq i ord0. + by rewrite (_ : _ \o _ = f)//. +have @j : 'I_n. + apply: (@Ordinal _ i.-1). + rewrite prednK//. + have := ltn_ord i. + by rewrite ltnS. + by rewrite lt0n. +rewrite (_ : _ \o _ = (fun x => tnth (g x) j))//. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n T1 => tnth x j) _ g) => //. + by apply: measurable_tnth. +apply/funext => t/=. +rewrite (_ : i = lift ord0 j)//. +by rewrite tnthS. +apply/val_inj => /=. +by rewrite /bump/= add1n prednK// lt0n. + +Qed. + +End prod_measurable_fun. + + +Lemma measurable_cons d (T : measurableType d) n : measurable_fun [set: T * mtuple n T] + (fun x : T * mtuple n T => [the mtuple n.+1 T of x.1 :: x.2]). +Proof. +move=> _ /= Y mY; rewrite setTI. +red. +simpl. +red. +apply: sub_sigma_algebra. +red. +simpl. +rewrite /preimage_set_system/=. + + +Lemma measurable_cons d (T : measurableType d) n : measurable_fun [set: T * mtuple n T] + (fun x : T * mtuple n T => [the mtuple n.+1 T of x.1 :: x.2]). +Proof. +move=> _ /= Y mY; rewrite setTI. +red. +simpl. +red. +apply: sub_sigma_algebra. +red. +simpl. +rewrite /preimage_set_system/=. + + + + Section pro. Context d (T : measurableType d) (R : realType) (P : probability T R). + Fixpoint mpro (n : nat) : set (mtuple n T) -> \bar R := match n with | 0%N => \d_([::] : mtuple 0 T) | m.+1 => fun A => (P \x^ @mpro m)%E [set (thead x, [tuple of behead x]) | x in A] end. -Lemma mpro_measure n : @mpro n set0 = 0 /\ (forall A, (0 <= @mpro n A)%E) /\ semi_sigma_additive (@mpro n). +Lemma mpro_measure n : @mpro n set0 = 0 /\ (forall A, (0 <= @mpro n A)%E) + /\ semi_sigma_additive (@mpro n). Proof. -elim: n => //= [|n ih]; first by repeat split => //; exact: measure_semi_sigma_additive. +elim: n => //= [|n ih]. + by repeat split => //; exact: measure_semi_sigma_additive. pose build_Mpro := isMeasure.Build _ _ _ (@mpro n) ih.1 ih.2.1 ih.2.2. pose Mpro : measure _ R := HB.pack (@mpro n) build_Mpro. pose ppro : measure _ R := (P \x^ Mpro)%E. split. - rewrite image_set0 /product_measure2/=. + rewrite image_set0 /product_measure2 /=. under eq_fun => x do rewrite ysection0 measure0 (_ : 0 = cst 0 x)//. rewrite (_ : @mpro n = Mpro)//. by rewrite integral_cst// mul0e. @@ -589,11 +719,28 @@ move=> F mF dF mUF. rewrite image_bigcup. apply: measure_semi_sigma_additive. - move=> i. + pose f (t : n.+1.-tuple T) := (@thead n T t, [the mtuple _ T of behead t]). + pose f' (x : T * mtuple n T) := [the mtuple n.+1 T of x.1 :: x.2]. + rewrite [X in measurable X](_ : _ = f' @^-1` F i); last first. + apply/seteqP; split=> [x/= [t Fit] <-{x}|[x1 x2] /= Fif']. + rewrite /f'/=. + by rewrite (tuple_eta t) in Fit. + exists (f' (x1, x2)) => //. + rewrite /f' /= theadE//; congr pair. + exact/val_inj. + rewrite -[X in measurable X]setTI. + suff: measurable_fun setT f' by exact. + rewrite /= /f'. admit. -- apply/trivIsetP => i j _ _ ineqj. - have := dF. - move/trivIsetP/(_ i j Logic.I Logic.I ineqj). - admit. +- (* TODO: lemma? *) + apply/trivIsetP => i j _ _ ij. + move/trivIsetP : dF => /(_ i j Logic.I Logic.I ij). + rewrite -!subset0 => ij0 /= [_ _] [[t Fit] [<- <-]]/=. + move=> [u Fju [hut tut]]. + have := ij0 t; apply; split => //. + suff: t = u by move=> ->. + rewrite (tuple_eta t) (tuple_eta u) hut. + by apply/val_inj => /=; rewrite tut. apply: bigcup_measurable => j _. admit. Admitted. @@ -630,6 +777,9 @@ Definition pro (n : nat) : probability (mtuple n T) R := @mpro n. End pro. Arguments pro {d T R} P n. +Notation "\X_ n P" := (pro P n) (at level 10, n, P at next level, + format "\X_ n P"). + Section bernoulli. Local Open Scope ereal_scope. @@ -643,7 +793,7 @@ Definition bernoulli_RV (X : {RV P >-> bool}) := Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> P [set i | X i == 1%R] = p%:E. Proof. -move=> [[/(congr1 (fun f => f [set 1%:R]))]]. +move=> /(congr1 (fun f => f [set 1%:R])). rewrite bernoulliE//. rewrite /mscale/=. rewrite diracE/= mem_set// mule1// diracE/= memNset//. @@ -657,7 +807,7 @@ Qed. Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> P [set i | X i == 0%R] = (`1-p)%:E. Proof. -move=> [[/(congr1 (fun f => f [set 0%:R]))]]. +move=> /(congr1 (fun f => f [set 0%:R])). rewrite bernoulliE//. rewrite /mscale/=. rewrite diracE/= memNset//. @@ -686,7 +836,8 @@ Lemma integrable_bernoulli (X : {RV P >-> bool}) : bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). Proof. move=> bX. -apply/integrableP; split; first by apply: measurableT_comp => //; exact: measurable_bool_to_real. +apply/integrableP; split. + by apply: measurableT_comp => //; exact: measurable_bool_to_real. have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. rewrite unlock /expectation. apply: eq_integral => x _. @@ -726,14 +877,6 @@ Defined. Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. -Lemma measurable_tnth n (i : 'I_n) : - measurable_fun [set: mtuple n 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. - Lemma measurable_tuple_sum n (s : n.-tuple {mfun T >-> R}) : measurable_fun setT (tuple_sum s). Proof. @@ -757,7 +900,7 @@ Qed. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := isMeasurableFun.Build _ _ _ _ (tuple_prod s) (measurable_tuple_prod s). -Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (pro P n) >-> R} := +Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R} := tuple_sum [the n.-tuple _ of (map (btr P) (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. @@ -769,60 +912,81 @@ Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} : Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) : (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_(pro P n)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). + 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). Proof. -move: n X. -elim => [X|n IH X] /= intX. -- rewrite /tuple_sum. +elim: n X => [X|n IH X] /= intX. + rewrite /tuple_sum. under eq_fun do rewrite big_ord0. by rewrite big_ord0 expectation_cst. -pose X0 := tnth X ord0. +pose X0 := thead X. have intX0 : P.-integrable [set: T] (EFin \o X0). by apply: intX; rewrite mem_tnth. have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). by move=> XiX; exact: intX. -rewrite big_ord_recr/=. +rewrite big_ord_recl/=. rewrite /tuple_sum/=. -under eq_fun do rewrite big_ord_recr/=. -pose X1 := fun x : mtuple n.+1 T => - (\sum_(i < n) MeasurableFun.sort (tnth X (widen_ord (leqnSn n) i)) (tnth x (widen_ord (leqnSn n) i)))%R. +under eq_fun do rewrite big_ord_recl/=. +pose X1 (x : mtuple n.+1 T) := + (\sum_(i < n) (tnth X (lift ord0 i)) (tnth x (lift ord0 i)))%R. have mX1 : measurable_fun setT X1. apply: measurable_sum => /= i; apply: measurableT_comp => //. exact: measurable_tnth. pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. -pose X2 := fun x : mtuple n.+1 T => - MeasurableFun.sort (tnth X ord_max) (tnth x ord_max). +pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). have mX2 : measurable_fun setT X2. rewrite /X2 /=. by apply: measurableT_comp => //; exact: measurable_tnth. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. -rewrite [X in 'E__[X]](_ : _ = Y1 \+ Y2)//. +rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. rewrite expectationD; last 2 first. admit. admit. -congr (_ + _); last first. -- rewrite /Y1/X1/=. - rewrite unlock /expectation. - pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord_max). +congr (_ + _). +- rewrite /Y2 /X2/= unlock /expectation. + (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) + pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). have mphi : measurable_fun setT phi. exact: measurable_tnth. - rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ (fun w => (tnth X ord_max w)%:E)); last 2 first. + rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ + (fun w => (tnth X ord0 w)%:E)); last 2 first. exact/measurable_EFinP. admit. - congr (\int[_]__ _). + apply: eq_measure_integral => //= A mA _. rewrite /pushforward. - apply: funext => x. - admit. (* priority? *) -rewrite /Y2/X2/=. + rewrite /pro/= /phi. + rewrite [X in (_ \x^ _) X = _](_ : + [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] + = A `*` setT); last first. + apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. + move=> [x1 x2]/= [Ax1 _]. + exists [the mtuple _ _ of x1 :: x2] => //=. + by rewrite theadE; congr pair => //; exact/val_inj. + by rewrite product_measure2E//= mpro_setT mule1. +- rewrite /Y1 /X1/=. + transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. + apply: eq_bigr => /= i _. + congr expectation. + rewrite tnth_behead. + congr (tnth X). + apply/val_inj => /=. + by rewrite /bump/= add1n/= inordK// ltnS. + rewrite -IH; last first. + move=> Xi XiX. + admit. + transitivity ('E_\X_n P[(fun x : mtuple n T => + (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). + rewrite unlock /expectation. + admit. + by []. Admitted. Lemma expectation_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : - is_bernoulli_trial X -> 'E_(pro P n)[bernoulli_trial X] = (n%:R * p)%:E. + is_bernoulli_trial X -> 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. Proof. move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(pro P n)[tuple_sum (map (btr P) X)]). +transitivity ('E_(\X_n P)[tuple_sum (map (btr P) X)]). congr expectation; apply/funext => t. by apply: eq_bigr => /= i _; rewrite !tnth_map. rewrite expectation_sum_pro; last first. @@ -925,7 +1089,7 @@ Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : independent_RVs P `I_n (fun i => nth (@cst T R 0%R : {mfun T >-> R}) (map (fun x : {RV P >-> R} => x : {mfun T >-> R}) X) i) -> - 'E_(pro P n)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. + 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. Admitted. @@ -941,8 +1105,10 @@ pose mmtX : n.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) (map (btr P) X_). (*pose mmtX (i : 'I_n) : {RV P >-> R} := expR \o t \o* (btr P (tnth X_ i)).*) have iRV_mmtX : independent_RVs P setT (fun i => tnth mmtX i). + have f0 : {mfun T >-> bool}. admit. + have := @independent_mmt_gen_fun ([sequence (nth f0 X_ k) ]_k) n t. (*exact: independent_mmt_gen_fun.*) admit. -transitivity ('E_(pro P n)[ tuple_prod mmtX ])%R. +transitivity ('E_(\X_n P)[ tuple_prod mmtX ])%R. congr expectation => /=; apply: funext => x/=. rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. by rewrite !tnth_map. @@ -997,8 +1163,8 @@ Qed. (* wrong lemma *) Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV pro P n >-> R} in - 'M_X t = ((p * expR t + (1-p))`^(n%:R))%:E. + let X := bernoulli_trial X_ : {RV \X_n P >-> R} in + 'M_X t = ((p * expR t + (1 - p))`^(n%:R))%:E. Proof. move: p01 => /andP[p0 p1] bX/=. rewrite bernoulli_trial_mmt_gen_fun//. @@ -1012,8 +1178,8 @@ Qed. Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : (0 <= t)%R -> is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV pro P n >-> R} in - 'M_X t <= (expR (fine 'E_(pro P n)[X] * (expR t - 1)))%:E. + let X := bernoulli_trial X_ : {RV \X_n P >-> R} in + 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. Proof. move=> t0 bX/=. have /andP[p0 p1] := p01. @@ -1029,7 +1195,7 @@ Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in - let mu := 'E_(pro P n)[X] in + let mu := 'E_(\X_n P)[X] in let t := ln (1 + delta) in (expR (expR t - 1) `^ fine mu)%:E * (expR (- t * (1 + delta)) `^ fine mu)%:E <= @@ -1049,13 +1215,13 @@ Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {RV P >-> bool}) (delta : R is_bernoulli_trial X_ -> (0 < delta)%R -> let X := @bernoulli_trial n X_ in - let mu := 'E_(pro P n)[X] in - (pro P n) [set i | X i >= (1 + delta) * fine mu]%R <= + let mu := 'E_(\X_n P)[X] in + (\X_n P) [set i | X i >= (1 + delta) * fine mu]%R <= ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. Proof. rewrite /= => bX delta0. set X := @bernoulli_trial n X_. -set mu := 'E_(pro P n)[X]. +set mu := 'E_(\X_n P)[X]. set t := ln (1 + delta). have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. apply: (le_trans (chernoff _ _ t0)). @@ -1071,10 +1237,10 @@ Qed. Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> let X' := @bernoulli_trial n X in - let mu := 'E_(pro P n)[X'] in + let mu := 'E_(\X_n P)[X'] in (0 < n)%nat -> (0 < delta < 1)%R -> - (pro P n) [set i | X' i >= (1 + delta) * fine mu]%R <= + (\X_n P) [set i | X' i >= (1 + delta) * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3))%:E. Proof. move=> bX X' mu n0 /[dup] delta01 /andP[delta0 _]. @@ -1097,18 +1263,18 @@ Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> (0 < delta < 1)%R -> - let X' := @bernoulli_trial n X : {RV pro P n >-> R} in - let mu := 'E_(pro P n)[X'] in - (pro P n) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. + let X' := @bernoulli_trial n X : {RV \X_n P >-> R} in + let mu := 'E_(\X_n P)[X'] in + (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. Proof. move=> bX /andP[delta0 delta1] /=. -set X' := @bernoulli_trial n X : {RV pro P n >-> R}. -set mu := 'E_(pro P n)[X']. +set X' := @bernoulli_trial n X : {RV \X_n P >-> R}. +set mu := 'E_(\X_n P)[X']. have /andP[p0 p1] := p01. apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). (* using Markov's inequality somewhere, see mu's book page 66 *) have H1 t : (t < 0)%R -> - (pro P n) [set i | (X' i <= (1 - delta) * fine mu)%R] = (pro P n) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. + (\X_n P) [set i | (X' i <= (1 - delta) * fine mu)%R] = (\X_n P) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. move=> t0; apply: congr1; apply: eq_set => x /=. rewrite lee_fin ger0_norm ?expR_ge0// ler_expR (mulrC _ t) -mulrA. by rewrite -[in RHS]ler_ndivrMl// mulrA mulVf ?lt_eqF// mul1r. @@ -1118,16 +1284,16 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine rewrite -oppr0 ltrNr -lnV ?posrE ?subr_gt0// ln_gt0//. by rewrite invf_gt1// ?subr_gt0// ltrBlDr ltrDl. have {H1}-> := H1 _ ln1delta. - apply: (@le_trans _ _ (((fine 'E_(pro P n)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). - rewrite EFinM lee_pdivl_mulr ?expR_gt0// muleC fineK. - apply: (@markov _ _ _ (pro P n) (expR \o t \o* X' : {RV (pro P n) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + apply: (@le_trans _ _ (((fine 'E_(\X_n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). + rewrite EFinM lee_pdivlMr ?expR_gt0// muleC fineK. + apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X' : {RV (\X_n P) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. - apply: expR_gt0. - rewrite norm_expR. - have -> : 'E_(pro P n)[expR \o t \o* X'] = 'M_X' t by []. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. by rewrite (binomial_mmt_gen_fun _ bX). apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. - have -> : 'E_(pro P n)[expR \o t \o* X'] = 'M_X' t by []. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. rewrite (binomial_mmt_gen_fun _ bX)/=. rewrite /mu /X' (expectation_bernoulli_trial bX)/=. rewrite !lnK ?posrE ?subr_gt0//. @@ -1198,13 +1364,13 @@ Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : (0 < n)%nat -> (0 < p)%R -> let X' := @bernoulli_trial n X in - let mu := 'E_(pro P n)[X'] in - (pro P n) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= + let mu := 'E_(\X_n P)[X'] in + (\X_n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. Proof. move=> bX /andP[d0 d1] n0 p0 /=. set X' := @bernoulli_trial n X. -set mu := 'E_(pro P n)[X']. +set mu := 'E_(\X_n P)[X']. under eq_set => x. rewrite ler_normr. rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. @@ -1228,7 +1394,7 @@ rewrite measureU; last 3 first. rewrite !EFinM. rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. by rewrite fineK /mu/X' (expectation_bernoulli_trial bX)// lte_fin mulr_gt0 ?ltr0n. -rewrite mulr2n EFinD lee_add//=. +rewrite mulr2n EFinD leeD//=. - by apply: (bernoulli_trial_inequality2 bX); rewrite //d0 d1. - have d01 : (0 < delta < 1)%R by rewrite d0. apply: (le_trans (@bernoulli_trial_inequality3 _ X delta bX d01)). @@ -1247,10 +1413,10 @@ Theorem sampling n (X : n.-tuple {RV P >-> bool}) (theta delta : R) : is_bernoulli_trial X -> (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> - (pro P n) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. + (\X_n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. Proof. move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. -have E_X_sum: 'E_(pro P n)[X_sum] = (p * n%:R)%:E. +have E_X_sum: 'E_(\X_n P)[X_sum] = (p * n%:R)%:E. by rewrite /X_sum expectation_bernoulli_trial// mulrC. have /andP[_ p1] := p01. set epsilon := theta / p. @@ -1258,9 +1424,9 @@ have epsilon01 : (0 < epsilon < 1)%R. by rewrite /epsilon ?ltr_pdivrMr ?divr_gt0 ?mul1r. have thetaE : theta = (epsilon * p)%R. by rewrite /epsilon -mulrA mulVf ?mulr1// gt_eqF. -have step1 : (pro P n) [set i | `| X' i - p | >= epsilon * p]%R <= +have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. - rewrite [X in (pro P n) X <= _](_ : _ = + rewrite [X in (\X_n P) X <= _](_ : _ = [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. apply/seteqP; split => [t|t]/=. move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. @@ -1275,7 +1441,7 @@ have step1 : (pro P n) [set i | `| X' i - p | >= epsilon * p]%R <= have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -E_X_sum. exact: (@bernoulli_trial_inequality4 _ X epsilon bX). -have step2 : (pro P n) [set i | `| X' i - p | >= theta]%R <= +have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. @@ -1284,8 +1450,8 @@ have step2 : (pro P n) [set i | `| X' i - p | >= theta]%R <= rewrite mulrCA ler_wpM2l ?(ltW theta0)//. rewrite [X in (_ * X)%R]mulrA mulVf ?gt_eqF// -[leLHS]mul1r [in leRHS]mul1r. by rewrite ler_wpM2r// invf_ge1. -suff : delta%:E >= (pro P n) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. - rewrite [X in (pro P n) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. +suff : delta%:E >= (\X_n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. + rewrite [X in (\X_n P) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. apply/seteqP; split => [t|t]/=. by rewrite leNgt => /negP. by rewrite ltNge => /negP/negPn. From ec7be0577d3f62fbdd314ef04fd6f7f7382d488e Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 3 Mar 2025 23:10:56 +0900 Subject: [PATCH 47/73] integration over iterated product (wip) --- theories/sampling.v | 231 +++++++++++++++++++++++++++++--------------- 1 file changed, 151 insertions(+), 80 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 5bc6f04795..959e13dcff 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -472,7 +472,9 @@ Section mfunM. Context {d} (T : measurableType d) {R : realType}. HB.instance Definition _ (f g : {mfun T >-> R}) := - @isMeasurableFun.Build d _ _ _ (f \* g)%R (measurable_funM (@measurable_funP _ _ _ _ f) ((@measurable_funP _ _ _ _ g))). + @isMeasurableFun.Build d _ _ _ (f \* g)%R + (measurable_funM (@measurable_funP _ _ _ _ f) + ((@measurable_funP _ _ _ _ g))). End mfunM. @@ -571,6 +573,19 @@ rewrite -bigcup_seq/=; exists i => //=; first by rewrite mem_index_enum. by exists Y => //; rewrite setTI. Qed. +Section move_to_bigop_nat_lemmas. +Context {T : Type}. +Implicit Types (A : set T). + +Lemma bigcup_mkord_ord n (F : 'I_n.+1 -> set T) : + \bigcup_(i < n.+1) F (inord i) = \big[setU/set0]_(i < n.+1) F i. +Proof. +rewrite bigcup_mkord; apply: eq_bigr => /= i _; congr F. +by apply/val_inj => /=;rewrite inordK. +Qed. + +End move_to_bigop_nat_lemmas. + Lemma g_sigma_preimage_comp [d1 : measure_display] [T1 : semiRingOfSetsType d1] n [T : pointedType] (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : @@ -578,69 +593,65 @@ g_sigma_preimage (fun i => (f1 i \o g)) = preimage_set_system [set: T3] g (g_sigma_preimage f1). Proof. rewrite {1}/g_sigma_preimage. -rewrite -g_sigma_preimageE; congr (<>). +rewrite -g_sigma_preimageE; congr (<>). +destruct n as [|n]. + rewrite !big_ord0 /preimage_set_system/=. + by apply/esym; rewrite -subset0 => t/= []. rewrite predeqE => C; split. -- (*move=> [i A mA <-{C}]. - + by exists (f1 @^-1` A) => //; left; exists A => //; rewrite setTI. - + by exists (f2 @^-1` A) => //; right; exists A => //; rewrite setTI.*) admit. -- move=> [A mA <-{C}]. -(* [A [[B mB <-{A} <-{C}]]]. - + by left; rewrite !setTI; exists B => //; rewrite setTI. - + by right; rewrite !setTI; exists B => //; rewrite setTI. -*) -Admitted. +- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]]. + exists (f1 (Ordinal Ii) @^-1` A). + rewrite -bigcup_mkord_ord; exists i => //. + exists A => //; rewrite setTI// (_ : Ordinal _ = inord i)//. + by apply/val_inj => /=;rewrite inordK. + rewrite !setTI// -comp_preimage// (_ : Ordinal _ = inord i)//. + by apply/val_inj => /=;rewrite inordK. +- move=> [A]. + rewrite -bigcup_mkord_ord => -[i Ii [B mB <-{A}]] <-{C}. + rewrite -bigcup_mkord_ord. + exists i => //. + by exists B => //; rewrite !setTI -comp_preimage. +Qed. -Section prod_measurable_fun. +Section cons_measurable_fun. Context d d1 (T : measurableType d) (T1 : measurableType d1). -Lemma prod_measurable_funP (n : nat) (h : T -> mtuple n T1) : measurable_fun setT h <-> +Lemma cons_measurable_funP (n : nat) (h : T -> mtuple n T1) : + measurable_fun setT h <-> forall i : 'I_n, measurable_fun setT ((@tnth _ T1 ^~ i) \o h). Proof. apply: (@iff_trans _ (g_sigma_preimage (fun i : 'I_n => (@tnth _ T1 ^~ i) \o h) `<=` measurable)). - rewrite g_sigma_preimage_comp; split=> [mf A [C HC <-]|f12]. - by apply: mf => //. - by move=> _ A mA; apply: f12; exists A => //. + exact: mf. + by move=> _ A mA; apply: f12; exists A. - split=> [h12|mh]. move=> i _ A mA. apply: h12. apply: sub_sigma_algebra. - suff: - (\bigcup_(i0 < n) preimage_set_system [set: T] - ((nth point (T:=T1))^~ i0 \o h) d1.-measurable) - ([set: T] `&` ((tnth (T:=T1))^~ i \o h) @^-1` A). - admit. - exists i => //. - by red. + destruct n as [|n]. + by case: i => [] []. + rewrite -bigcup_mkord_ord. + exists i => //; first by red. exists A => //. rewrite !setTI. - rewrite /tnth. - congr (_ @^-1` A). - apply/funext => x. - rewrite /=. - apply: set_nth_default => //. - by rewrite size_tuple. + rewrite (_ : inord i = i)//. + by apply/val_inj => /=; rewrite inordK. apply: smallest_sub; first exact: sigma_algebra_measurable. - suff: - \bigcup_(i < n) preimage_set_system [set: T] - ((nth point (T:=T1))^~ i \o h) d1.-measurable - `<=` d.-measurable. - admit. + destruct n as [|n]. + by rewrite big_ord0. + rewrite -bigcup_mkord_ord. apply: bigcup_sub => i Ii. move=> A [C mC <-]. - have := mh (Ordinal Ii). - rewrite /measurable_fun. - admit. -Admitted. + exact: mh. +Qed. -Lemma measurable_fun_prod (f : T -> T1) n (g : T -> mtuple n T1) : +Lemma measurable_fun_cons (f : T -> T1) n (g : T -> mtuple n T1) : measurable_fun setT f -> measurable_fun setT g -> measurable_fun setT (fun x : T => [the mtuple n.+1 T1 of (f x) :: (g x)]). Proof. -move=> mf mg. -apply/prod_measurable_funP => /= i. +move=> mf mg; apply/cons_measurable_funP => /= i. have [->|i0] := eqVneq i ord0. - by rewrite (_ : _ \o _ = f)//. + by rewrite (_ : _ \o _ = f). have @j : 'I_n. apply: (@Ordinal _ i.-1). rewrite prednK//. @@ -648,51 +659,38 @@ have @j : 'I_n. by rewrite ltnS. by rewrite lt0n. rewrite (_ : _ \o _ = (fun x => tnth (g x) j))//. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n T1 => tnth x j) _ g) => //. - by apply: measurable_tnth. + apply: (@measurableT_comp _ _ _ _ _ _ + (fun x : mtuple n T1 => tnth x j) _ g) => //. + exact: measurable_tnth. apply/funext => t/=. -rewrite (_ : i = lift ord0 j)//. -by rewrite tnthS. +rewrite (_ : i = lift ord0 j) ?tnthS//. apply/val_inj => /=. by rewrite /bump/= add1n prednK// lt0n. - Qed. -End prod_measurable_fun. +End cons_measurable_fun. +Section pro2. +Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} + (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). -Lemma measurable_cons d (T : measurableType d) n : measurable_fun [set: T * mtuple n T] - (fun x : T * mtuple n T => [the mtuple n.+1 T of x.1 :: x.2]). -Proof. -move=> _ /= Y mY; rewrite setTI. -red. -simpl. -red. -apply: sub_sigma_algebra. -red. -simpl. -rewrite /preimage_set_system/=. - - -Lemma measurable_cons d (T : measurableType d) n : measurable_fun [set: T * mtuple n T] - (fun x : T * mtuple n T => [the mtuple n.+1 T of x.1 :: x.2]). -Proof. -move=> _ /= Y mY; rewrite setTI. -red. -simpl. -red. -apply: sub_sigma_algebra. -red. -simpl. -rewrite /preimage_set_system/=. +Definition pro2 := product_measure2 P1 P2. +HB.instance Definition _ := Measure.on pro2. +Lemma pro2_setT : pro2 setT = 1%E. +Proof. +rewrite /pro2 -setXTT product_measure2E// -[RHS]mule1. +by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). +Qed. +HB.instance Definition _ := + Measure_isProbability.Build _ _ _ pro2 pro2_setT. +End pro2. Section pro. Context d (T : measurableType d) (R : realType) (P : probability T R). - Fixpoint mpro (n : nat) : set (mtuple n T) -> \bar R := match n with | 0%N => \d_([::] : mtuple 0 T) @@ -717,8 +715,10 @@ split. rewrite (_ : @mpro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. move=> F mF dF mUF. rewrite image_bigcup. +move=> [:save]. apply: measure_semi_sigma_additive. -- move=> i. +- abstract: save. + move=> i. pose f (t : n.+1.-tuple T) := (@thead n T t, [the mtuple _ T of behead t]). pose f' (x : T * mtuple n T) := [the mtuple n.+1 T of x.1 :: x.2]. rewrite [X in measurable X](_ : _ = f' @^-1` F i); last first. @@ -731,7 +731,7 @@ apply: measure_semi_sigma_additive. rewrite -[X in measurable X]setTI. suff: measurable_fun setT f' by exact. rewrite /= /f'. - admit. + exact: measurable_fun_cons. - (* TODO: lemma? *) apply/trivIsetP => i j _ _ ij. move/trivIsetP : dF => /(_ i j Logic.I Logic.I ij). @@ -741,12 +741,12 @@ apply: measure_semi_sigma_additive. suff: t = u by move=> ->. rewrite (tuple_eta t) (tuple_eta u) hut. by apply/val_inj => /=; rewrite tut. -apply: bigcup_measurable => j _. -admit. -Admitted. +- apply: bigcup_measurable => j _. + exact: save. +Qed. -HB.instance Definition _ n := - isMeasure.Build _ _ _ (@mpro n) (@mpro_measure n).1 (@mpro_measure n).2.1 (@mpro_measure n).2.2. +HB.instance Definition _ n := isMeasure.Build _ _ _ (@mpro n) + (@mpro_measure n).1 (@mpro_measure n).2.1 (@mpro_measure n).2.2. Lemma mpro_setT n : @mpro n setT = 1%E. Proof. @@ -780,6 +780,55 @@ Arguments pro {d T R} P n. Notation "\X_ n P" := (pro P n) (at level 10, n, P at next level, format "\X_ n P"). +Section proS. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Lemma integral_mpro n (f : n.+1.-tuple T -> R) : + \int[\X_n.+1 P]_w (f w)%:E = + \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. +Proof. +set phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. +have mphi : measurable_fun setT phi. + admit. +rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ + (fun x : mtuple n.+1 T => (f x)%:E)). + apply: eq_measure_integral => A mA _. + rewrite /=. + rewrite /pushforward. + rewrite /pro2. + rewrite /phi/=. + rewrite /preimage/=. + congr (_ _). + apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. + move: At. + by rewrite {1}(tuple_eta t)//. + exists (x.1 :: x.2) => //=. + destruct x as [x1 x2] => //=. + congr pair. + by apply/val_inj. +admit. +rewrite /=. +Admitted. + +End proS. + +Lemma fubini2' : +forall [d1 d2 : measure_display] [T1 : measurableType d1] + [T2 : measurableType d2] [R : realType] + [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] + f -> (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f intf. +rewrite fubini2//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC. +rewrite /=. +by rewrite product_measure2E. +Qed. + Section bernoulli. Local Open Scope ereal_scope. @@ -978,7 +1027,29 @@ congr (_ + _). transitivity ('E_\X_n P[(fun x : mtuple n T => (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). rewrite unlock /expectation. - admit. + transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). + rewrite integral_mpro//. + apply: eq_integral => /= -[w1 w2] _. + rewrite -!sumEFin. + apply: eq_bigr => i _ /=. + by rewrite tnthS//. + rewrite /pro2. + rewrite -fubini2'/=; last first. + admit. + apply: eq_integral => t _. + rewrite /fubini_G. + transitivity (\sum_(i < n) + (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). + (* TODO: prove ge0_integral_sum for integrable *) + admit. + rewrite -sumEFin. + apply: eq_bigr => /= i _. + rewrite integral_cst//. + rewrite [X in _ * X]probability_setT mule1. + rewrite tnth_behead//=. + congr (tnth X _ _)%:E. + apply/val_inj => /=. + by rewrite inordK// ltnS. by []. Admitted. From cd6d029e512f53aa09a1dd305f9d287b3846e3b3 Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Wed, 5 Mar 2025 20:38:54 +0900 Subject: [PATCH 48/73] add integrability assumption to integraal_mpro --- theories/sampling.v | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 959e13dcff..3795689ac7 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -645,6 +645,7 @@ apply: (@iff_trans _ (g_sigma_preimage exact: mh. Qed. +(* TODO: rename to measurable_cons *) Lemma measurable_fun_cons (f : T -> T1) n (g : T -> mtuple n T1) : measurable_fun setT f -> measurable_fun setT g -> measurable_fun setT (fun x : T => [the mtuple n.+1 T1 of (f x) :: (g x)]). @@ -785,14 +786,16 @@ Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. Lemma integral_mpro n (f : n.+1.-tuple T -> R) : + measurable_fun [set: mtuple n.+1 T] f -> + (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f) -> \int[\X_n.+1 P]_w (f w)%:E = \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. +move=> mf intf. set phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. -have mphi : measurable_fun setT phi. - admit. +have mphi : measurable_fun [set: T * mtuple _ _] phi by exact: measurable_fun_cons. rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ - (fun x : mtuple n.+1 T => (f x)%:E)). + (fun x : mtuple n.+1 T => (f x)%:E)); [|exact: (measurable_comp measurableT)|]. apply: eq_measure_integral => A mA _. rewrite /=. rewrite /pushforward. @@ -807,8 +810,15 @@ rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ destruct x as [x1 x2] => //=. congr pair. by apply/val_inj. -admit. rewrite /=. +set psi := fun (w : mtuple n.+1 T) => (thead w, [tuple of behead w]) : T * mtuple n T. +have mpsi : measurable_fun [set: mtuple n.+1 T] psi. + apply: measurable_fun_prod=> //=. +(* +under [X in _ (_ X)]funext=> x /= do idtac. + simpl. *) + +admit. Admitted. End proS. @@ -990,8 +1000,9 @@ pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. rewrite expectationD; last 2 first. - admit. - admit. + simpl in Y2. + admit. (* TODO (1): reduce the integrability of thead X to intX *) + admit. (* TODO (2): reduce \sum (behead X) (?) to intX *) congr (_ + _). - rewrite /Y2 /X2/= unlock /expectation. (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) @@ -1001,7 +1012,7 @@ congr (_ + _). rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ (fun w => (tnth X ord0 w)%:E)); last 2 first. exact/measurable_EFinP. - admit. + admit. (* TODO: (1) *) apply: eq_measure_integral => //= A mA _. rewrite /pushforward. rewrite /pro/= /phi. @@ -1023,25 +1034,26 @@ congr (_ + _). by rewrite /bump/= add1n/= inordK// ltnS. rewrite -IH; last first. move=> Xi XiX. - admit. + admit. (* TODO (3): looks like (2), for behead X *) transitivity ('E_\X_n P[(fun x : mtuple n T => (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). rewrite unlock /expectation. transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). rewrite integral_mpro//. - apply: eq_integral => /= -[w1 w2] _. - rewrite -!sumEFin. - apply: eq_bigr => i _ /=. - by rewrite tnthS//. + apply: eq_integral => /= -[w1 w2] _. + rewrite -!sumEFin. + apply: eq_bigr => i _ /=. + by rewrite tnthS//. + admit. (* TODO: (2) *) rewrite /pro2. rewrite -fubini2'/=; last first. - admit. + admit. (* TODO(2'): (2) *) apply: eq_integral => t _. rewrite /fubini_G. transitivity (\sum_(i < n) (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). (* TODO: prove ge0_integral_sum for integrable *) - admit. + admit. (* TODO: (2') *) rewrite -sumEFin. apply: eq_bigr => /= i _. rewrite integral_cst//. From 4dc4c5f7612506009f8fb1a7bd64a1fbca172d3d Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Thu, 6 Mar 2025 10:25:45 +0900 Subject: [PATCH 49/73] one admit in bernoulli_trial_mmt_gen_fun --- theories/sampling.v | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 3795689ac7..043b5b96c3 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1023,7 +1023,7 @@ congr (_ + _). move=> [x1 x2]/= [Ax1 _]. exists [the mtuple _ _ of x1 :: x2] => //=. by rewrite theadE; congr pair => //; exact/val_inj. - by rewrite product_measure2E//= mpro_setT mule1. + by rewrite product_measure2E//= probability_setT mule1. - rewrite /Y1 /X1/=. transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. apply: eq_bigr => /= i _. @@ -1182,13 +1182,16 @@ Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : let X := bernoulli_trial X_ in 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. -move=> []bRVX iRVX /=. -rewrite /bernoulli_trial/mmt_gen_fun. -pose mmtX : n.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) +move: X_; case: n => [|n] X_ []bRVX iRVX /=; rewrite /bernoulli_trial/mmt_gen_fun/=. + under [X in 'E__[X]]eq_fun => x/= do rewrite /tuple_sum big_ord0 mul0r expR0. + by rewrite big_ord0 expectation_cst. +pose mmtX : n.+1.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) (map (btr P) X_). (*pose mmtX (i : 'I_n) : {RV P >-> R} := expR \o t \o* (btr P (tnth X_ i)).*) have iRV_mmtX : independent_RVs P setT (fun i => tnth mmtX i). - have f0 : {mfun T >-> bool}. admit. + have f0 : {mfun T >-> bool}. + move: bRVX iRVX mmtX => _ _ _. + exact: tnth X_ ord0. have := @independent_mmt_gen_fun ([sequence (nth f0 X_ k) ]_k) n t. (*exact: independent_mmt_gen_fun.*) admit. transitivity ('E_(\X_n P)[ tuple_prod mmtX ])%R. From ab2d37f7fa0f0323649ea4f2dd602b9e0a14178f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 6 Mar 2025 11:23:07 +0900 Subject: [PATCH 50/73] integrable_sum_ord, integral_sum (wip) --- theories/sampling.v | 94 ++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 89 insertions(+), 5 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 043b5b96c3..e29b592269 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -839,6 +839,74 @@ rewrite /=. by rewrite product_measure2E. Qed. +Section integrable_theory. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}). +Variables (D : set T) (mD : measurable D). +Implicit Type f g : T -> \bar R. + +Let ltnP_sumbool (a b : nat) : {(a < b)%N} + {(a >= b)%N}. +Proof. by case: ltnP => _; [left|right]. Qed. + +(* TODO: clean, move near integrable_sum, refactor *) +Lemma integrable_sum_ord n (t : 'I_n -> (T -> \bar R)) : + (forall i, mu.-integrable D (t i)) -> + mu.-integrable D (fun x => \sum_(i < n) t i x). +Proof. +move=> intt. +pose s0 := fun k => match ltnP_sumbool k n with + | left kn => t (Ordinal kn) + | right _ => cst 0%E + end. +pose s := [tuple of map s0 (index_iota 0 n)]. +suff: mu.-integrable D (fun x => (\sum_(i <- s) i x)%R). + apply: eq_integrable => // i iT. + rewrite big_map/=. + rewrite big_mkord. + apply: eq_bigr => /= j _. + rewrite /s0. + case: ltnP_sumbool => // jn. + f_equal. + exact/val_inj. + have := ltn_ord j. + by rewrite ltnNge jn. +apply: (@integrable_sum d T R mu D mD s) => /= h /mapP[/= k]. +rewrite mem_index_iota leq0n/= => kn ->{h}. +have := intt (Ordinal kn). +rewrite /s0. +case: ltnP_sumbool => //. +by rewrite leqNgt kn. +Qed. + +End integrable_theory. + +(* TODO: clean, move near integrableD, refactor *) +Section integral_sum. +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). +Variables (I : eqType) (f : I -> (T -> \bar R)). +Hypothesis intf : forall n, mu.-integrable D (f n). + +Lemma integral_sum (s : seq I) : + \int[mu]_(x in D) (\sum_(k <- s) f k x) = + \sum_(k <- s) \int[mu]_(x in D) (f k x). +Proof. +elim: s => [|h t ih]. + under eq_integral do rewrite big_nil. + by rewrite integral0 big_nil. +rewrite big_cons -ih -integralD//. + by apply: eq_integral => x xD; rewrite big_cons. +rewrite [X in _.-integrable _ X](_ : _ = + (fun x => (\sum_(h0 <- [seq f i | i <- t]) h0 x))); last first. + by apply/funext => x; rewrite big_map. +apply: integrable_sum => //= g /mapP[i ti ->{g}]. +exact: intf. +Qed. + +End integral_sum. + Section bernoulli. Local Open Scope ereal_scope. @@ -1002,7 +1070,13 @@ rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. rewrite expectationD; last 2 first. simpl in Y2. admit. (* TODO (1): reduce the integrability of thead X to intX *) - admit. (* TODO (2): reduce \sum (behead X) (?) to intX *) + (* TODO (2): reduce \sum (behead X) (?) to intX *) + rewrite (_ : _ \o _ = fun x => (\sum_(i < n) + (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. + by apply/funext => t/=; rewrite sumEFin. + apply: integrable_sum_ord => // i. + (* TODO: similar to (1)? integrability of tnth *) + admit. congr (_ + _). - rewrite /Y2 /X2/= unlock /expectation. (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) @@ -1044,16 +1118,26 @@ congr (_ + _). rewrite -!sumEFin. apply: eq_bigr => i _ /=. by rewrite tnthS//. - admit. (* TODO: (2) *) + rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) + (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. + by apply/funext => t/=; rewrite sumEFin. + apply: integrable_sum_ord => // i. + admit. (* TODO: (2) integrability of tnth *) rewrite /pro2. rewrite -fubini2'/=; last first. - admit. (* TODO(2'): (2) *) + rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) + (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. + by apply/funext => t/=; rewrite sumEFin. + apply: integrable_sum_ord => //= i. + admit. (* TODO: integrability of tnth (2') *) apply: eq_integral => t _. rewrite /fubini_G. transitivity (\sum_(i < n) (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). - (* TODO: prove ge0_integral_sum for integrable *) - admit. (* TODO: (2') *) + rewrite -[RHS]integral_sum//. + by apply: eq_integral => x _; rewrite sumEFin. + move=> /= i. + admit. (* TODO: (2') integrability tnth *) rewrite -sumEFin. apply: eq_bigr => /= i _. rewrite integral_cst//. From 98082811f4e18f3a4d1e860e144b10a8cedd2003 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Thu, 6 Mar 2025 11:56:05 +0900 Subject: [PATCH 51/73] independence of product - fixed admit on bernoulli_trial_mmt_gen_fun - solved bernoulli_trial_mmt_gen_fun --- theories/sampling.v | 187 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 151 insertions(+), 36 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index e29b592269..cdea8e1a18 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -453,8 +453,8 @@ Variable P : probability T R. Local Open Scope ring_scope. Lemma independent_RVs_btr - (I : set nat) (X : nat -> {mfun T >-> bool}) : - independent_RVs P I X -> independent_RVs P I (fun i : nat => btr P (X i)). + n (X : n.-tuple {mfun T >-> bool}) : + independent_RVs P [set: 'I_n] (fun i => tnth X i) -> independent_RVs P [set: 'I_n] (fun i => btr P (tnth X i)). Proof. move=> PIX; split. - move=> i Ii. @@ -991,15 +991,9 @@ by rewrite expe2 -EFinD onemMr. Qed. (* TODO: define a mixin *) -Program Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := +Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := (forall i : 'I_n, bernoulli_RV (tnth X i)) /\ - independent_RVs P `I_n (fun i => nth _ X i). -Next Obligation. -move=> n X i. -have @h : {RV P >-> bool}. - exact: (cst false). -exact: h. -Defined. + independent_RVs P [set: 'I_n] (tnth X). Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. @@ -1242,9 +1236,9 @@ Qed. End taylor_ln_le. -Lemma independent_mmt_gen_fun (X : {RV P >-> bool}^nat) n t : - let mmtX (i : nat) : {RV P >-> R} := expR \o t \o* (btr P (X i)) in - independent_RVs P `I_n X -> independent_RVs P `I_n mmtX. +Lemma independent_mmt_gen_fun n (X : n.-tuple {RV P >-> bool}) t : + let mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* (btr P (tnth X i)) in + independent_RVs P [set: 'I_n] (fun i => tnth X i) -> independent_RVs P [set: 'I_n] mmtX. Proof. rewrite /= => PnX. apply: independent_RVs_comp => //. @@ -1252,44 +1246,165 @@ apply: independent_RVs_scale => //=. exact: independent_RVs_btr. Qed. +(* Lemma expectation_prod2 (X Y : {RV P >-> R}) : *) +(* P.-integrable setT (EFin \o X) -> *) +(* P.-integrable setT (EFin \o Y) -> *) +(* independent_RVs2 P X Y -> *) +(* let XY := fun (x : T * T) => (X x.1 * Y x.2)%R in *) +(* 'E_(P \x P)[XY] = 'E_P[X] * 'E_P[Y]. *) +(* Proof. *) +(* move=> ? iRVXY/=. *) +(* rewrite unlock /expectation/= -fubini1/=; last first. admit. *) +(* rewrite /fubini_F/=. *) +(* under eq_integral => x _. *) +(* under eq_integral => y _ do rewrite EFinM. *) +(* rewrite integralZl//. *) +(* rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. *) +(* over. *) +(* rewrite /= integralZr//. *) +(* by rewrite fineK// integral_fune_fin_num. *) +(* Admitted. *) + Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : - independent_RVs P `I_n (fun i => nth (@cst T R 0%R : {mfun T >-> R}) - (map (fun x : {RV P >-> R} => x : {mfun T >-> R}) X) - i) -> - 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. + independent_RVs P [set: 'I_n] (tnth X) -> + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. +(* Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) : *) +(* (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> *) +(* 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). *) +(* Proof. *) +elim: n X => [X|n IH X] /= iRVX intX. + rewrite /tuple_prod. + under eq_fun do rewrite big_ord0. + by rewrite big_ord0 expectation_cst. +pose X0 := thead X. +have intX0 : P.-integrable [set: T] (EFin \o X0). + by apply: intX; rewrite mem_tnth. +have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). + by move=> XiX; exact: intX. +rewrite big_ord_recl/=. +rewrite /tuple_prod/=. +under eq_fun do rewrite big_ord_recl/=. +pose X1 (x : mtuple n.+1 T) := + (\prod_(i < n) tnth X (lift ord0 i) (tnth x (lift ord0 i)))%R. +have mX1 : measurable_fun setT X1. + apply: measurable_prod => /= i ?. apply: measurableT_comp => //. + exact: measurable_tnth. +pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. +pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. +pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). +have mX2 : measurable_fun setT X2. +rewrite /X2 /=. + by apply: measurableT_comp => //; exact: measurable_tnth. +pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. +pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. +rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. +(* rewrite expectation_prod2. *) +(* rewrite expectationD; last 2 first. *) +(* simpl in Y2. *) +(* admit. (* TODO (1): reduce the integrability of thead X to intX *) *) +(* (* TODO (2): reduce \sum (behead X) (?) to intX *) *) +(* rewrite (_ : _ \o _ = fun x => (\sum_(i < n) *) +(* (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. *) +(* by apply/funext => t/=; rewrite sumEFin. *) +(* apply: integrable_sum_ord => // i. *) +(* (* TODO: similar to (1)? integrability of tnth *) *) +(* admit. *) +(* congr (_ + _). *) +(* - rewrite /Y2 /X2/= unlock /expectation. *) +(* (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) *) +(* pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). *) +(* have mphi : measurable_fun setT phi. *) +(* exact: measurable_tnth. *) +(* rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ *) +(* (fun w => (tnth X ord0 w)%:E)); last 2 first. *) +(* exact/measurable_EFinP. *) +(* admit. (* TODO: (1) *) *) +(* apply: eq_measure_integral => //= A mA _. *) +(* rewrite /pushforward. *) +(* rewrite /pro/= /phi. *) +(* rewrite [X in (_ \x^ _) X = _](_ : *) +(* [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] *) +(* = A `*` setT); last first. *) +(* apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. *) +(* move=> [x1 x2]/= [Ax1 _]. *) +(* exists [the mtuple _ _ of x1 :: x2] => //=. *) +(* by rewrite theadE; congr pair => //; exact/val_inj. *) +(* by rewrite product_measure2E//= probability_setT mule1. *) +(* - rewrite /Y1 /X1/=. *) +(* transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. *) +(* apply: eq_bigr => /= i _. *) +(* congr expectation. *) +(* rewrite tnth_behead. *) +(* congr (tnth X). *) +(* apply/val_inj => /=. *) +(* by rewrite /bump/= add1n/= inordK// ltnS. *) +(* rewrite -IH; last first. *) +(* move=> Xi XiX. *) +(* admit. (* TODO (3): looks like (2), for behead X *) *) +(* transitivity ('E_\X_n P[(fun x : mtuple n T => *) +(* (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). *) +(* rewrite unlock /expectation. *) +(* transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). *) +(* rewrite integral_mpro//. *) +(* apply: eq_integral => /= -[w1 w2] _. *) +(* rewrite -!sumEFin. *) +(* apply: eq_bigr => i _ /=. *) +(* by rewrite tnthS//. *) +(* rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) *) +(* (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. *) +(* by apply/funext => t/=; rewrite sumEFin. *) +(* apply: integrable_sum_ord => // i. *) +(* admit. (* TODO: (2) integrability of tnth *) *) +(* rewrite /pro2. *) +(* rewrite -fubini2'/=; last first. *) +(* rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) *) +(* (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. *) +(* by apply/funext => t/=; rewrite sumEFin. *) +(* apply: integrable_sum_ord => //= i. *) +(* admit. (* TODO: integrability of tnth (2') *) *) +(* apply: eq_integral => t _. *) +(* rewrite /fubini_G. *) +(* transitivity (\sum_(i < n) *) +(* (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). *) +(* rewrite -[RHS]integral_sum//. *) +(* by apply: eq_integral => x _; rewrite sumEFin. *) +(* move=> /= i. *) +(* admit. (* TODO: (2') integrability tnth *) *) +(* rewrite -sumEFin. *) +(* apply: eq_bigr => /= i _. *) +(* rewrite integral_cst//. *) +(* rewrite [X in _ * X]probability_setT mule1. *) +(* rewrite tnth_behead//=. *) +(* congr (tnth X _ _)%:E. *) +(* apply/val_inj => /=. *) +(* by rewrite inordK// ltnS. *) +(* by []. *) Admitted. -(* wrong lemma *) Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> let X := bernoulli_trial X_ in 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. -move: X_; case: n => [|n] X_ []bRVX iRVX /=; rewrite /bernoulli_trial/mmt_gen_fun/=. - under [X in 'E__[X]]eq_fun => x/= do rewrite /tuple_sum big_ord0 mul0r expR0. - by rewrite big_ord0 expectation_cst. -pose mmtX : n.+1.-tuple {mfun T >-> R} := map (fun X => mmt_gen_fun0 X t) - (map (btr P) X_). -(*pose mmtX (i : 'I_n) : {RV P >-> R} := expR \o t \o* (btr P (tnth X_ i)).*) -have iRV_mmtX : independent_RVs P setT (fun i => tnth mmtX i). - have f0 : {mfun T >-> bool}. - move: bRVX iRVX mmtX => _ _ _. - exact: tnth X_ ord0. - have := @independent_mmt_gen_fun ([sequence (nth f0 X_ k) ]_k) n t. - (*exact: independent_mmt_gen_fun.*) admit. -transitivity ('E_(\X_n P)[ tuple_prod mmtX ])%R. +move=> []bRVX iRVX/=. +pose mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* btr P (tnth X_ i). +have /=iRV_mmtX : independent_RVs P setT mmtX. + exact: independent_mmt_gen_fun. +transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. congr expectation => /=; apply: funext => x/=. rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. - by rewrite !tnth_map. + by rewrite !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. -rewrite expectation_prod_independent_RVs; last first. - admit. +rewrite expectation_prod_independent_RVs; last first. admit. + rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. + apply: funext => i. + by rewrite /mmtX/= tnth_map tnth_ord_tuple. apply: eq_bigr => /= i _. congr expectation. rewrite /=. -rewrite tnth_map/=. -by rewrite tnth_map/=. +by rewrite tnth_map/= tnth_ord_tuple. Admitted. Arguments sub_countable [T U]. From ceec16c6df714084b7c6aa5bf18bb074e1c183b5 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 7 Mar 2025 13:01:23 +0900 Subject: [PATCH 52/73] integral_mpro Co-authored-by: Takafumi Saikawa --- theories/sampling.v | 273 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 242 insertions(+), 31 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index cdea8e1a18..ff58c530a8 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -689,6 +689,19 @@ HB.instance Definition _ := Measure_isProbability.Build _ _ _ pro2 pro2_setT. End pro2. +(*Lemma measurable_drop d (T : measurableType d) n k : + measurable_fun [set: mtuple n.+1 T] + (fun x : mtuple n.+1 T => [the mtuple (n.+1 - k) T of drop (T := T) k x]). +Proof. +elim: k n => [|k ihk n]. + admit. +rewrite /=. +set f := (X in measurable_fun _ X). +rewrite (_ : f = + (fun x : mtuple n.+1 T => + [the mtuple (n.+1 - k.+1) T of tnth x ord0 :: drop (n.+1 - k) x])). +Admitted.*) + Section pro. Context d (T : measurableType d) (R : realType) (P : probability T R). @@ -781,21 +794,186 @@ Arguments pro {d T R} P n. Notation "\X_ n P" := (pro P n) (at level 10, n, P at next level, format "\X_ n P"). +Lemma fubini2' : +forall [d1 d2 : measure_display] [T1 : measurableType d1] + [T2 : measurableType d2] [R : realType] + [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] + f -> (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f intf. +rewrite fubini2//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC. +rewrite /=. +by rewrite product_measure2E. +Qed. + +Lemma fubini1' : +forall [d1 d2 : measure_display] [T1 : measurableType d1] + [T2 : measurableType d2] [R : realType] + [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] + f -> (\int[m1]_x fubini_F m2 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f intf. +rewrite fubini1//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC. +rewrite /=. +by rewrite product_measure2E. +Qed. + +Lemma integrable_prodP : +forall [d1 d2 : measure_display] [T1 : measurableType d1] [T2 : measurableType d2] + [R : realType] [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f -> +(m1 \x^ m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f /integrableP[mf intf]; apply/integrableP; split => //. + rewrite -fubini2'//=. + rewrite fubini2//=. + apply/integrableP; split => //. + by apply/measurableT_comp => //. + by under eq_integral do rewrite abse_id. + apply/integrableP; split => //. + by apply/measurableT_comp => //. + by under eq_integral do rewrite abse_id. +Qed. + +Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : + behead t = [tuple (tnth t (lift ord0 i)) | i < n]. +Proof. +destruct n as [|n]. + rewrite !tuple0. + apply: size0nil. + by rewrite size_behead size_tuple. +apply: (@eq_from_nth _ (tnth_default t ord0)). + by rewrite size_behead !size_tuple. +move=> i ti. +rewrite nth_behead/= (nth_map ord0); last first. + rewrite size_enum_ord. + by rewrite size_behead size_tuple in ti. +rewrite (tnth_nth (tnth_default t ord0)). +congr nth. +rewrite /= /bump/= add1n; congr S. +apply/esym. +rewrite size_behead size_tuple in ti. +have := @nth_ord_enum _ ord0 (Ordinal ti). +by move=> ->. +Qed. + +Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : + {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. +Proof. +move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. + by case=> B + <- => -[? | ?]; [left | right]; exists B. +by case=> -[] B FGB <-; exists B=> //; [left | right]. +Qed. + +Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : + preimage_set_system X f set0 = set0. +Proof. by apply/seteqP; split=> A // []. Qed. + +(* The appropriate name `preimage_set_system_comp` is already occupied by + something different *) +(* TODO: generalize `setT`s in the statement *) +Lemma preimage_set_system_funcomp + {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} : + preimage_set_system setT f (preimage_set_system setT g F) = + preimage_set_system setT (g \o f) F. +Proof. +apply/seteqP; split=> A. + case=> B [] C FC <- <-. + exists C=> //. + rewrite !setTI. + by rewrite comp_preimage. +case=> B FB <-. +exists (g @^-1` B)=> //. +exists B=> //. +by rewrite setTI. +Qed. + +Lemma measurable_behead d (T : measurableType d) n : + measurable_fun setT (fun x : mtuple n.+1 T => [tuple of behead x] : mtuple n T). +Proof. +red=> /=. +move=> _ Y mY. +rewrite setTI. +set bh := (bh in preimage bh). +have bhYE : (bh @^-1` Y) = [set x :: y | x in setT & y in Y]. + rewrite /bh. + apply/seteqP; split=> x /=. + move=> ?; exists (thead x)=> //. + exists [tuple of behead x] => //=. + by rewrite [in RHS](tuple_eta x). + case=> x0 _ [] y Yy xE. + suff->: [tuple of behead x] = y by []. + apply/val_inj=> /=. + by rewrite -xE. +have:= mY. +rewrite /measurable/= => + F [] sF. +pose F' := image_set_system setT bh F. +move=> /(_ F') /=. +have-> : F' Y = F (bh @^-1` Y) by rewrite /F' /image_set_system /= setTI. +move=> /[swap] H; apply; split; first exact: sigma_algebra_image. +move=> A; rewrite /= /F' /image_set_system /= setTI. +set X := (X in X A). +move => XA. +apply: H; rewrite big_ord_recl /=; right. +set X' := (X' in X' (preimage _ _)). +have-> : X' = preimage_set_system setT bh X. + rewrite /X. + rewrite (big_morph _ preimage_set_systemU preimage_set_system0). + apply: eq_bigr=> i _. + rewrite preimage_set_system_funcomp. + congr preimage_set_system. + apply: funext=> t. + rewrite (tuple_eta t) /bh /= tnthS. + by congr tnth; apply/val_inj. +exists A=> //. +by rewrite setTI. +Qed. + Section proS. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. +Variable n : nat. + +Let phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. + +Let mphi : measurable_fun [set: T * mtuple _ _] phi. +Proof. exact: measurable_fun_cons. Qed. + +Let psi := fun (w : mtuple n.+1 T) => (thead w, [the mtuple _ _ of behead w]). + +Let mpsi : measurable_fun [set: mtuple _ _] psi. +Proof. +apply/measurable_fun_prod => /=. + exact: measurable_tnth. +apply: measurable_behead. +Qed. + +Let phiK : cancel phi psi. +Proof. +by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. +Qed. -Lemma integral_mpro n (f : n.+1.-tuple T -> R) : +Let psiK : cancel psi phi. +Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. + +Lemma integral_mpro (f : n.+1.-tuple T -> R) : measurable_fun [set: mtuple n.+1 T] f -> (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f) -> \int[\X_n.+1 P]_w (f w)%:E = \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. move=> mf intf. -set phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. -have mphi : measurable_fun [set: T * mtuple _ _] phi by exact: measurable_fun_cons. rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ - (fun x : mtuple n.+1 T => (f x)%:E)); [|exact: (measurable_comp measurableT)|]. + (fun x : mtuple n.+1 T => (f x)%:E)); [|exact: measurableT_comp|]. apply: eq_measure_integral => A mA _. rewrite /=. rewrite /pushforward. @@ -809,36 +987,49 @@ rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ exists (x.1 :: x.2) => //=. destruct x as [x1 x2] => //=. congr pair. - by apply/val_inj. + exact/val_inj. rewrite /=. -set psi := fun (w : mtuple n.+1 T) => (thead w, [tuple of behead w]) : T * mtuple n T. -have mpsi : measurable_fun [set: mtuple n.+1 T] psi. - apply: measurable_fun_prod=> //=. -(* -under [X in _ (_ X)]funext=> x /= do idtac. - simpl. *) - -admit. -Admitted. - -End proS. - -Lemma fubini2' : -forall [d1 d2 : measure_display] [T1 : measurableType d1] - [T2 : measurableType d2] [R : realType] - [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] - f -> (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f intf. -rewrite fubini2//. -apply: eq_measure_integral => //= A mA _. -apply: product_measure_unique => // B C mB mC. +apply/integrable_prodP. rewrite /=. -by rewrite product_measure2E. +apply/integrableP; split => /=. + by apply: measurableT_comp => //=; exact/measurable_EFinP. +move/integrableP : (intf) => [_ intfoo]. +apply: le_lt_trans (intfoo). +rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x + ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. + by apply: eq_integral => x _ /=; rewrite psiK. +rewrite le_eqVlt; apply/orP; left; apply/eqP. +rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ + (fun x : T * mtuple n T => ((abse \o (EFin \o (f \o phi))) x)))//. +- apply: eq_measure_integral => // A mA _. + apply: product_measure_unique => // B C mB mC. + rewrite /= /pushforward/=. + rewrite -product_measure2E//=. + congr (_ _). + (* TODO: lemma *) + apply/seteqP; split => [[x1 x2]/= [t [Bt Ct]] [<- <-//]|]. + move=> [x1 x2] [B1 C2] /=. + exists (x1 :: x2) => //=. + split=> //. + rewrite [X in C X](_ : _ = x2)//. + exact/val_inj. + congr pair => //. + exact/val_inj. +- apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + exact: measurableT_comp. +- apply: le_integrable intf => //=. + + apply: measurableT_comp => //=. + * apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + by apply: measurableT_comp => //=. + * exact: mpsi. + + move=> x _. + by rewrite normr_id// psiK. Qed. +End proS. + Section integrable_theory. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). @@ -907,6 +1098,24 @@ Qed. End integral_sum. +Section integrable_thead. +Context d (T : measurableType d) (R : realType). +Variables (P : probability T R) (n : nat) (X : n.+1.-tuple {RV P >-> R}). + +Lemma integrable_thead : P.-integrable setT (EFin \o thead X) -> + (\X_n.+1 P).-integrable [set: mtuple n.+1 T] + (EFin \o (fun x => thead X (thead x))). +Proof. +move=> /integrableP[mX intX]. +apply/integrableP; split. + apply: measurableT_comp => //. + apply: measurableT_comp => //. + exact: measurable_tnth. +rewrite integral_mpro. +Admitted. + +End integrable_thead. + Section bernoulli. Local Open Scope ereal_scope. @@ -1062,7 +1271,9 @@ pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. rewrite expectationD; last 2 first. - simpl in Y2. + apply: integrable_thead. + apply: intX. + exact: mem_tnth. admit. (* TODO (1): reduce the integrability of thead X to intX *) (* TODO (2): reduce \sum (behead X) (?) to intX *) rewrite (_ : _ \o _ = fun x => (\sum_(i < n) From e0d596b1f200d31fd73bd5eb32529a49e81f1e38 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 7 Mar 2025 13:38:44 +0900 Subject: [PATCH 53/73] move expectation of product out of Bernoulli section - exploit boolean RVs - uncomment expectation_prod2 --- theories/sampling.v | 608 ++++++++++++++++++++++++++------------------ 1 file changed, 361 insertions(+), 247 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index ff58c530a8..4ca179c9a1 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -586,9 +586,8 @@ Qed. End move_to_bigop_nat_lemmas. -Lemma g_sigma_preimage_comp - [d1 : measure_display] [T1 : semiRingOfSetsType d1] n - [T : pointedType] (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : +Lemma g_sigma_preimage_comp d1 {T1 : semiRingOfSetsType d1} n + {T : pointedType} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : g_sigma_preimage (fun i => (f1 i \o g)) = preimage_set_system [set: T3] g (g_sigma_preimage f1). Proof. @@ -671,6 +670,24 @@ Qed. End cons_measurable_fun. +Section pro1. +Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} + (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). + +Definition pro1 := product_measure1 P1 P2. + +HB.instance Definition _ := Measure.on pro1. + +Lemma pro1_setT : pro1 setT = 1%E. +Proof. +rewrite /pro1 -setXTT product_measure1E// -[RHS]mule1. +by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). +Qed. + +HB.instance Definition _ := + Measure_isProbability.Build _ _ _ pro1 pro1_setT. +End pro1. + Section pro2. Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). @@ -885,7 +902,7 @@ Lemma preimage_set_system_funcomp {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} : preimage_set_system setT f (preimage_set_system setT g F) = preimage_set_system setT (g \o f) F. -Proof. +Proof. apply/seteqP; split=> A. case=> B [] C FC <- <-. exists C=> //. @@ -943,21 +960,21 @@ Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. Variable n : nat. -Let phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. +Definition phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. -Let mphi : measurable_fun [set: T * mtuple _ _] phi. +Lemma mphi : measurable_fun [set: T * mtuple _ _] phi. Proof. exact: measurable_fun_cons. Qed. -Let psi := fun (w : mtuple n.+1 T) => (thead w, [the mtuple _ _ of behead w]). +Definition psi := fun (w : mtuple n.+1 T) => (thead w, [the mtuple _ _ of behead w]). -Let mpsi : measurable_fun [set: mtuple _ _] psi. +Lemma mpsi : measurable_fun [set: mtuple _ _] psi. Proof. apply/measurable_fun_prod => /=. exact: measurable_tnth. -apply: measurable_behead. +exact: measurable_behead. Qed. -Let phiK : cancel phi psi. +Lemma phiK : cancel phi psi. Proof. by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. Qed. @@ -966,14 +983,13 @@ Let psiK : cancel psi phi. Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. Lemma integral_mpro (f : n.+1.-tuple T -> R) : - measurable_fun [set: mtuple n.+1 T] f -> (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f) -> \int[\X_n.+1 P]_w (f w)%:E = \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. -move=> mf intf. +move=> /integrableP[mf intf]. rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ - (fun x : mtuple n.+1 T => (f x)%:E)); [|exact: measurableT_comp|]. + (fun x : mtuple n.+1 T => (f x)%:E)); [|by []|]. apply: eq_measure_integral => A mA _. rewrite /=. rewrite /pushforward. @@ -992,9 +1008,9 @@ rewrite /=. apply/integrable_prodP. rewrite /=. apply/integrableP; split => /=. - by apply: measurableT_comp => //=; exact/measurable_EFinP. -move/integrableP : (intf) => [_ intfoo]. -apply: le_lt_trans (intfoo). + apply: measurableT_comp => //=. + exact: mphi. +apply: le_lt_trans (intf). rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. by apply: eq_integral => x _ /=; rewrite psiK. @@ -1017,13 +1033,17 @@ rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ exact/val_inj. - apply/measurable_EFinP => //=. apply: measurableT_comp => //=. - exact: measurableT_comp. -- apply: le_integrable intf => //=. - + apply: measurableT_comp => //=. - * apply/measurable_EFinP => //=. - apply: measurableT_comp => //=. - by apply: measurableT_comp => //=. - * exact: mpsi. + apply: measurableT_comp => //=. + by apply/measurable_EFinP. + exact: mphi. +- have : (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f). + exact/integrableP. +- apply: le_integrable => //=. + + apply: measurableT_comp => //=; last exact: mpsi. + apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + apply: measurableT_comp => //=; last exact: mphi. + by apply/measurable_EFinP => //=. + move=> x _. by rewrite normr_id// psiK. Qed. @@ -1098,6 +1118,8 @@ Qed. End integral_sum. +(* TODO: integral_fune_lt_pinfty does not look useful a lemma *) + Section integrable_thead. Context d (T : measurableType d) (R : realType). Variables (P : probability T R) (n : nat) (X : n.+1.-tuple {RV P >-> R}). @@ -1106,103 +1128,111 @@ Lemma integrable_thead : P.-integrable setT (EFin \o thead X) -> (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o (fun x => thead X (thead x))). Proof. -move=> /integrableP[mX intX]. +move=> intX. apply/integrableP; split. apply: measurableT_comp => //. apply: measurableT_comp => //. exact: measurable_tnth. rewrite integral_mpro. -Admitted. +- rewrite -fubini1'//=. + + move/integrableP : (intX) => [_]. + + apply: le_lt_trans. + rewrite le_eqVlt; apply/orP; left; apply/eqP. + apply: eq_integral => x _. + rewrite /fubini_F/=. + admit. + + apply/fubini1b => //=. + * admit. + * admit. +- apply/integrableP; split. + + admit. + + rewrite integral_mpro. +Abort. End integrable_thead. -Section bernoulli. - -Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Variable p : R. -Hypothesis p01 : (0 <= p <= 1)%R. - -Definition bernoulli_RV (X : {RV P >-> bool}) := - distribution P X = bernoulli p. - -Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> - P [set i | X i == 1%R] = p%:E. -Proof. -move=> /(congr1 (fun f => f [set 1%:R])). -rewrite bernoulliE//. -rewrite /mscale/=. -rewrite diracE/= mem_set// mule1// diracE/= memNset//. -rewrite mule0 adde0. -rewrite /distribution /= => <-. -congr (P _). -rewrite /preimage/=. -by apply/seteqP; split => [x /eqP H//|x /eqP]. -Qed. - -Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> - P [set i | X i == 0%R] = (`1-p)%:E. -Proof. -move=> /(congr1 (fun f => f [set 0%:R])). -rewrite bernoulliE//. -rewrite /mscale/=. -rewrite diracE/= memNset//. -rewrite mule0// diracE/= mem_set// add0e mule1. -rewrite /distribution /= => <-. -congr (P _). -rewrite /preimage/=. -by apply/seteqP; split => [x /eqP H//|x /eqP]. +Lemma bounded_RV_integrable d (T : measurableType d) (R : realType) + (P : probability T R) (X : T -> R) M : + measurable_fun setT X -> + (forall t, (0 <= X t <= M)%R) -> P.-integrable setT (EFin \o X). +Proof. +move=> mf XM. +apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). +- exact/measurable_EFinP. +- move=> t _ /=; rewrite lee_fin/=. + rewrite !ger0_norm//. + + by have /andP[] := XM t. + + by rewrite (@le_trans _ _ (X t))//; have /andP[] := XM t. + + by have /andP[] := XM t. +- exact: finite_measure_integrable_cst. Qed. +Arguments bounded_RV_integrable {d T R P X} M. -Lemma bernoulli_expectation (X : {RV P >-> bool}) : - bernoulli_RV X -> 'E_P[btr P X] = p%:E. -Proof. -move=> bX. -rewrite unlock /btr. -rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. - by move=> y //=. -rewrite /bernoulli/=. -rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. - by move=> A mA _/=; rewrite (_ : distribution P X = bernoulli p). -rewrite integral_bernoulli//=. -by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. -Qed. +(* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 +taylor_ln_le : + forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. *) +Section taylor_ln_le. +Context {R : realType}. +Local Open Scope ring_scope. -Lemma integrable_bernoulli (X : {RV P >-> bool}) : - bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). -Proof. -move=> bX. -apply/integrableP; split. - by apply: measurableT_comp => //; exact: measurable_bool_to_real. -have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. - rewrite unlock /expectation. - apply: eq_integral => x _. - by rewrite gee0_abs //= lee_fin. -by rewrite bernoulli_expectation// ltry. -Qed. +Axiom expR2_lt8 : expR 2 <= 8 :> R. -Lemma bool_RV_sqr (X : {dRV P >-> bool}) : - ((btr P X ^+ 2) = btr P X :> (T -> R))%R. +Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. Proof. -apply: funext => x /=. -rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. -by case: (X x) => /=; rewrite ?mulr1 ?mulr0. +move=> x01; rewrite -subr_ge0. +pose f (x : R) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). +have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. +rewrite [leRHS](_ : _ = f x) // -f0. +evar (df0 : R -> R); evar (df : R -> R). +have idf (y : R) : 0 < 1 + y -> is_derive y (1:R) f (df y). + move=> y1. + rewrite (_ : df y = df0 y). + apply: is_deriveB; last exact: is_deriveD. + apply: is_deriveM=> //. + apply: is_derive1_comp=> //. + exact: is_derive1_ln. + rewrite /df0. + rewrite deriveD// derive_cst derive_id. + rewrite /GRing.scale /= !(mulr0,add0r,mulr1). + rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. + instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). + reflexivity. +clear df0. +have y1cc y : y \in `[0, 1] -> 0 < 1 + y. + rewrite in_itv /= => /andP [] y0 ?. + by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. +have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. +have dfge0 y : y \in `]0, 1[ -> 0 <= df y. + move=> y01. + have:= y01. + rewrite /df in_itv /= => /andP [] y0 y1. + rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. + rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. + pose iy:= Itv01 (ltW y0) (ltW y1). + have y1E: 1 + y = @convex.conv _ R^o iy 1 2. + rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. + by rewrite addrACA (addrC (- y)) subrr addr0. + rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. + rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. + rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. + rewrite ler_pdivrMr//. + rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. + rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. + rewrite !exprS expr0 mulr1 -!natrM mulnE /=. + by rewrite expR2_lt8. +apply: (@ger0_derive1_homo R f 0 1 true false). +- by move=> y /y1oo /idf /@ex_derive. +- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. +- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. +- by rewrite bound_itvE. +- exact: subset_itv_oo_cc. +- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. Qed. -Lemma bernoulli_variance (X : {dRV P >-> bool}) : - bernoulli_RV X -> 'V_P[btr P X] = (p * (`1-p))%:E. -Proof. -move=> b. -rewrite (@varianceE _ _ _ _ (btr P X)); - [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. -rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. -by rewrite expe2 -EFinD onemMr. -Qed. +End taylor_ln_le. -(* TODO: define a mixin *) -Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := - (forall i : 'I_n, bernoulli_RV (tnth X i)) /\ - independent_RVs P [set: 'I_n] (tnth X). +Section tuple_sum. +Context d (T : measurableType d) (R : realType) (P : probability T R). Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. @@ -1230,29 +1260,29 @@ Qed. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := isMeasurableFun.Build _ _ _ _ (tuple_prod s) (measurable_tuple_prod s). -Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R} := - tuple_sum [the n.-tuple _ of (map (btr P) - (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. +End tuple_sum. -(* -was wrong -Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := - (\sum_(i-> R}) : - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> +Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) M : + (forall i t, (0 <= tnth X i t <= M)%R) -> 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). Proof. -elim: n X => [X|n IH X] /= intX. +elim: n X => [X|n IH X] /= XM. rewrite /tuple_sum. under eq_fun do rewrite big_ord0. by rewrite big_ord0 expectation_cst. pose X0 := thead X. have intX0 : P.-integrable [set: T] (EFin \o X0). - by apply: intX; rewrite mem_tnth. + apply: (bounded_RV_integrable M) => // t. + exact: XM. have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). - by move=> XiX; exact: intX. + move=> /tnthP[i XiXi]. + apply: (bounded_RV_integrable M) => // t. + rewrite XiXi. + exact: XM. rewrite big_ord_recl/=. rewrite /tuple_sum/=. under eq_fun do rewrite big_ord_recl/=. @@ -1271,17 +1301,17 @@ pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. rewrite expectationD; last 2 first. - apply: integrable_thead. - apply: intX. - exact: mem_tnth. - admit. (* TODO (1): reduce the integrability of thead X to intX *) - (* TODO (2): reduce \sum (behead X) (?) to intX *) + apply: (bounded_RV_integrable M) => // t. + exact: XM. rewrite (_ : _ \o _ = fun x => (\sum_(i < n) (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. by apply/funext => t/=; rewrite sumEFin. apply: integrable_sum_ord => // i. - (* TODO: similar to (1)? integrability of tnth *) - admit. + have : measurable_fun setT (fun x : mtuple n.+1 T => + (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). + apply/measurableT_comp => //=. + exact: measurable_tnth. + by move/(bounded_RV_integrable M); exact. congr (_ + _). - rewrite /Y2 /X2/= unlock /expectation. (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) @@ -1291,7 +1321,10 @@ congr (_ + _). rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ (fun w => (tnth X ord0 w)%:E)); last 2 first. exact/measurable_EFinP. - admit. (* TODO: (1) *) + apply: (bounded_RV_integrable M). + by []. + move=> t. + by apply: XM. apply: eq_measure_integral => //= A mA _. rewrite /pushforward. rewrite /pro/= /phi. @@ -1312,8 +1345,9 @@ congr (_ + _). apply/val_inj => /=. by rewrite /bump/= add1n/= inordK// ltnS. rewrite -IH; last first. - move=> Xi XiX. - admit. (* TODO (3): looks like (2), for behead X *) + move=> i t. + rewrite tnth_behead. + exact: XM. transitivity ('E_\X_n P[(fun x : mtuple n T => (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). rewrite unlock /expectation. @@ -1327,14 +1361,24 @@ congr (_ + _). (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. by apply/funext => t/=; rewrite sumEFin. apply: integrable_sum_ord => // i. - admit. (* TODO: (2) integrability of tnth *) + have : measurable_fun setT (fun x : mtuple n.+1 T => + (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). + apply/measurableT_comp => //=. + exact: measurable_tnth. + by move/(bounded_RV_integrable M); exact. rewrite /pro2. rewrite -fubini2'/=; last first. rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. by apply/funext => t/=; rewrite sumEFin. apply: integrable_sum_ord => //= i. - admit. (* TODO: integrability of tnth (2') *) + have : measurable_fun setT (fun x : T * mtuple n T => (tnth X (lift ord0 i) (tnth x.2 i))). + apply/measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n _ => tnth x i) _ snd) => //=. + exact: measurable_tnth. + move/(@bounded_RV_integrable _ _ R (pro1 P (mpro P (n:=n)))%E _ M) => /=. + apply => t. + by apply: XM. apply: eq_integral => t _. rewrite /fubini_G. transitivity (\sum_(i < n) @@ -1342,7 +1386,7 @@ congr (_ + _). rewrite -[RHS]integral_sum//. by apply: eq_integral => x _; rewrite sumEFin. move=> /= i. - admit. (* TODO: (2') integrability tnth *) + exact: finite_measure_integrable_cst. rewrite -sumEFin. apply: eq_bigr => /= i _. rewrite integral_cst//. @@ -1352,100 +1396,54 @@ congr (_ + _). apply/val_inj => /=. by rewrite inordK// ltnS. by []. -Admitted. - -Lemma expectation_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : - is_bernoulli_trial X -> 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. -Proof. -move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(\X_n P)[tuple_sum (map (btr P) X)]). - congr expectation; apply/funext => t. - by apply: eq_bigr => /= i _; rewrite !tnth_map. -rewrite expectation_sum_pro; last first. - move=> Xi. - move=> /mapP[/= k kn] ->. - have [i ki] : exists i : 'I_n, k = tnth X i. - by apply/tnthP. - apply: integrable_bernoulli. - rewrite ki. - by apply bRV. -transitivity (\sum_(i < n) p%:E). - apply: eq_bigr => k _. - rewrite tnth_map bernoulli_expectation//. - by apply bRV. -by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. Qed. -Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> - (forall t, 0 <= bernoulli_trial X t)%R. -Proof. -move=> [bRV Xn] t. -rewrite /bernoulli_trial. -apply/sumr_ge0 => /= i _. -by rewrite !tnth_map. +Lemma expectation_prod2 (X Y : {mfun T >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> +(* independent_RVs2 P X Y -> NB: independence not used *) + let XY := fun (x : T * T) => (X x.1 * Y x.2)%R in + 'E_(P \x P)[XY] = 'E_P[X] * 'E_P[Y]. +Proof. +move=> intX intY/=. +rewrite unlock /expectation/= -fubini1/=; last first. + apply/fubini1b. + - apply/measurable_EFinP => //=. + by apply: measurable_funM => //=; apply: measurableT_comp. + - under eq_integral. + move=> t _. + under eq_integral. + move=> x _. + rewrite /= normrM EFinM muleC. + over. + rewrite /= integralZl//; last first. + by move/integrable_abse : intX. + over. + rewrite /=. + rewrite ge0_integralZr//; last 2 first. + apply/measurable_EFinP => //. + by apply/measurableT_comp => //. + by apply: integral_ge0 => //. + rewrite lte_mul_pinfty//. + by apply: integral_ge0 => //. + apply: integral_fune_fin_num => //. + by move/integrable_abse : intY. + by move/integrableP : intX => []. +rewrite /fubini_F/=. +under eq_integral => x _. + under eq_integral => y _ do rewrite EFinM. + rewrite integralZl//. + rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. + over. +rewrite /= integralZr//. +by rewrite fineK// integral_fune_fin_num. Qed. -(* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 -taylor_ln_le : - forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. *) -Section taylor_ln_le. -Local Open Scope ring_scope. - -Axiom expR2_lt8 : expR 2 <= 8 :> R. - -Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. -Proof. -move=> x01; rewrite -subr_ge0. -pose f (x : R) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). -have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. -rewrite [leRHS](_ : _ = f x) // -f0. -evar (df0 : R -> R); evar (df : R -> R). -have idf (y : R) : 0 < 1 + y -> is_derive y (1:R) f (df y). - move=> y1. - rewrite (_ : df y = df0 y). - apply: is_deriveB; last exact: is_deriveD. - apply: is_deriveM=> //. - apply: is_derive1_comp=> //. - exact: is_derive1_ln. - rewrite /df0. - rewrite deriveD// derive_cst derive_id. - rewrite /GRing.scale /= !(mulr0,add0r,mulr1). - rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. - instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). - reflexivity. -clear df0. -have y1cc y : y \in `[0, 1] -> 0 < 1 + y. - rewrite in_itv /= => /andP [] y0 ?. - by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. -have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. -have dfge0 y : y \in `]0, 1[ -> 0 <= df y. - move=> y01. - have:= y01. - rewrite /df in_itv /= => /andP [] y0 y1. - rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. - rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. - pose iy:= Itv01 (ltW y0) (ltW y1). - have y1E: 1 + y = @convex.conv _ R^o iy 1 2. - rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. - by rewrite addrACA (addrC (- y)) subrr addr0. - rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. - rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. - rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. - rewrite ler_pdivrMr//. - rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. - rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. - rewrite !exprS expr0 mulr1 -!natrM mulnE /=. - by rewrite expR2_lt8. -apply: (@ger0_derive1_homo R f 0 1 true false). -- by move=> y /y1oo /idf /@ex_derive. -- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. -- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. -- by rewrite bound_itvE. -- exact: subset_itv_oo_cc. -- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. -Qed. +End properties_of_expectation. -End taylor_ln_le. +Section properties_of_independence. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. Lemma independent_mmt_gen_fun n (X : n.-tuple {RV P >-> bool}) t : let mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* (btr P (tnth X i)) in @@ -1457,25 +1455,6 @@ apply: independent_RVs_scale => //=. exact: independent_RVs_btr. Qed. -(* Lemma expectation_prod2 (X Y : {RV P >-> R}) : *) -(* P.-integrable setT (EFin \o X) -> *) -(* P.-integrable setT (EFin \o Y) -> *) -(* independent_RVs2 P X Y -> *) -(* let XY := fun (x : T * T) => (X x.1 * Y x.2)%R in *) -(* 'E_(P \x P)[XY] = 'E_P[X] * 'E_P[Y]. *) -(* Proof. *) -(* move=> ? iRVXY/=. *) -(* rewrite unlock /expectation/= -fubini1/=; last first. admit. *) -(* rewrite /fubini_F/=. *) -(* under eq_integral => x _. *) -(* under eq_integral => y _ do rewrite EFinM. *) -(* rewrite integralZl//. *) -(* rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. *) -(* over. *) -(* rewrite /= integralZr//. *) -(* by rewrite fineK// integral_fune_fin_num. *) -(* Admitted. *) - Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : independent_RVs P [set: 'I_n] (tnth X) -> (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> @@ -1511,7 +1490,7 @@ rewrite /X2 /=. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. -(* rewrite expectation_prod2. *) +have := @expectation_prod2 _ _ _ _ Y2 Y1. (* rewrite expectationD; last 2 first. *) (* simpl in Y2. *) (* admit. (* TODO (1): reduce the integrability of thead X to intX *) *) @@ -1594,6 +1573,134 @@ rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. (* by []. *) Admitted. +End properties_of_independence. + +Section bernoulli. + +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Variable p : R. +Hypothesis p01 : (0 <= p <= 1)%R. + +Definition bernoulli_RV (X : {RV P >-> bool}) := + distribution P X = bernoulli p. + +Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> + P [set i | X i == 1%R] = p%:E. +Proof. +move=> /(congr1 (fun f => f [set 1%:R])). +rewrite bernoulliE//. +rewrite /mscale/=. +rewrite diracE/= mem_set// mule1// diracE/= memNset//. +rewrite mule0 adde0. +rewrite /distribution /= => <-. +congr (P _). +rewrite /preimage/=. +by apply/seteqP; split => [x /eqP H//|x /eqP]. +Qed. + +Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> + P [set i | X i == 0%R] = (`1-p)%:E. +Proof. +move=> /(congr1 (fun f => f [set 0%:R])). +rewrite bernoulliE//. +rewrite /mscale/=. +rewrite diracE/= memNset//. +rewrite mule0// diracE/= mem_set// add0e mule1. +rewrite /distribution /= => <-. +congr (P _). +rewrite /preimage/=. +by apply/seteqP; split => [x /eqP H//|x /eqP]. +Qed. + +Lemma bernoulli_expectation (X : {RV P >-> bool}) : + bernoulli_RV X -> 'E_P[btr P X] = p%:E. +Proof. +move=> bX. +rewrite unlock /btr. +rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. + by move=> y //=. +rewrite /bernoulli/=. +rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. + by move=> A mA _/=; rewrite (_ : distribution P X = bernoulli p). +rewrite integral_bernoulli//=. +by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. +Qed. + +Lemma integrable_bernoulli (X : {RV P >-> bool}) : + bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). +Proof. +move=> bX. +apply/integrableP; split. + by apply: measurableT_comp => //; exact: measurable_bool_to_real. +have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. + rewrite unlock /expectation. + apply: eq_integral => x _. + by rewrite gee0_abs //= lee_fin. +by rewrite bernoulli_expectation// ltry. +Qed. + +Lemma bool_RV_sqr (X : {dRV P >-> bool}) : + ((btr P X ^+ 2) = btr P X :> (T -> R))%R. +Proof. +apply: funext => x /=. +rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. +by case: (X x) => /=; rewrite ?mulr1 ?mulr0. +Qed. + +Lemma bernoulli_variance (X : {dRV P >-> bool}) : + bernoulli_RV X -> 'V_P[btr P X] = (p * (`1-p))%:E. +Proof. +move=> b. +rewrite (@varianceE _ _ _ _ (btr P X)); + [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. +rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. +by rewrite expe2 -EFinD onemMr. +Qed. + +(* TODO: define a mixin *) +Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := + (forall i : 'I_n, bernoulli_RV (tnth X i)) /\ + independent_RVs P [set: 'I_n] (tnth X). + +Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R} := + tuple_sum [the n.-tuple _ of (map (btr P) + (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. + +(* +was wrong +Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := + (\sum_(i-> bool}) : + is_bernoulli_trial X -> 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. +Proof. +move=> bRV. rewrite /bernoulli_trial. +transitivity ('E_(\X_n P)[tuple_sum (map (btr P) X)]). + congr expectation; apply/funext => t. + by apply: eq_bigr => /= i _; rewrite !tnth_map. +rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. + move=> i t. + rewrite tnth_map//. + rewrite /btr/= /bool_to_real/=. + by case: (tnth X i t) => /=; rewrite !lexx !ler01. +transitivity (\sum_(i < n) p%:E). + apply: eq_bigr => k _. + rewrite tnth_map bernoulli_expectation//. + by apply bRV. +by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. +Qed. + +Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> + (forall t, 0 <= bernoulli_trial X t)%R. +Proof. +move=> [bRV Xn] t. +rewrite /bernoulli_trial. +apply/sumr_ge0 => /= i _. +by rewrite !tnth_map. +Qed. + Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> let X := bernoulli_trial X_ in @@ -1608,7 +1715,13 @@ transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. by rewrite !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. -rewrite expectation_prod_independent_RVs; last first. admit. +rewrite expectation_prod_independent_RVs; last first. + move=> _ /mapP[/= i _ ->]. + apply: (bounded_RV_integrable (expR `|t|)) => //= t0. + rewrite expR_ge0/= ler_expR/=. + rewrite /bool_to_real/=. + case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. + by rewrite ler_norm. rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. apply: funext => i. by rewrite /mmtX/= tnth_map tnth_ord_tuple. @@ -1616,7 +1729,7 @@ apply: eq_bigr => /= i _. congr expectation. rewrite /=. by rewrite tnth_map/= tnth_ord_tuple. -Admitted. +Qed. Arguments sub_countable [T U]. Arguments card_le_finite [T U]. @@ -1665,7 +1778,8 @@ Proof. move: p01 => /andP[p0 p1] bX/=. rewrite bernoulli_trial_mmt_gen_fun//. under eq_bigr => i _. - rewrite bernoulli_mmt_gen_fun; last exact: bX.1. + rewrite bernoulli_mmt_gen_fun; last first. + by apply: bX.1. over. rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. @@ -1677,7 +1791,7 @@ Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : let X := bernoulli_trial X_ : {RV \X_n P >-> R} in 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. Proof. -move=> t0 bX/=. +move=> t_ge0 bX/=. have /andP[p0 p1] := p01. rewrite binomial_mmt_gen_fun// lee_fin. rewrite expectation_bernoulli_trial//. @@ -1724,7 +1838,7 @@ apply: (le_trans (chernoff _ _ t0)). apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * (expR (- (t * ((1 + delta) * fine mu))))%:E)). rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - by apply: (mmt_gen_fun_expectation _ bX); rewrite le_eqVlt t0 orbT. + by apply: (mmt_gen_fun_expectation _ bX); rewrite ltW. rewrite mulrC expRM -mulNr mulrA expRM. exact: (end_thm24 _ bX). Qed. @@ -1783,10 +1897,10 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine apply: (@le_trans _ _ (((fine 'E_(\X_n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite EFinM lee_pdivlMr ?expR_gt0// muleC fineK. apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X' : {RV (\X_n P) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. - - apply: expR_gt0. + - by apply: expR_gt0. - rewrite norm_expR. have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. - by rewrite (binomial_mmt_gen_fun _ bX). + by rewrite (binomial_mmt_gen_fun _ bX)//. apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. @@ -1975,6 +2089,6 @@ rewrite ler_expR mulNr lerNl -lnV; last by rewrite posrE divr_gt0. rewrite invf_div ler_pdivlMr// mulrC. rewrite -ler_pdivrMr; last by rewrite exprn_gt0. by rewrite mulrAC. -Admitted. +Qed. End bernoulli. From 2eb1481273ffc69990bb36d604746d3cbfecd1aa Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Sat, 8 Mar 2025 14:04:06 +0900 Subject: [PATCH 54/73] attempt at product of random variables using pushforward - prod RVs - alternative sampling formulation --- theories/sampling.v | 453 +++++++++++++++++++++++++++++++++----------- 1 file changed, 341 insertions(+), 112 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 4ca179c9a1..81aa698cca 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1398,15 +1398,17 @@ congr (_ + _). by []. Qed. -Lemma expectation_prod2 (X Y : {mfun T >-> R}) : - P.-integrable setT (EFin \o X) -> - P.-integrable setT (EFin \o Y) -> +Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) + (P1 : probability T1 R) (P2 : probability T2 R) + (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : + P1.-integrable setT (EFin \o X) -> + P2.-integrable setT (EFin \o Y) -> (* independent_RVs2 P X Y -> NB: independence not used *) - let XY := fun (x : T * T) => (X x.1 * Y x.2)%R in - 'E_(P \x P)[XY] = 'E_P[X] * 'E_P[Y]. + let XY := fun (x : T1 * T2) => (X x.1 * Y x.2)%R in + 'E_(pro2 P1 P2)[XY] = 'E_P1[X] * 'E_P2[Y]. Proof. move=> intX intY/=. -rewrite unlock /expectation/= -fubini1/=; last first. +rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. apply/fubini1b. - apply/measurable_EFinP => //=. by apply: measurable_funM => //=; apply: measurableT_comp. @@ -1435,7 +1437,7 @@ under eq_integral => x _. rewrite integralZl//. rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. over. -rewrite /= integralZr//. +rewrite /=integralZr//. by rewrite fineK// integral_fune_fin_num. Qed. @@ -1455,15 +1457,111 @@ apply: independent_RVs_scale => //=. exact: independent_RVs_btr. Qed. +Lemma boundedM U (f g : U -> R) (A : set U) : + [bounded f x | x in A] -> + [bounded g x | x in A] -> + [bounded (f x * g x)%R | x in A]. +Proof. +move=> bF bG. +rewrite/bounded_near. +case: bF => M1 [M1real M1f]. +case: bG => M2 [M2real M2g]. +near=> M. +rewrite/globally/= => x xA. +rewrite normrM. +rewrite (@le_trans _ _ (`|M1 + 1| * `|M2 + 1|)%R)//. +rewrite ler_pM//. + by rewrite M1f// (lt_le_trans _ (ler_norm _))// ltrDl. +by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. +Unshelve. all: by end_near. +Qed. + + +Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : + (forall i t, (0 <= tnth X i t <= M)%R) -> + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. +Proof. +elim: n X => [X|n IH X] /= boundedX intX. + rewrite /tuple_prod. + under eq_fun do rewrite big_ord0. + by rewrite big_ord0 expectation_cst. +rewrite big_ord_recl/=. +rewrite unlock /expectation integral_mpro /pro2; last first. + apply: (bounded_RV_integrable (M^+n.+1)%R) => // t. + rewrite /tuple_prod. + apply/andP. split. + rewrite prodr_ge0//= => i _. + by have /andP[] := boundedX i (tnth t i). + rewrite -[in leRHS](subn0 n.+1) -prodr_const_nat. + by rewrite big_mkord ler_prod. +rewrite /tuple_prod/=. +under eq_fun => x do (rewrite big_ord_recl/= tnth0; under eq_bigr => i do rewrite tnthS). +rewrite -fubini1' /fubini_F/=; last first. + apply: measurable_bounded_integrable => //=. + - rewrite /product_measure1/=. + apply: (@le_lt_trans _ _ 1); last exact: ltry. + rewrite -(mule1 1) -{2}(@probability_setT _ _ _ P) -(integral_cst P _ 1)//. + apply: ge0_le_integral => //=. + exact: measurable_fun_xsection. + by move=> x _; apply: probability_le1; exact: measurable_xsection. + - apply: measurable_funM => //=. + exact: measurableT_comp. + apply: measurable_prod => //=i ?. + apply: measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n T => @tnth n T x i) _ snd) => //=. + exact: measurable_tnth. + apply: boundedM. + apply/ex_bound. exact: (@globally_properfilter _ _ point). (* TODO: need to automate globally_properfilter *) + exists M; rewrite /globally/= => x _. + have /andP[? ?] := boundedX ord0 x.1. + by rewrite ger0_norm. + apply/ex_bound; first exact: (@globally_properfilter _ _ point). + exists (M^+n)%R. rewrite /globally/= => x _. + rewrite normr_prod -[in leRHS](subn0 n) -prodr_const_nat. + rewrite big_mkord ler_prod => //=i _. + have /andP[? ?] := boundedX (lift ord0 i) (tnth x.2 i). + by rewrite normr_ge0/= ger0_norm. +have ? : (mpro P (n:=n)).-integrable [set: mtuple n T] + (fun x : mtuple n T => (\prod_(i < n) tnth X (lift ord0 i) (tnth x i))%:E). + apply: (bounded_RV_integrable (M^+n)%R) => //=. + apply: measurable_prod => /=i _. + apply: measurableT_comp => //. + exact: measurable_tnth. + move=> t. apply/andP. split. + by rewrite prodr_ge0//= => i _; have /andP[] := boundedX (lift ord0 i) (tnth t i). + by rewrite -[in leRHS](subn0 n) -prodr_const_nat big_mkord ler_prod. +under eq_fun => x. + under eq_fun => y do rewrite/= EFinM. + rewrite integralZl//= -[X in _*X]fineK ?integral_fune_fin_num//=. + over. +rewrite integralZr//; last by rewrite intX// (tuple_eta X) tnth0 mem_head. +congr (_ * _). +rewrite fineK ?integral_fune_fin_num//=. +under eq_fun => x. + under eq_bigr => i _. + rewrite [X in tnth X]tuple_eta tnthS. + over. + over. +simpl. +rewrite [LHS](_ : _ = 'E_(\X_n P)[ tuple_prod (behead_tuple X) ]); last first. + by rewrite [in RHS]unlock /expectation [in RHS]/tuple_prod. +rewrite IH; last 2 first. +- by move=> i t; rewrite tnth_behead. +- by move=> Xi XiX; apply: intX; rewrite mem_behead. +apply: eq_bigr => /=i _. +rewrite unlock /expectation. +apply: eq_integral => x _. +congr EFin. +by rewrite [in RHS](tuple_eta X) tnthS. +Qed. + + Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : independent_RVs P [set: 'I_n] (tnth X) -> (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. -(* Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) : *) -(* (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> *) -(* 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). *) -(* Proof. *) elim: n X => [X|n IH X] /= iRVX intX. rewrite /tuple_prod. under eq_fun do rewrite big_ord0. @@ -1473,9 +1571,7 @@ have intX0 : P.-integrable [set: T] (EFin \o X0). by apply: intX; rewrite mem_tnth. have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). by move=> XiX; exact: intX. -rewrite big_ord_recl/=. -rewrite /tuple_prod/=. -under eq_fun do rewrite big_ord_recl/=. + pose X1 (x : mtuple n.+1 T) := (\prod_(i < n) tnth X (lift ord0 i) (tnth x (lift ord0 i)))%R. have mX1 : measurable_fun setT X1. @@ -1489,89 +1585,220 @@ rewrite /X2 /=. by apply: measurableT_comp => //; exact: measurable_tnth. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. +rewrite /tuple_prod. +under eq_fun => x /=. rewrite big_ord_recl/=. over. rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. -have := @expectation_prod2 _ _ _ _ Y2 Y1. -(* rewrite expectationD; last 2 first. *) -(* simpl in Y2. *) -(* admit. (* TODO (1): reduce the integrability of thead X to intX *) *) -(* (* TODO (2): reduce \sum (behead X) (?) to intX *) *) -(* rewrite (_ : _ \o _ = fun x => (\sum_(i < n) *) -(* (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. *) -(* by apply/funext => t/=; rewrite sumEFin. *) -(* apply: integrable_sum_ord => // i. *) -(* (* TODO: similar to (1)? integrability of tnth *) *) -(* admit. *) -(* congr (_ + _). *) -(* - rewrite /Y2 /X2/= unlock /expectation. *) -(* (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) *) -(* pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). *) -(* have mphi : measurable_fun setT phi. *) -(* exact: measurable_tnth. *) -(* rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ *) -(* (fun w => (tnth X ord0 w)%:E)); last 2 first. *) -(* exact/measurable_EFinP. *) -(* admit. (* TODO: (1) *) *) -(* apply: eq_measure_integral => //= A mA _. *) -(* rewrite /pushforward. *) -(* rewrite /pro/= /phi. *) -(* rewrite [X in (_ \x^ _) X = _](_ : *) -(* [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] *) -(* = A `*` setT); last first. *) -(* apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. *) -(* move=> [x1 x2]/= [Ax1 _]. *) -(* exists [the mtuple _ _ of x1 :: x2] => //=. *) -(* by rewrite theadE; congr pair => //; exact/val_inj. *) -(* by rewrite product_measure2E//= probability_setT mule1. *) -(* - rewrite /Y1 /X1/=. *) -(* transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. *) -(* apply: eq_bigr => /= i _. *) -(* congr expectation. *) -(* rewrite tnth_behead. *) -(* congr (tnth X). *) -(* apply/val_inj => /=. *) -(* by rewrite /bump/= add1n/= inordK// ltnS. *) -(* rewrite -IH; last first. *) -(* move=> Xi XiX. *) -(* admit. (* TODO (3): looks like (2), for behead X *) *) -(* transitivity ('E_\X_n P[(fun x : mtuple n T => *) -(* (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). *) -(* rewrite unlock /expectation. *) -(* transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). *) -(* rewrite integral_mpro//. *) -(* apply: eq_integral => /= -[w1 w2] _. *) -(* rewrite -!sumEFin. *) -(* apply: eq_bigr => i _ /=. *) -(* by rewrite tnthS//. *) -(* rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) *) -(* (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. *) -(* by apply/funext => t/=; rewrite sumEFin. *) -(* apply: integrable_sum_ord => // i. *) -(* admit. (* TODO: (2) integrability of tnth *) *) -(* rewrite /pro2. *) -(* rewrite -fubini2'/=; last first. *) -(* rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) *) -(* (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. *) -(* by apply/funext => t/=; rewrite sumEFin. *) -(* apply: integrable_sum_ord => //= i. *) -(* admit. (* TODO: integrability of tnth (2') *) *) -(* apply: eq_integral => t _. *) -(* rewrite /fubini_G. *) -(* transitivity (\sum_(i < n) *) -(* (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). *) -(* rewrite -[RHS]integral_sum//. *) -(* by apply: eq_integral => x _; rewrite sumEFin. *) -(* move=> /= i. *) -(* admit. (* TODO: (2') integrability tnth *) *) -(* rewrite -sumEFin. *) -(* apply: eq_bigr => /= i _. *) -(* rewrite integral_cst//. *) -(* rewrite [X in _ * X]probability_setT mule1. *) -(* rewrite tnth_behead//=. *) -(* congr (tnth X _ _)%:E. *) -(* apply/val_inj => /=. *) -(* by rewrite inordK// ltnS. *) -(* by []. *) -Admitted. +simpl in Y1, Y2. + +rewrite expectation_prod; last 3 first. +- admit. (* HARD *) +- admit. +- admit. +rewrite big_ord_recl. +congr (_ * _). + admit. + +under eq_bigr => i _ do rewrite [X in tnth X]tuple_eta tnthS. +rewrite -IH; last 2 first. +- admit. +- admit. +rewrite /Y1/X1/tuple_prod/=. +under eq_fun => x. under eq_bigr => i _. rewrite [X in tnth X]tuple_eta [X in _ (tnth X _)]tuple_eta !tnthS. over. over. +rewrite /=. +rewrite unlock /expectation integral_mpro//. + under eq_fun => x. under eq_bigr => i _. + rewrite (tnth_behead (x.1 :: x.2)) (_ : inord i.+1 = lift ord0 i) ?tnthS; last first. + by apply: val_inj; rewrite /=inordK// ltnS. + over. + over. + simpl. + rewrite -fubini2'/fubini_G/=. + apply: eq_integral => x _/=. + by rewrite integral_cst//= probability_setT mule1. + admit. +admit. +Abort. + +Lemma finite_prod n (F : 'I_n -> \bar R) : + (forall i, 0 <= F i < +oo) -> \prod_(i < n) F i < +oo. +Proof. +move: F; elim: n => n; first by rewrite big_ord0 ltry. +move=> ih F Foo. +rewrite big_ord_recl lte_mul_pinfty//. +- by have /andP[] := Foo ord0. +- rewrite fin_numElt. + have /andP[F0 ->] := Foo ord0. + by rewrite (@lt_le_trans _ _ 0). +by rewrite ih. +Qed. + +Lemma sub_independent_RVs d' [T' : measurableType d'] [I : choiceType] [A B : set I] + [X : I -> {RV P >-> T'}]: + A `<=` B -> independent_RVs P B X -> independent_RVs P A X. +Proof. +move=> AB [h1 h2]. split. + by move=> i Ai; apply: h1; exact: AB. +move=> J JA E h3. +by apply: h2 => //; apply: subset_trans; first apply: JA. +Qed. + +Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) M: + independent_RVs P [set: 'I_n] (tnth X) -> + (forall i t, (0 <= tnth X i t <= M)%R) -> + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_P[ \prod_(i < n) (tnth X i) ] = \prod_(i < n) 'E_P[ (tnth X i) ]. +Proof. +elim: n X => [X|n ih X]. + by rewrite !big_ord0 expectation_cst. +move=> /=iRVs boundedX intX. + +rewrite [RHS]big_ord_recl/=. +rewrite [X in _ * X](_ : _ = \prod_(i < n) ('E_P [ (tnth (behead_tuple X) i) ])); last first. + by apply: eq_bigr => i _; congr expectation; apply funext => x; rewrite [in LHS](tuple_eta X) tnthS. +rewrite -ih; last 3 first. +- suffices: independent_RVs P [set` behead_tuple (ord_tuple n.+1)] (fun i => tnth X i). + rewrite /independent_RVs. move=> [/=h1 h2]. split => /=. + move=> i _. + have := h1 (lift ord0 i). rewrite {1}(tuple_eta X) tnthS. apply. + apply/tnthP. exists i. + rewrite tnth_behead/= tnth_ord_tuple. + by apply: ord_inj; rewrite lift0 inordK// ltnS. + move=> J JIn E h3. + have /=J' := ((@widen_ord n n.+1 (leqnSn n)) @` J)%fset. + have J'In1 : [set` J'] `<=` [set: 'I_n.+1] by exact: subsetT. + (* have := h2 J' J'In1. *) + admit. + exact: (@sub_independent_RVs _ _ _ _ [set: 'I_n.+1]). +- by move=> i t; rewrite tnth_behead boundedX. +- by move=> Xi XiX; rewrite intX// mem_behead. + +pose X1 := (fun x : mtuple n.+1 R => \prod_(i < n.+1) tnth x i)%R. +pose X2 := (fun t : T => [the mtuple n.+1 R of [tuple of [seq tnth X i t | i <- ord_tuple n.+1]]])%R. +have mX1 : measurable_fun setT X1. admit. +have mX2 : measurable_fun setT X2. admit. +pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. +pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. +pose Y1 : {mfun mtuple n.+1 R >-> R} := HB.pack X1 build_mX1. +pose Y2 : {mfun T >-> mtuple n.+1 R} := HB.pack X2 build_mX2. +rewrite [X in 'E_P[X]](_ : _ = Y1 \o Y2)%R; last first. + apply: funext => t. + rewrite /Y1/Y2/X1/X2/=. + under [RHS]eq_bigr => i _ do rewrite tnth_map tnth_ord_tuple. + admit. + +rewrite unlock/expectation -(@integral_pushforward _ _ _ _ _ _ _ _ (EFin \o Y1))//=; last first. +- admit. +- exact: measurableT_comp. +pose X3 := (fun t : T => (tnth X ord0 t,[the mtuple n R of [tuple of [seq tnth (behead_tuple X) i t | i <- ord_tuple n]]]))%R. +have mX3 : measurable_fun setT X3. admit. +pose build_mX3 := isMeasurableFun.Build _ _ _ _ _ mX3. +pose Y3 : {mfun T >-> _} := HB.pack X3 build_mX3. +rewrite /X1. +rewrite [LHS](_ : _ = \int[pushforward P mX3]_y (y.1 * \prod_(i < n) tnth y.2 i)%:E); last first. + under eq_integral => y _. + rewrite big_ord_recl/=. + rewrite [X in (_ * X)%R](_ : _ = \prod_(i < n) tnth (behead_tuple y) i )%R; last first. + by apply eq_bigr => j _; rewrite [in LHS](tuple_eta y) tnthS. + over. + simpl. + admit. +rewrite [in LHS]/pushforward/=. + +(* +case: n X => [X|n X]. + by rewrite !big_ord0 expectation_cst. +elim: n X => [X|n IH X] /= iRVX intX. + admit. +rewrite big_ord_recl [in RHS] big_ord_recl. +rewrite expectation_prod; last 3 first. +- apply: (@independent_generators _ _ _ _ _ _ _ _ (fun i => @RGenOInfty.G R)) => //=. + - move=> i _. admit. + - move=> i _. admit. + - admit. + split => /=. + case => _//= A/= []B nB <-. + have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. + apply => //. admit. + have : measurable_fun setT (tnth X ord0) by []. + apply => //. admit. + move=> J _ E JE. + have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. + rewrite setT_bool. + rewrite bigcap_setU1 bigcap_set1. + rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. + case: iRVX => /=H1 H2. + pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else + if i == lift ord0 ord0 then E true + else setT. + pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. + (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) + (* case. case. *) + (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) + (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) + (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) + (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) + (* admit. *) + (* (* have := H2 _ _ _ K1. *) *) + have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). + apply: H2 => //. + case. case. + - move=> i _. rewrite /E'/=. have := JE false. admit. + - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. + by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. +- split => /=. + case => _//= A/= []B nB <-. + have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. + exact. + have : measurable_fun setT (tnth X ord0) by []. + exact. + move=> J _ E JE. + + + have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. + rewrite setT_bool. + rewrite bigcap_setU1 bigcap_set1. + rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. + case: iRVX => /=H1 H2. + pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else + if i == lift ord0 ord0 then E true + else setT. + pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. + (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) + (* case. case. *) + (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) + (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) + (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) + (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) + (* admit. *) + (* (* have := H2 _ _ _ K1. *) *) + have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). + apply: H2 => //. + case. case. + - move=> i _. rewrite /E'/=. have := JE false. admit. + - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. + by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. +- by rewrite intX// mem_tnth. +- rewrite (_ : (\prod_(i < n) tnth X (lift ord0 i))%R = (\prod_(i < n) tnth (behead_tuple X) i)%R); last first. + by apply: eq_bigr => i _; rewrite [in LHS](tuple_eta X) tnthS. + apply: integrable_prod => i. + by rewrite intX// tnth_behead mem_tnth. +rewrite (_ : \prod_(i < n) tnth X (lift ord0 i) = \prod_(i < n) tnth (behead X) i)%R; last first. + apply: eq_bigr => /=i _. rewrite tnth_behead (_ : inord i.+1 = lift ord0 i)//=. + by apply: val_inj; rewrite /=inordK// ltnS. +rewrite IH//=. +- congr (_ * _). + apply: eq_bigr=> i _. + congr expectation. + by rewrite [in RHS](tuple_eta X) tnthS. +- admit. +- by move=> Xi XiX; rewrite intX// mem_behead.*) +Abort. End properties_of_independence. @@ -1660,8 +1887,7 @@ Qed. (* TODO: define a mixin *) Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := - (forall i : 'I_n, bernoulli_RV (tnth X i)) /\ - independent_RVs P [set: 'I_n] (tnth X). + (forall i : 'I_n, bernoulli_RV (tnth X i)). Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R} := tuple_sum [the n.-tuple _ of (map (btr P) @@ -1688,14 +1914,13 @@ rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. transitivity (\sum_(i < n) p%:E). apply: eq_bigr => k _. rewrite tnth_map bernoulli_expectation//. - by apply bRV. by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. Qed. Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> (forall t, 0 <= bernoulli_trial X t)%R. Proof. -move=> [bRV Xn] t. +move=> bRV t. rewrite /bernoulli_trial. apply/sumr_ge0 => /= i _. by rewrite !tnth_map. @@ -1706,25 +1931,32 @@ Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : let X := bernoulli_trial X_ in 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. -move=> []bRVX iRVX/=. +move=> bRVX/=. pose mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* btr P (tnth X_ i). -have /=iRV_mmtX : independent_RVs P setT mmtX. - exact: independent_mmt_gen_fun. transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. congr expectation => /=; apply: funext => x/=. rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. by rewrite !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. -rewrite expectation_prod_independent_RVs; last first. - move=> _ /mapP[/= i _ ->]. +rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. +- move=> i ?. + apply/andP. split. + by rewrite tnth_mktuple/= expR_ge0. + rewrite tnth_mktuple/=/bool_to_real/=. + rewrite ler_expR -[leRHS]mul1r. + have [t0|t0] := leP 0%R t. + by rewrite ger0_norm// ler_pM//; case: (tnth X_ i _). + rewrite (@le_trans _ _ 0%R)//. + by rewrite mulr_ge0_le0// ltW. +- move=> _ /mapP[/= i _ ->]. apply: (bounded_RV_integrable (expR `|t|)) => //= t0. rewrite expR_ge0/= ler_expR/=. rewrite /bool_to_real/=. case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. by rewrite ler_norm. - rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. - apply: funext => i. - by rewrite /mmtX/= tnth_map tnth_ord_tuple. + (* rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. *) + (* apply: funext => i. *) + (* by rewrite /mmtX/= tnth_map tnth_ord_tuple. *) apply: eq_bigr => /= i _. congr expectation. rewrite /=. @@ -1777,10 +2009,7 @@ Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : Proof. move: p01 => /andP[p0 p1] bX/=. rewrite bernoulli_trial_mmt_gen_fun//. -under eq_bigr => i _. - rewrite bernoulli_mmt_gen_fun; last first. - by apply: bX.1. - over. +under eq_bigr => i _ do rewrite bernoulli_mmt_gen_fun//. rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. Qed. From 1ea19df6f1ff45dc39fd99e374c37e6654bcb655 Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Wed, 12 Mar 2025 05:24:19 +0900 Subject: [PATCH 55/73] Lemma expR2_le8 --- coq-mathcomp-analysis.opam | 1 + theories/sampling.v | 95 ++++++++++++++++++++++++-------------- 2 files changed, 61 insertions(+), 35 deletions(-) diff --git a/coq-mathcomp-analysis.opam b/coq-mathcomp-analysis.opam index a0890eb504..ae70c35611 100644 --- a/coq-mathcomp-analysis.opam +++ b/coq-mathcomp-analysis.opam @@ -19,6 +19,7 @@ depends: [ "coq-mathcomp-solvable" "coq-mathcomp-field" "coq-mathcomp-bigenough" { (>= "1.0.0") } + "coq-interval" ] tags: [ diff --git a/theories/sampling.v b/theories/sampling.v index 81aa698cca..ca107dc79c 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -3,6 +3,8 @@ From mathcomp Require Import all_ssreflect. From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. From mathcomp Require Import mathcomp_extra boolp classical_sets functions. From mathcomp Require Import cardinality fsbigop. +Require Reals Interval.Tactic. +From mathcomp Require Import (canonicals) Rstruct Rstruct_topology. From HB Require Import structures. From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. From mathcomp Require Import reals ereal interval_inference topology normedtype sequences. @@ -435,7 +437,7 @@ Lemma measurable_bool_to_real : measurable_fun [set: T] bool_to_real. Proof. rewrite /bool_to_real. apply: measurableT_comp => //=. -exact: (@measurable_funP _ _ _ _ f). +exact: (@measurable_funPT _ _ _ _ f). Qed. (* HB.about isMeasurableFun.Build. *) HB.instance Definition _ := @@ -454,7 +456,7 @@ Local Open Scope ring_scope. Lemma independent_RVs_btr n (X : n.-tuple {mfun T >-> bool}) : - independent_RVs P [set: 'I_n] (fun i => tnth X i) -> independent_RVs P [set: 'I_n] (fun i => btr P (tnth X i)). + independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] (fun i => btr P (tnth X i)). Proof. move=> PIX; split. - move=> i Ii. @@ -473,8 +475,8 @@ Context {d} (T : measurableType d) {R : realType}. HB.instance Definition _ (f g : {mfun T >-> R}) := @isMeasurableFun.Build d _ _ _ (f \* g)%R - (measurable_funM (@measurable_funP _ _ _ _ f) - ((@measurable_funP _ _ _ _ g))). + (measurable_funM (@measurable_funPT _ _ _ _ f) + ((@measurable_funPT _ _ _ _ g))). End mfunM. @@ -988,8 +990,8 @@ Lemma integral_mpro (f : n.+1.-tuple T -> R) : \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. move=> /integrableP[mf intf]. -rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ - (fun x : mtuple n.+1 T => (f x)%:E)); [|by []|]. +rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ setT + (fun x : mtuple n.+1 T => (f x)%:E)); [|by []| |by []]. apply: eq_measure_integral => A mA _. rewrite /=. rewrite /pushforward. @@ -1015,7 +1017,7 @@ rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. by apply: eq_integral => x _ /=; rewrite psiK. rewrite le_eqVlt; apply/orP; left; apply/eqP. -rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ +rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT (fun x : T * mtuple n T => ((abse \o (EFin \o (f \o phi))) x)))//. - apply: eq_measure_integral => // A mA _. apply: product_measure_unique => // B C mB mC. @@ -1168,23 +1170,43 @@ apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). Qed. Arguments bounded_RV_integrable {d T R P X} M. -(* this seems to be provable like in https://www.cs.purdue.edu/homes/spa/courses/pg17/mu-book.pdf page 65 -taylor_ln_le : - forall (delta : R), ((1 + delta) * ln (1 + delta) >= delta + delta^+2 / 3)%R. *) -Section taylor_ln_le. -Context {R : realType}. +Module with_interval. +Declare Scope bigQ_scope. +Import Reals. +Import Rstruct Rstruct_topology. +Import Interval.Tactic. + +Section expR2_le8. +Let R := Rdefinitions.R. Local Open Scope ring_scope. -Axiom expR2_lt8 : expR 2 <= 8 :> R. +Lemma expR2_le8 : expR 2 <= 8 :> R. +Proof. +rewrite (_ : 2 = 1 + 1)//. +rewrite exp.expRD -RmultE. +rewrite (_ : 8 = 8%R); last first. + by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. +rewrite (_ : 1 = INR 1%N)//=. +rewrite -RexpE. +apply/RleP. +by interval. +Qed. + +End expR2_le8. +End with_interval. + +Section taylor_ln_le. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. Proof. move=> x01; rewrite -subr_ge0. -pose f (x : R) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). +pose f (x : R^o) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. rewrite [leRHS](_ : _ = f x) // -f0. evar (df0 : R -> R); evar (df : R -> R). -have idf (y : R) : 0 < 1 + y -> is_derive y (1:R) f (df y). +have idf (y : R^o) : 0 < 1 + y -> is_derive y (1:R) f (df y). move=> y1. rewrite (_ : df y = df0 y). apply: is_deriveB; last exact: is_deriveD. @@ -1219,7 +1241,7 @@ have dfge0 y : y \in `]0, 1[ -> 0 <= df y. rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. rewrite !exprS expr0 mulr1 -!natrM mulnE /=. - by rewrite expR2_lt8. + by rewrite with_interval.expR2_le8. apply: (@ger0_derive1_homo R f 0 1 true false). - by move=> y /y1oo /idf /@ex_derive. - by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. @@ -1318,13 +1340,14 @@ congr (_ + _). pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). have mphi : measurable_fun setT phi. exact: measurable_tnth. - rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ - (fun w => (tnth X ord0 w)%:E)); last 2 first. + rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ setT + (fun w => (tnth X ord0 w)%:E)); last 3 first. exact/measurable_EFinP. apply: (bounded_RV_integrable M). by []. move=> t. by apply: XM. + by []. apply: eq_measure_integral => //= A mA _. rewrite /pushforward. rewrite /pro/= /phi. @@ -1449,7 +1472,7 @@ Local Open Scope ereal_scope. Lemma independent_mmt_gen_fun n (X : n.-tuple {RV P >-> bool}) t : let mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* (btr P (tnth X i)) in - independent_RVs P [set: 'I_n] (fun i => tnth X i) -> independent_RVs P [set: 'I_n] mmtX. + independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] mmtX. Proof. rewrite /= => PnX. apply: independent_RVs_comp => //. @@ -1558,7 +1581,7 @@ Qed. Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : - independent_RVs P [set: 'I_n] (tnth X) -> + independent_RVs (P := P) [set: 'I_n] (tnth X) -> (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. @@ -1634,7 +1657,7 @@ Qed. Lemma sub_independent_RVs d' [T' : measurableType d'] [I : choiceType] [A B : set I] [X : I -> {RV P >-> T'}]: - A `<=` B -> independent_RVs P B X -> independent_RVs P A X. + A `<=` B -> independent_RVs (P := P) B X -> independent_RVs (P := P) A X. Proof. move=> AB [h1 h2]. split. by move=> i Ai; apply: h1; exact: AB. @@ -1643,7 +1666,7 @@ by apply: h2 => //; apply: subset_trans; first apply: JA. Qed. Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) M: - independent_RVs P [set: 'I_n] (tnth X) -> + independent_RVs (P := P) [set: 'I_n] (tnth X) -> (forall i t, (0 <= tnth X i t <= M)%R) -> (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> 'E_P[ \prod_(i < n) (tnth X i) ] = \prod_(i < n) 'E_P[ (tnth X i) ]. @@ -1656,7 +1679,7 @@ rewrite [RHS]big_ord_recl/=. rewrite [X in _ * X](_ : _ = \prod_(i < n) ('E_P [ (tnth (behead_tuple X) i) ])); last first. by apply: eq_bigr => i _; congr expectation; apply funext => x; rewrite [in LHS](tuple_eta X) tnthS. rewrite -ih; last 3 first. -- suffices: independent_RVs P [set` behead_tuple (ord_tuple n.+1)] (fun i => tnth X i). +- suffices: independent_RVs (P := P) [set` behead_tuple (ord_tuple n.+1)] (fun i => tnth X i). rewrite /independent_RVs. move=> [/=h1 h2]. split => /=. move=> i _. have := h1 (lift ord0 i). rewrite {1}(tuple_eta X) tnthS. apply. @@ -1686,7 +1709,7 @@ rewrite [X in 'E_P[X]](_ : _ = Y1 \o Y2)%R; last first. under [RHS]eq_bigr => i _ do rewrite tnth_map tnth_ord_tuple. admit. -rewrite unlock/expectation -(@integral_pushforward _ _ _ _ _ _ _ _ (EFin \o Y1))//=; last first. +rewrite unlock/expectation -(@integral_pushforward _ _ _ _ _ _ _ _ setT (EFin \o Y1))//=; last first. - admit. - exact: measurableT_comp. pose X3 := (fun t : T => (tnth X ord0 t,[the mtuple n R of [tuple of [seq tnth (behead_tuple X) i t | i <- ord_tuple n]]]))%R. @@ -1805,7 +1828,8 @@ End properties_of_independence. Section bernoulli. Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType) (P : probability T R). +Let R := Rdefinitions.R. +Context d (T : measurableType d) (P : probability T R). Variable p : R. Hypothesis p01 : (0 <= p <= 1)%R. @@ -1889,7 +1913,7 @@ Qed. Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := (forall i : 'I_n, bernoulli_RV (tnth X i)). -Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R} := +Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R : realType} := tuple_sum [the n.-tuple _ of (map (btr P) (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. @@ -1932,7 +1956,7 @@ Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. move=> bRVX/=. -pose mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* btr P (tnth X_ i). +pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* btr P (tnth X_ i). transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. congr expectation => /=; apply: funext => x/=. rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. @@ -1949,7 +1973,7 @@ rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. rewrite (@le_trans _ _ 0%R)//. by rewrite mulr_ge0_le0// ltW. - move=> _ /mapP[/= i _ ->]. - apply: (bounded_RV_integrable (expR `|t|)) => //= t0. + apply: (bounded_RV_integrable (expR `|t|)) => // t0. rewrite expR_ge0/= ler_expR/=. rewrite /bool_to_real/=. case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. @@ -1967,10 +1991,10 @@ Arguments sub_countable [T U]. Arguments card_le_finite [T U]. Lemma bernoulli_mmt_gen_fun (X : {RV P >-> bool}) (t : R) : - bernoulli_RV X -> 'M_(btr P X : {RV P >-> R}) t = (p * expR t + (1-p))%:E. + bernoulli_RV X -> 'M_(btr P X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. Proof. move=> bX. rewrite/mmt_gen_fun. -pose mmtX : {RV P >-> R} := expR \o t \o* (btr P X). +pose mmtX : {RV P >-> R : realType} := expR \o t \o* (btr P X). set A := X @^-1` [set true]. set B := X @^-1` [set false]. have mA: measurable A by exact: measurable_sfunP. @@ -2004,7 +2028,7 @@ Qed. (* wrong lemma *) Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV \X_n P >-> R} in + let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in 'M_X t = ((p * expR t + (1 - p))`^(n%:R))%:E. Proof. move: p01 => /andP[p0 p1] bX/=. @@ -2017,7 +2041,7 @@ Qed. Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : (0 <= t)%R -> is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV \X_n P >-> R} in + let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. Proof. move=> t_ge0 bX/=. @@ -2096,18 +2120,19 @@ rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. +(* TODO: move (to exp.v?) *) Lemma norm_expR : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : is_bernoulli_trial X -> (0 < delta < 1)%R -> - let X' := @bernoulli_trial n X : {RV \X_n P >-> R} in + let X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType} in let mu := 'E_(\X_n P)[X'] in (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. Proof. move=> bX /andP[delta0 delta1] /=. -set X' := @bernoulli_trial n X : {RV \X_n P >-> R}. +set X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType}. set mu := 'E_(\X_n P)[X']. have /andP[p0 p1] := p01. apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). @@ -2125,7 +2150,7 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine have {H1}-> := H1 _ ln1delta. apply: (@le_trans _ _ (((fine 'E_(\X_n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite EFinM lee_pdivlMr ?expR_gt0// muleC fineK. - apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X' : {RV (\X_n P) >-> R}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X' : {RV (\X_n P) >-> R : realType}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. - by apply: expR_gt0. - rewrite norm_expR. have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. From 4f4e745c9f5616703d20481d3122278a5716f7ca Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 12 Mar 2025 23:50:31 +0900 Subject: [PATCH 56/73] memo, renaming --- theories/sampling.v | 282 +++++++++++++++++++++----------------------- 1 file changed, 134 insertions(+), 148 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index ca107dc79c..c76de1bd39 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -509,16 +509,81 @@ Lemma sum_mfunE {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) ((\sum_(f <- s) f) x = sumrfct s x)%R. Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. - End move. -Definition measure_tuple_display : measure_display -> measure_display. -Proof. exact. Qed. +Section move_to_bigop_nat_lemmas. +Context {T : Type}. +Implicit Types (A : set T). + +Lemma bigcup_mkord_ord n (F : 'I_n.+1 -> set T) : + \bigcup_(i < n.+1) F (inord i) = \big[setU/set0]_(i < n.+1) F i. +Proof. +rewrite bigcup_mkord; apply: eq_bigr => /= i _; congr F. +by apply/val_inj => /=;rewrite inordK. +Qed. + +End move_to_bigop_nat_lemmas. + +(* MathComp-Analysis PR in progress *) +Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : + {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. +Proof. +move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. + by case=> B + <- => -[? | ?]; [left | right]; exists B. +by case=> -[] B FGB <-; exists B=> //; [left | right]. +Qed. + +(* MathComp-Analysis PR in progress *) +Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : + preimage_set_system X f set0 = set0. +Proof. by apply/seteqP; split=> A // []. Qed. + +(* MathComp-Analysis PR in progress *) +Lemma preimage_set_system_funcomp + {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} D : + preimage_set_system D (g \o f) F = + preimage_set_system D f (preimage_set_system setT g F). +Proof. +apply/seteqP; split=> A. + case=> B FB <-. + exists (g @^-1` B)=> //. + exists B=> //. + by rewrite setTI. +case=> B [] C FC <- <-. +exists C=> //. +rewrite !setTI. +by rewrite comp_preimage. +Qed. 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} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : +g_sigma_preimage (fun i => (f1 i \o g)) = +preimage_set_system [set: T3] g (g_sigma_preimage f1). +Proof. +rewrite {1}/g_sigma_preimage. +rewrite -g_sigma_preimageE; congr (<>). +destruct n as [|n]. + rewrite !big_ord0 /preimage_set_system/=. + by apply/esym; rewrite -subset0 => t/= []. +rewrite predeqE => C; split. +- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]]. + exists (f1 (Ordinal Ii) @^-1` A). + rewrite -bigcup_mkord_ord; exists i => //. + exists A => //; rewrite setTI// (_ : Ordinal _ = inord i)//. + by apply/val_inj => /=;rewrite inordK. + rewrite !setTI// -comp_preimage// (_ : Ordinal _ = inord i)//. + by apply/val_inj => /=;rewrite inordK. +- move=> [A]. + rewrite -bigcup_mkord_ord => -[i Ii [B mB <-{A}]] <-{C}. + rewrite -bigcup_mkord_ord. + exists i => //. + by exists B => //; rewrite !setTI -comp_preimage. +Qed. + HB.instance Definition _ (n : nat) (T : pointedType) := isPointed.Build (n.-tuple T) (nseq n point). @@ -534,6 +599,9 @@ Proof. exact: countableP. Qed. HB.instance Definition _ d (T : measurableType d) b := MeasurableFun_isDiscrete.Build d _ T _ (cst b) (countable_range_bool T b). +Definition measure_tuple_display : measure_display -> measure_display. +Proof. exact. Qed. + Section measurable_tuple. Context {d} {T : measurableType d}. Variable n : nat. @@ -575,44 +643,6 @@ rewrite -bigcup_seq/=; exists i => //=; first by rewrite mem_index_enum. by exists Y => //; rewrite setTI. Qed. -Section move_to_bigop_nat_lemmas. -Context {T : Type}. -Implicit Types (A : set T). - -Lemma bigcup_mkord_ord n (F : 'I_n.+1 -> set T) : - \bigcup_(i < n.+1) F (inord i) = \big[setU/set0]_(i < n.+1) F i. -Proof. -rewrite bigcup_mkord; apply: eq_bigr => /= i _; congr F. -by apply/val_inj => /=;rewrite inordK. -Qed. - -End move_to_bigop_nat_lemmas. - -Lemma g_sigma_preimage_comp d1 {T1 : semiRingOfSetsType d1} n - {T : pointedType} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : -g_sigma_preimage (fun i => (f1 i \o g)) = -preimage_set_system [set: T3] g (g_sigma_preimage f1). -Proof. -rewrite {1}/g_sigma_preimage. -rewrite -g_sigma_preimageE; congr (<>). -destruct n as [|n]. - rewrite !big_ord0 /preimage_set_system/=. - by apply/esym; rewrite -subset0 => t/= []. -rewrite predeqE => C; split. -- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]]. - exists (f1 (Ordinal Ii) @^-1` A). - rewrite -bigcup_mkord_ord; exists i => //. - exists A => //; rewrite setTI// (_ : Ordinal _ = inord i)//. - by apply/val_inj => /=;rewrite inordK. - rewrite !setTI// -comp_preimage// (_ : Ordinal _ = inord i)//. - by apply/val_inj => /=;rewrite inordK. -- move=> [A]. - rewrite -bigcup_mkord_ord => -[i Ii [B mB <-{A}]] <-{C}. - rewrite -bigcup_mkord_ord. - exists i => //. - by exists B => //; rewrite !setTI -comp_preimage. -Qed. - Section cons_measurable_fun. Context d d1 (T : measurableType d) (T1 : measurableType d1). @@ -672,6 +702,69 @@ Qed. End cons_measurable_fun. +Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : + behead t = [tuple (tnth t (lift ord0 i)) | i < n]. +Proof. +destruct n as [|n]. + rewrite !tuple0. + apply: size0nil. + by rewrite size_behead size_tuple. +apply: (@eq_from_nth _ (tnth_default t ord0)). + by rewrite size_behead !size_tuple. +move=> i ti. +rewrite nth_behead/= (nth_map ord0); last first. + rewrite size_enum_ord. + by rewrite size_behead size_tuple in ti. +rewrite (tnth_nth (tnth_default t ord0)). +congr nth. +rewrite /= /bump/= add1n; congr S. +apply/esym. +rewrite size_behead size_tuple in ti. +have := @nth_ord_enum _ ord0 (Ordinal ti). +by move=> ->. +Qed. + +Lemma measurable_behead d (T : measurableType d) n : + measurable_fun setT (fun x : mtuple n.+1 T => [tuple of behead x] : mtuple n T). +Proof. +red=> /=. +move=> _ Y mY. +rewrite setTI. +set bh := (bh in preimage bh). +have bhYE : (bh @^-1` Y) = [set x :: y | x in setT & y in Y]. + rewrite /bh. + apply/seteqP; split=> x /=. + move=> ?; exists (thead x)=> //. + exists [tuple of behead x] => //=. + by rewrite [in RHS](tuple_eta x). + case=> x0 _ [] y Yy xE. + suff->: [tuple of behead x] = y by []. + apply/val_inj=> /=. + by rewrite -xE. +have:= mY. +rewrite /measurable/= => + F [] sF. +pose F' := image_set_system setT bh F. +move=> /(_ F') /=. +have-> : F' Y = F (bh @^-1` Y) by rewrite /F' /image_set_system /= setTI. +move=> /[swap] H; apply; split; first exact: sigma_algebra_image. +move=> A; rewrite /= /F' /image_set_system /= setTI. +set X := (X in X A). +move => XA. +apply: H; rewrite big_ord_recl /=; right. +set X' := (X' in X' (preimage _ _)). +have-> : X' = preimage_set_system setT bh X. + rewrite /X. + rewrite (big_morph _ preimage_set_systemU preimage_set_system0). + apply: eq_bigr=> i _. + rewrite -preimage_set_system_funcomp. + congr preimage_set_system. + apply: funext=> t. + rewrite (tuple_eta t) /bh /= tnthS. + by congr tnth; apply/val_inj. +exists A=> //. +by rewrite setTI. +Qed. + Section pro1. Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). @@ -708,19 +801,6 @@ HB.instance Definition _ := Measure_isProbability.Build _ _ _ pro2 pro2_setT. End pro2. -(*Lemma measurable_drop d (T : measurableType d) n k : - measurable_fun [set: mtuple n.+1 T] - (fun x : mtuple n.+1 T => [the mtuple (n.+1 - k) T of drop (T := T) k x]). -Proof. -elim: k n => [|k ihk n]. - admit. -rewrite /=. -set f := (X in measurable_fun _ X). -rewrite (_ : f = - (fun x : mtuple n.+1 T => - [the mtuple (n.+1 - k.+1) T of tnth x ord0 :: drop (n.+1 - k) x])). -Admitted.*) - Section pro. Context d (T : measurableType d) (R : realType) (P : probability T R). @@ -863,100 +943,6 @@ move=> d1 d2 T1 T2 R m1 m2 f /integrableP[mf intf]; apply/integrableP; split => by under eq_integral do rewrite abse_id. Qed. -Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : - behead t = [tuple (tnth t (lift ord0 i)) | i < n]. -Proof. -destruct n as [|n]. - rewrite !tuple0. - apply: size0nil. - by rewrite size_behead size_tuple. -apply: (@eq_from_nth _ (tnth_default t ord0)). - by rewrite size_behead !size_tuple. -move=> i ti. -rewrite nth_behead/= (nth_map ord0); last first. - rewrite size_enum_ord. - by rewrite size_behead size_tuple in ti. -rewrite (tnth_nth (tnth_default t ord0)). -congr nth. -rewrite /= /bump/= add1n; congr S. -apply/esym. -rewrite size_behead size_tuple in ti. -have := @nth_ord_enum _ ord0 (Ordinal ti). -by move=> ->. -Qed. - -Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : - {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. -Proof. -move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. - by case=> B + <- => -[? | ?]; [left | right]; exists B. -by case=> -[] B FGB <-; exists B=> //; [left | right]. -Qed. - -Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : - preimage_set_system X f set0 = set0. -Proof. by apply/seteqP; split=> A // []. Qed. - -(* The appropriate name `preimage_set_system_comp` is already occupied by - something different *) -(* TODO: generalize `setT`s in the statement *) -Lemma preimage_set_system_funcomp - {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} : - preimage_set_system setT f (preimage_set_system setT g F) = - preimage_set_system setT (g \o f) F. -Proof. -apply/seteqP; split=> A. - case=> B [] C FC <- <-. - exists C=> //. - rewrite !setTI. - by rewrite comp_preimage. -case=> B FB <-. -exists (g @^-1` B)=> //. -exists B=> //. -by rewrite setTI. -Qed. - -Lemma measurable_behead d (T : measurableType d) n : - measurable_fun setT (fun x : mtuple n.+1 T => [tuple of behead x] : mtuple n T). -Proof. -red=> /=. -move=> _ Y mY. -rewrite setTI. -set bh := (bh in preimage bh). -have bhYE : (bh @^-1` Y) = [set x :: y | x in setT & y in Y]. - rewrite /bh. - apply/seteqP; split=> x /=. - move=> ?; exists (thead x)=> //. - exists [tuple of behead x] => //=. - by rewrite [in RHS](tuple_eta x). - case=> x0 _ [] y Yy xE. - suff->: [tuple of behead x] = y by []. - apply/val_inj=> /=. - by rewrite -xE. -have:= mY. -rewrite /measurable/= => + F [] sF. -pose F' := image_set_system setT bh F. -move=> /(_ F') /=. -have-> : F' Y = F (bh @^-1` Y) by rewrite /F' /image_set_system /= setTI. -move=> /[swap] H; apply; split; first exact: sigma_algebra_image. -move=> A; rewrite /= /F' /image_set_system /= setTI. -set X := (X in X A). -move => XA. -apply: H; rewrite big_ord_recl /=; right. -set X' := (X' in X' (preimage _ _)). -have-> : X' = preimage_set_system setT bh X. - rewrite /X. - rewrite (big_morph _ preimage_set_systemU preimage_set_system0). - apply: eq_bigr=> i _. - rewrite preimage_set_system_funcomp. - congr preimage_set_system. - apply: funext=> t. - rewrite (tuple_eta t) /bh /= tnthS. - by congr tnth; apply/val_inj. -exists A=> //. -by rewrite setTI. -Qed. - Section proS. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. From 188117481c2af1fb0a262c7b04d088a61e9cad64 Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Thu, 13 Mar 2025 01:55:52 +0900 Subject: [PATCH 57/73] HARD part done --- theories/sampling.v | 123 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 122 insertions(+), 1 deletion(-) diff --git a/theories/sampling.v b/theories/sampling.v index c76de1bd39..7f1c2ebb61 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -25,6 +25,23 @@ Import numFieldTopology.Exports numFieldNormedType.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +Section product_probability2. +Local Open Scope ereal_scope. +Lemma product_probability2_setT : + forall (d1 d2 : measure_display) (T1 : measurableType d1) (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) (P2 : probability T2 R), (P1 \x^ P2) setT = 1%E. +Proof. +move=> ? ? ? ? ? P1 P2. +rewrite -setXTT product_measure2E// -[RHS]mul1e. +congr mule. +all: rewrite -[LHS]fineK ?fin_num_measure//. +all: congr EFin=> /=. +all: by rewrite probability_setT. +Qed. + +HB.instance Definition _ (d1 d2 : measure_display) (T1 : measurableType d1) (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) (P2 : probability T2 R):= + Measure_isProbability.Build _ _ _ (P1 \x^ P2) (product_probability2_setT P1 P2). +End product_probability2. + Section independent_events. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. @@ -1565,6 +1582,20 @@ congr EFin. by rewrite [in RHS](tuple_eta X) tnthS. Qed. +Section fset. +Local Open Scope fset_scope. +Lemma fset_bool : forall B : {fset bool}, + [\/ B == [fset true], B == [fset false], B == fset0 | B == [fset true; false]]. +Proof. +move=> B. +have:= set_bool [set` B]. +rewrite -!set_fset1 -set_fset0. +rewrite (_ : [set: bool] = [set` [fset true; false]]); last first. + by apply/seteqP; split=> -[]; rewrite /= !inE eqxx. +by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; + [apply: Or41|apply: Or42|apply: Or43|apply: Or44]. +Qed. +End fset. Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : independent_RVs (P := P) [set: 'I_n] (tnth X) -> @@ -1600,7 +1631,97 @@ rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. simpl in Y1, Y2. rewrite expectation_prod; last 3 first. -- admit. (* HARD *) +- split. + move=> i /= _ A. + case: ifP=> Hi /=. + by case=> B mB <-; exact: (mX1). + by case=> B mB <-; exact: (mX2). + move=> /= J ? E Ei. + case: (fset_bool J)=> /eqP HJ; rewrite -> HJ in * |- *; clear J HJ. + + by rewrite !big_seq_fset1. + + by rewrite !big_seq_fset1. + + rewrite !big_seq_fset0. + suff-> : [set (thead x, [tuple of behead x]) | x in [set: mtuple n.+1 T]] = setT. + by rewrite probability_setT. + apply/seteqP; split=> -[t1 t2] //= _. + exists [tuple of t1 :: t2] => //=. + by rewrite theadE; congr pair; exact/val_inj. + + rewrite !big_fsetU1 ?inE//= !big_seq_fset1. + set E1 := E true. + set E2 := E false. + have EX1 : E1 \in g_sigma_algebra_preimage X1. + by have:= Ei true; rewrite !inE eqxx=> /(_ erefl). + have EX2 : E2 \in g_sigma_algebra_preimage X2. + by have:= Ei false; rewrite !inE eqxx orbT=> /(_ erefl). + clear Ei X0 intX0 intX Y1 Y2 build_mX1 build_mX2. + (* analyze EX2 *) + have:= EX2. + rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. + under [f in image _ f]funext=> /= B do rewrite setTI. + rewrite inE/=. + case=> B2 mB2. + move=> /[dup] EX2' <-. + (* analyze EX1 *) + have:= EX1. + rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. + under [f in image _ f]funext=> /= B. + rewrite setTI. + rewrite (_ : mkset _ = [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth (behead_tuple t) (i : 'I_n.+1.-1)))%R]); last first. + apply/eq_set=> t. + rewrite /X1 [in LHS](tuple_eta t) [in LHS](tuple_eta X). + by under eq_bigr do rewrite !tnthS. + rewrite + (_ : + mkset _ = + image (setT `*` + [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth t i))%R]) + (fun t => [tuple of t.1 :: t.2]) ); last first. + apply/seteqP; split=> t; rewrite (tuple_eta t) /=. + have-> : behead_tuple [tuple of thead t :: behead t] = behead_tuple t by exact/val_inj. + by move=> H; exists (thead t, behead_tuple t) => //; split. + case=> -[x0 x] [] _ /= H <-. + by have-> : behead_tuple [tuple of x0 :: x] = x by exact/val_inj. + over. + set X' : n.-tuple _ := behead_tuple X. + rewrite inE /=. + case=> B' mB'. + move<-. + (* simplify LHS *) + set E1'' := mkset _. + have mE1'' : measurable (E1'' : set (mtuple _ _)). + rewrite /E1'' -/(preimage _ _). + set f : mtuple n T -> R := (f in preimage f). + suff: measurable_fun setT f by rewrite -[preimage _ _]setTI; exact. + rewrite /f. + apply: measurable_prod=> /= i _. + apply: (measurable_comp measurableT)=> //=. + exact: measurable_tnth. + (* simplify LHS *) + rewrite [image _ _](_ : _ = (thead X @^-1` B2) `*` E1''); last first. + apply/seteqP; split=> -[x0 x] /=. + case=> x1 [] [] [y0 y] /= [] _ ? <- /[!theadE] ? /eqP /[!xpair_eqE] /andP [] /eqP <- /eqP /= <-. + rewrite [y in E1'' y](_ : _ = y)//. + exact/val_inj. + case=> ? ?. + exists [tuple of x0 :: x]; last by congr pair; apply/val_inj. + split=> //. + by exists (x0, x). + rewrite product_measure2E//=; last first. + by rewrite -[preimage _ _]setTI; exact: measurable_funP. + (* simplify RHS *) + rewrite image_comp [f in image _ f](_ : _ = idfun); last first. + by apply/funext=> -[t0 t] /=; congr pair; exact/val_inj. + rewrite image_id product_measure2E//. + rewrite [X in _ = X * _ * _]probability_setT mul1e /=. + rewrite muleC; congr mule. + rewrite (_ : image _ _ = thead X @^-1` B2 `*` setT); last first. + apply/seteqP; split=> /= -[t0 t] /=. + by case=> x ? /eqP /[!xpair_eqE] /andP [] /eqP <- _. + case=> ? _; exists [tuple of t0 :: t]; rewrite ?theadE//. + by congr pair; exact/val_inj. + rewrite product_measure2E//; last first. + by rewrite -[preimage _ _]setTI; exact: measurable_funP. + by rewrite [X in _ = _ * X]probability_setT mule1. - admit. - admit. rewrite big_ord_recl. From 85a85d75116b53ad018d6f149fc25b10d7718d14 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 14 Mar 2025 18:47:25 +0900 Subject: [PATCH 58/73] splitting sampling_wip.v --- _CoqProject | 1 + theories/Make | 1 + theories/sampling.v | 815 +----------- theories/sampling_wip.v | 2636 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 2655 insertions(+), 798 deletions(-) create mode 100644 theories/sampling_wip.v diff --git a/_CoqProject b/_CoqProject index a2b2d6530a..967ac9423f 100644 --- a/_CoqProject +++ b/_CoqProject @@ -114,6 +114,7 @@ theories/ftc.v theories/hoelder.v theories/probability.v theories/sampling.v +theories/sampling_wip.v theories/convex.v theories/charge.v theories/kernel.v diff --git a/theories/Make b/theories/Make index 61a9b5a52a..3980bb3697 100644 --- a/theories/Make +++ b/theories/Make @@ -79,6 +79,7 @@ ftc.v hoelder.v probability.v sampling.v +sampling_wip.v lebesgue_stieltjes_measure.v convex.v charge.v diff --git a/theories/sampling.v b/theories/sampling.v index 7f1c2ebb61..682c7ff4de 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -7,18 +7,20 @@ Require Reals Interval.Tactic. From mathcomp Require Import (canonicals) Rstruct Rstruct_topology. From HB Require Import structures. From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. -From mathcomp Require Import reals ereal interval_inference topology normedtype sequences. -From mathcomp Require Import realfun convex. +From mathcomp Require Import reals ereal interval_inference topology normedtype. +From mathcomp Require Import sequences realfun convex. From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral kernel probability. From mathcomp Require Import independence. -Reserved Notation "' P [ A | B ]". - Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. +(**md**************************************************************************) +(* This file contains the formalization of a sampling theorem *) +(******************************************************************************) + Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldTopology.Exports numFieldNormedType.Exports. @@ -28,7 +30,9 @@ Local Open Scope ring_scope. Section product_probability2. Local Open Scope ereal_scope. Lemma product_probability2_setT : - forall (d1 d2 : measure_display) (T1 : measurableType d1) (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) (P2 : probability T2 R), (P1 \x^ P2) setT = 1%E. + forall (d1 d2 : measure_display) (T1 : measurableType d1) + (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) + (P2 : probability T2 R), (P1 \x^ P2) setT = 1%E. Proof. move=> ? ? ? ? ? P1 P2. rewrite -setXTT product_measure2E// -[RHS]mul1e. @@ -38,414 +42,14 @@ all: congr EFin=> /=. all: by rewrite probability_setT. Qed. -HB.instance Definition _ (d1 d2 : measure_display) (T1 : measurableType d1) (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) (P2 : probability T2 R):= +HB.instance Definition _ (d1 d2 : measure_display) (T1 : measurableType d1) + (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) + (P2 : probability T2 R):= Measure_isProbability.Build _ _ _ (P1 \x^ P2) (product_probability2_setT P1 P2). End product_probability2. -Section independent_events. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Lemma sub_independent_events (I : choiceType) (A B : set I) (E : I -> set T) : - A `<=` B -> independent_events P B E -> independent_events P A E. -Proof. -by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. -Qed. - -Definition kwise_independent (I : choiceType) (A : set I) (E : I -> set T) k := - (forall i, A i -> measurable (E i)) /\ - forall B : {fset I}, [set` B] `<=` A -> (#|` B | <= k)%nat -> - P (\bigcap_(i in [set` B]) E i) = \prod_(i <- B) P (E i). - -Lemma sub_kwise_independent (I : choiceType) (A B : set I) (E : I -> set T) k : - A `<=` B -> kwise_independent B E k -> kwise_independent A E k. -Proof. -by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. -Qed. - -Lemma mutual_indep_is_kwise_indep (I : choiceType) (A : set I) (E : I -> set T) k : - independent_events P A E -> kwise_independent A E k. -Proof. -rewrite /independent_events /kwise_independent. -move=> [mE miE]; split=> // B BleA _. -exact: miE. -Qed. - -Lemma nwise_indep_is_mutual_indep (I : choiceType) (A : {fset I}) (E : I -> set T) n : - #|` A | = n -> kwise_independent [set` A] E n -> independent_events P [set` A] E. -Proof. -rewrite /independent_events /kwise_independent. -move=> nA [mE miE]; split=> // B BleA. -apply: miE => //; rewrite -nA fsubset_leq_card//. -by apply/fsubsetP => x xB; exact: (BleA x). -Qed. - -Lemma mutually_independent_weak (I : choiceType) (E : I -> set T) (B : set I) : - (forall b, ~ B b -> E b = setT) -> - independent_events P [set: I] E <-> - independent_events P B E. -Proof. -move=> BE; split; first exact: sub_independent_events. -move=> [mE h]; split=> [i _|C _]. - by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. -have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. -rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. -rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. -have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. - exists (fset_set ([set` C] `&` B)). - by rewrite fset_setK//; exact: finite_setIl. -rewrite CBD h; last first. - rewrite -CBD; exact: subIsetr. -rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. -rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. - by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. -by rewrite CBD -fsbig_seq. -Qed. - -Lemma kwise_independent_weak (I : choiceType) (E : I -> set T) (B : set I) k : - (forall b, ~ B b -> E b = setT) -> - kwise_independent [set: I] E k <-> - kwise_independent B E k. -Proof. -move=> BE; split; first exact: sub_kwise_independent. -move=> [mE h]; split=> [i _|C _ Ck]. - by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. -have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. -rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. -rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. -have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. - exists (fset_set ([set` C] `&` B)). - by rewrite fset_setK//; exact: finite_setIl. -rewrite CBD h; last 2 first. - - rewrite -CBD; exact: subIsetr. - - rewrite (leq_trans _ Ck)// fsubset_leq_card// -(set_fsetK D) -(set_fsetK C). - by rewrite -fset_set_sub// -CBD; exact: subIsetl. -rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. -rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. - by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. -by rewrite CBD -fsbig_seq. -Qed. - -Lemma kwise_independent_weak01 E1 E2 : - kwise_independent [set: nat] (bigcap2 E1 E2) 2%N <-> - kwise_independent [set 0%N; 1%N] (bigcap2 E1 E2) 2%N. -Proof. -apply: kwise_independent_weak. -by move=> n /= /not_orP[/eqP /negbTE -> /eqP /negbTE ->]. -Qed. - -Lemma independent_events_weak' (I : choiceType) (E : I -> set T) (B : set I) : - (forall b, ~ B b -> E b = setT) -> - independent_events P [set: I] E <-> - independent_events P B E. -Proof. -move=> BE; split; first exact: sub_independent_events. -move=> [mE h]; split=> [i _|C CI]. - by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. -have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. -rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. -rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. -have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. - exists (fset_set ([set` C] `&` B)). - by rewrite fset_setK//; exact: finite_setIl. -rewrite CBD h; last first. - - rewrite -CBD; exact: subIsetr. -rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. -rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. - by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. -by rewrite CBD -fsbig_seq. -Qed. - -Definition pairwise_independent E1 E2 := - kwise_independent [set 0; 1]%N (bigcap2 E1 E2) 2. - -Lemma pairwise_independentM_old (E1 E2 : set T) : - pairwise_independent E1 E2 <-> - [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. -Proof. -split. -- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. - rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. - + by rewrite set_fsetU !set_fset1; exact: subset_refl. - + rewrite cardfs2//. - split => //. - + by apply: (mE1E2 0%N) => /=; left. - + by apply: (mE1E2 1%N) => /=; right. -- move=> [mE1 mE2 E1E2M]. - split => //=. - + by move=> [| [| [|]]]//=. - + move=> B _; have [B0|B0] := boolP (0%N \in B); last first. - have [B1|B1] := boolP (1%N \in B); last first. - rewrite big1_fset; last first. - move=> k kB _; rewrite /bigcap2. - move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. - move: kB B1; case: ifPn => [/eqP -> ->//|_ _ _]. - by rewrite probability_setT. - rewrite bigcapT ?probability_setT// => k/= kB. - move: kB B0 B1; case: ifPn => [/eqP -> ->//|k0]. - by case: ifPn => [/eqP -> ->|]. - rewrite (bigcap_setD1 1%N _ [set` B])//=. - rewrite bigcapT ?setIT; last first. - move=> k [/= kB /eqP /negbTE ->]. - by move: kB B0; case: ifPn => [/eqP -> ->|]. - rewrite (big_fsetD1 1%N)//= big1_fset ?mule1// => k. - rewrite !inE => /andP[/negbTE -> kB] _. - move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. - by rewrite probability_setT. - rewrite (bigcap_setD1 0%N _ [set` B])//. - have [B1|B1] := boolP (1%N \in B); last first. - rewrite bigcapT ?setIT; last first. - move=> k [/= kB /eqP /negbTE ->]. - by move: kB B1; case: ifPn => [/eqP -> ->|]. - rewrite (big_fsetD1 0%N)//= big1_fset ?mule1// => k. - rewrite !inE => /andP[/negbTE -> kB] _. - move: kB B1; case: ifPn => [/eqP -> ->//|k1 kB B1]. - by rewrite probability_setT. - rewrite (bigcap_setD1 1%N _ ([set` B] `\ 0%N))// bigcapT ?setIT; last first. - by move=> n/= [[nB]/eqP/negbTE -> /eqP/negbTE ->]. - rewrite E1E2M (big_fsetD1 0%N)//= (big_fsetD1 1%N)/=; last by rewrite !inE B1. - rewrite big1_fset ?mule1//= => k. - rewrite !inE => -/and3P[/negbTE -> /negbTE -> kB] _; - by rewrite probability_setT. -Qed. - -Lemma pairwise_independentM (E1 E2 : set T) : - pairwise_independent E1 E2 <-> - [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. -Proof. -split. -- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. - rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. - + by rewrite set_fsetU !set_fset1; exact: subset_refl. - + by rewrite cardfs2. - split => //. - + by apply: (mE1E2 0%N) => /=; left. - + by apply: (mE1E2 1%N) => /=; right. -- move=> [mE1 mE2 E1E2M]. - rewrite /pairwise_independent. - split. - + by move=> [| [| [|]]]//=. - + move=> B B01 B2. - have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. - * rewrite B_set0. - move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. - by rewrite big_nil bigcap_set0 probability_setT. - * rewrite B_set0 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set0 fsbig_set1/=. - * rewrite B_set1 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set1 fsbig_set1/=. - * rewrite B_set01 bigcap_setU1 bigcap_set1/=. - rewrite fsbig_seq//= B_set01. - rewrite fsbigU//=; last first. - by move=> n [/= ->]. - by rewrite !fsbig_set1//=. -Qed. - -Lemma pairwise_independent_setC (E1 E2 : set T) : - pairwise_independent E1 E2 -> pairwise_independent E1 (~` E2). -Proof. -rewrite/pairwise_independent. -move/pairwise_independentM=> [mE1 mE2 h]. -apply/pairwise_independentM; split=> //. -- exact: measurableC. -- rewrite -setDE measureD//; last first. - exact: (le_lt_trans (probability_le1 P mE1) (ltry _)). - rewrite probability_setC// muleBr// ?mule1 -?h//. - by rewrite fin_num_measure. -Qed. - -Lemma pairwise_independentC (E1 E2 : set T) : - pairwise_independent E1 E2 -> pairwise_independent E2 E1. -Proof. -rewrite/pairwise_independent/kwise_independent; move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. -rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => h. -split. -- case=> [_|[_|]]//=. - + by apply: (mE1E2 1%N) => /=; right. - + by apply: (mE1E2 0%N) => /=; left. -- move=> B B01 B2. - have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. - + rewrite B_set0. - move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. - by rewrite big_nil bigcap_set0 probability_setT. - + rewrite B_set0 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set0 fsbig_set1/=. - + rewrite B_set1 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set1 fsbig_set1/=. - + rewrite B_set01 bigcap_setU1 bigcap_set1/=. - rewrite fsbig_seq//= B_set01. - rewrite fsbigU//=; last first. - by move=> n [/= ->]. - rewrite !fsbig_set1//= muleC setIC. - apply: h. - * by rewrite set_fsetU !set_fset1; exact: subset_refl. - * by rewrite cardfs2. -Qed. -(* ale: maybe interesting is thm 8.3 and exercise 8.6 from shoup/ntb at this point *) - -End independent_events. - -Section conditional_probability. -Context d (T : measurableType d) (R : realType). -Local Open Scope ereal_scope. - -Definition conditional_probability (P : probability T R) E1 E2 := (fine (P (E1 `&` E2)) / fine (P E2))%:E. -Local Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). - -Lemma conditional_independence (P : probability T R) E1 E2 : - P E2 != 0 -> pairwise_independent P E1 E2 -> 'P [ E1 | E2 ] = P E1. -Proof. -move=> PE2ne0 iE12. -have /= mE1 := (iE12.1 0%N). -have /= mE2 := (iE12.1 1%N). -rewrite/conditional_probability. -have [_ _ ->] := (pairwise_independentM _ _ _).1 iE12. -rewrite fineM ?fin_num_measure//; [|apply: mE1; left=>//|apply: mE2; right=>//]. -rewrite -mulrA mulfV ?mulr1 ?fineK// ?fin_num_measure//; first by apply: mE1; left. -by rewrite fine_eq0// fin_num_measure//; apply: mE2; right. -Qed. - -(* TODO (klenke thm 8.4): if P B > 0 then 'P[.|B] is a probability measure *) - -Lemma conditional_independent_is_pairwise_independent (P : probability T R) E1 E2 : - d.-measurable E1 -> d.-measurable E2 -> - P E2 != 0 -> - 'P[E1 | E2] = P E1 -> pairwise_independent P E1 E2. -Proof. -rewrite /conditional_probability/pairwise_independent=> mE1 mE2 pE20 pE1E2. -split. -- by case=> [|[|]]//=. -- move=> B B01 B2; have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. - + rewrite B_set0. - move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. - by rewrite big_nil bigcap_set0 probability_setT. - + rewrite B_set0 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set0 fsbig_set1/=. - + rewrite B_set1 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set1 fsbig_set1/=. - + rewrite B_set01 bigcap_setU1 bigcap_set1/=. - rewrite fsbig_seq//= B_set01. - rewrite fsbigU//=; last first. - by move=> n [/= ->]. - rewrite !fsbig_set1//= -pE1E2 -{2}(@fineK _ (P E2)). - rewrite -EFinM -mulrA mulVf ?mulr1 ?fine_eq0// ?fineK//. - all: by apply: fin_num_measure => //; apply: measurableI. -Qed. - -Lemma conditional_independentC (P : probability T R) E1 E2 : - d.-measurable E1 -> d.-measurable E2 -> - P E1 != 0 -> P E2 != 0 -> - reflect ('P[E1 | E2] == P E1) ('P[E2 | E1] == P E2). -Proof. -move=> mE1 mE2 pE10 pE20. -apply/(iffP idP)=>/eqP. -+ move/(@conditional_independent_is_pairwise_independent _ _ _ mE2 mE1 pE10). - move/pairwise_independentC. - by move/(conditional_independence pE20)/eqP. -+ move/(@conditional_independent_is_pairwise_independent _ _ _ mE1 mE2 pE20). - move/pairwise_independentC. - by move/(conditional_independence pE10)/eqP. -Qed. - -(* Lemma summation (I : choiceType) (A : {fset I}) E F (P : probability T R) : *) -(* (* the sets are disjoint *) *) -(* P (\bigcap_(i in [set` A]) F i) = 1 -> P E = \prod_(i <- A) ('P [E | F i] * P (F i)). *) -(* Proof. *) -(* move=> pF1. *) - -Lemma bayes (P : probability T R) E F : - d.-measurable E -> d.-measurable F -> - 'P[ E | F ] = ((fine ('P[F | E] * P E)) / (fine (P F)))%:E. -Proof. -rewrite /conditional_probability => mE mF. -have [PE0|PE0] := eqVneq (P E) 0. - have -> : P (E `&` F) = 0. - by apply/eqP; rewrite eq_le -{1}PE0 (@measureIl _ _ _ P E F mE mF)/= measure_ge0. - by rewrite PE0 fine0 invr0 mulr0 mule0 mul0r. -by rewrite -{2}(@fineK _ (P E)) -?EFinM -?(mulrA (fine _)) ?mulVf ?fine_eq0 ?fin_num_measure// mul1r setIC//. -Qed. - -End conditional_probability. -Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). - From mathcomp Require Import real_interval. -Section independent_RVs. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Definition pairwise_independent_RV (X Y : {RV P >-> R}) := - forall s t, pairwise_independent P (X @^-1` s) (Y @^-1` t). - -Lemma conditional_independent_RV (X Y : {RV P >-> R}) : - pairwise_independent_RV X Y -> - forall s t, P (Y @^-1` t) != 0 -> 'P [X @^-1` s | Y @^-1` t] = P (X @^-1` s). -Proof. -move=> iRVXY s t PYtne0. -exact: conditional_independence. -Qed. - -Definition mutually_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := - forall x_ : I -> R, independent_events P A (fun i => X i @^-1` `[(x_ i), +oo[%classic). - -Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := - forall x_ : I -> R, kwise_independent P A (fun i => X i @^-1` `[(x_ i), +oo[%classic) k. - -Lemma nwise_indep_is_mutual_indep_RV (I : choiceType) (A : {fset I}) (X : I -> {RV P >-> R}) n : - #|` A | = n -> kwise_independent_RV [set` A] X n -> mutually_independent_RV [set` A] X. -Proof. -rewrite/mutually_independent_RV/kwise_independent_RV=> nA kwX s. -by apply: nwise_indep_is_mutual_indep; rewrite ?nA. -Qed. - -(* alternative formalization -Definition inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := - forall (s : I -> set R), mutually_independent P A (fun i => X i @^-1` s i). - -Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := - forall (s : I -> set R), kwise_independent P A (fun i => X i @^-1` s i) k. - -this should be equivalent according to wikipedia https://en.wikipedia.org/wiki/Independence_(probability_theory)#For_real_valued_random_variables -*) - -(* Remark 2.15 (i) *) -Lemma prob_inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) : - mutually_independent_RV A X -> - forall J : {fset I}, [set` J] `<=` A -> - forall x_ : I -> R, - P (\bigcap_(i in [set` J]) X i @^-1` `[(x_ i), +oo[%classic) = - \prod_(i <- J) P (X i @^-1` `[(x_ i), +oo[%classic). -Proof. -move=> iRVX J JleA x_. -apply: (iRVX _).2 => //. -Qed. - -(* -Lemma mutually_independent_RV' (I : choiceType) (A : set I) - (X : I -> {RV P >-> R}) (S : I -> set R) : - mutually_independent_RV A X -> - (forall i, A i -> measurable (S i)) -> - mutually_independent P A (fun i => X i @^-1` S i). -Proof. -move=> miX mS. -split; first by move=> i Ai; exact/measurable_sfunP/(mS i Ai). -move=> B BA. -Abort. -*) - -Lemma inde_expectation (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) : - mutually_independent_RV A X -> - forall B : {fset I}, [set` B] `<=` A -> - 'E_P[\prod_(i <- B) X i] = \prod_(i <- B) 'E_P[X i]. -Proof. -move=> AX B BA. -rewrite [in LHS]unlock. -rewrite /mutually_independent_RV in AX. -rewrite /independent_events in AX. -Abort. - -End independent_RVs. - Section bool_to_real. Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). @@ -466,27 +70,6 @@ Definition btr : {RV P >-> R} := bool_to_real. End bool_to_real. -Section independent_RVs_btr. -Context {R : realType} d (T : measurableType d). -Variable P : probability T R. -Local Open Scope ring_scope. - -Lemma independent_RVs_btr - n (X : n.-tuple {mfun T >-> bool}) : - independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] (fun i => btr P (tnth X i)). -Proof. -move=> PIX; split. -- move=> i Ii. - rewrite /g_sigma_algebra_preimage/= /preimage_set_system/= => _ [A mA <-]. - by rewrite setTI; exact/measurable_sfunP. -- move=> J JI E/= JEfX; apply PIX => // j jJ. - have := JEfX _ jJ; rewrite !inE. - rewrite /g_sigma_algebra_preimage /preimage_set_system/= => -[A mA <-]. - by exists ((fun x => x%:R) @^-1` A). -Qed. - -End independent_RVs_btr. - Section mfunM. Context {d} (T : measurableType d) {R : realType}. @@ -541,7 +124,7 @@ Qed. End move_to_bigop_nat_lemmas. -(* MathComp-Analysis PR in progress *) +(* in master *) Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. Proof. @@ -550,12 +133,12 @@ move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. by case=> -[] B FGB <-; exists B=> //; [left | right]. Qed. -(* MathComp-Analysis PR in progress *) +(* in master *) Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : preimage_set_system X f set0 = set0. Proof. by apply/seteqP; split=> A // []. Qed. -(* MathComp-Analysis PR in progress *) +(* in master *) Lemma preimage_set_system_funcomp {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} D : preimage_set_system D (g \o f) F = @@ -643,11 +226,13 @@ HB.instance Definition _ := End measurable_tuple. +(* NB: not used *) Definition cylinder d {T : measurableType d} m (A : set (m.-tuple T)) (J : {fset 'I_m}%fset) : set (m.-tuple T) := \big[setI/setT]_(i <- J) (@tnth _ T ^~ i) @^-1` ((@tnth _ T ^~ i) @` A). +(* NB: not used *) Definition Z d {T : measurableType d} m (J : {fset 'I_m}%fset) : set_system (m.-tuple T) := [set B | exists A, B = cylinder A J]. @@ -1125,37 +710,6 @@ End integral_sum. (* TODO: integral_fune_lt_pinfty does not look useful a lemma *) -Section integrable_thead. -Context d (T : measurableType d) (R : realType). -Variables (P : probability T R) (n : nat) (X : n.+1.-tuple {RV P >-> R}). - -Lemma integrable_thead : P.-integrable setT (EFin \o thead X) -> - (\X_n.+1 P).-integrable [set: mtuple n.+1 T] - (EFin \o (fun x => thead X (thead x))). -Proof. -move=> intX. -apply/integrableP; split. - apply: measurableT_comp => //. - apply: measurableT_comp => //. - exact: measurable_tnth. -rewrite integral_mpro. -- rewrite -fubini1'//=. - + move/integrableP : (intX) => [_]. - + apply: le_lt_trans. - rewrite le_eqVlt; apply/orP; left; apply/eqP. - apply: eq_integral => x _. - rewrite /fubini_F/=. - admit. - + apply/fubini1b => //=. - * admit. - * admit. -- apply/integrableP; split. - + admit. - + rewrite integral_mpro. -Abort. - -End integrable_thead. - Lemma bounded_RV_integrable d (T : measurableType d) (R : realType) (P : probability T R) (X : T -> R) M : measurable_fun setT X -> @@ -1429,7 +983,6 @@ Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : P1.-integrable setT (EFin \o X) -> P2.-integrable setT (EFin \o Y) -> -(* independent_RVs2 P X Y -> NB: independence not used *) let XY := fun (x : T1 * T2) => (X x.1 * Y x.2)%R in 'E_(pro2 P1 P2)[XY] = 'E_P1[X] * 'E_P2[Y]. Proof. @@ -1473,16 +1026,6 @@ Section properties_of_independence. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Lemma independent_mmt_gen_fun n (X : n.-tuple {RV P >-> bool}) t : - let mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* (btr P (tnth X i)) in - independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] mmtX. -Proof. -rewrite /= => PnX. -apply: independent_RVs_comp => //. -apply: independent_RVs_scale => //=. -exact: independent_RVs_btr. -Qed. - Lemma boundedM U (f g : U -> R) (A : set U) : [bounded f x | x in A] -> [bounded g x | x in A] -> @@ -1502,7 +1045,6 @@ by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. Unshelve. all: by end_near. Qed. - Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : (forall i t, (0 <= tnth X i t <= M)%R) -> (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> @@ -1597,158 +1139,6 @@ by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; Qed. End fset. -Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : - independent_RVs (P := P) [set: 'I_n] (tnth X) -> - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. -Proof. -elim: n X => [X|n IH X] /= iRVX intX. - rewrite /tuple_prod. - under eq_fun do rewrite big_ord0. - by rewrite big_ord0 expectation_cst. -pose X0 := thead X. -have intX0 : P.-integrable [set: T] (EFin \o X0). - by apply: intX; rewrite mem_tnth. -have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). - by move=> XiX; exact: intX. - -pose X1 (x : mtuple n.+1 T) := - (\prod_(i < n) tnth X (lift ord0 i) (tnth x (lift ord0 i)))%R. -have mX1 : measurable_fun setT X1. - apply: measurable_prod => /= i ?. apply: measurableT_comp => //. - exact: measurable_tnth. -pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. -pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). -have mX2 : measurable_fun setT X2. -rewrite /X2 /=. - by apply: measurableT_comp => //; exact: measurable_tnth. -pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. -rewrite /tuple_prod. -under eq_fun => x /=. rewrite big_ord_recl/=. over. -rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. -simpl in Y1, Y2. - -rewrite expectation_prod; last 3 first. -- split. - move=> i /= _ A. - case: ifP=> Hi /=. - by case=> B mB <-; exact: (mX1). - by case=> B mB <-; exact: (mX2). - move=> /= J ? E Ei. - case: (fset_bool J)=> /eqP HJ; rewrite -> HJ in * |- *; clear J HJ. - + by rewrite !big_seq_fset1. - + by rewrite !big_seq_fset1. - + rewrite !big_seq_fset0. - suff-> : [set (thead x, [tuple of behead x]) | x in [set: mtuple n.+1 T]] = setT. - by rewrite probability_setT. - apply/seteqP; split=> -[t1 t2] //= _. - exists [tuple of t1 :: t2] => //=. - by rewrite theadE; congr pair; exact/val_inj. - + rewrite !big_fsetU1 ?inE//= !big_seq_fset1. - set E1 := E true. - set E2 := E false. - have EX1 : E1 \in g_sigma_algebra_preimage X1. - by have:= Ei true; rewrite !inE eqxx=> /(_ erefl). - have EX2 : E2 \in g_sigma_algebra_preimage X2. - by have:= Ei false; rewrite !inE eqxx orbT=> /(_ erefl). - clear Ei X0 intX0 intX Y1 Y2 build_mX1 build_mX2. - (* analyze EX2 *) - have:= EX2. - rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. - under [f in image _ f]funext=> /= B do rewrite setTI. - rewrite inE/=. - case=> B2 mB2. - move=> /[dup] EX2' <-. - (* analyze EX1 *) - have:= EX1. - rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. - under [f in image _ f]funext=> /= B. - rewrite setTI. - rewrite (_ : mkset _ = [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth (behead_tuple t) (i : 'I_n.+1.-1)))%R]); last first. - apply/eq_set=> t. - rewrite /X1 [in LHS](tuple_eta t) [in LHS](tuple_eta X). - by under eq_bigr do rewrite !tnthS. - rewrite - (_ : - mkset _ = - image (setT `*` - [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth t i))%R]) - (fun t => [tuple of t.1 :: t.2]) ); last first. - apply/seteqP; split=> t; rewrite (tuple_eta t) /=. - have-> : behead_tuple [tuple of thead t :: behead t] = behead_tuple t by exact/val_inj. - by move=> H; exists (thead t, behead_tuple t) => //; split. - case=> -[x0 x] [] _ /= H <-. - by have-> : behead_tuple [tuple of x0 :: x] = x by exact/val_inj. - over. - set X' : n.-tuple _ := behead_tuple X. - rewrite inE /=. - case=> B' mB'. - move<-. - (* simplify LHS *) - set E1'' := mkset _. - have mE1'' : measurable (E1'' : set (mtuple _ _)). - rewrite /E1'' -/(preimage _ _). - set f : mtuple n T -> R := (f in preimage f). - suff: measurable_fun setT f by rewrite -[preimage _ _]setTI; exact. - rewrite /f. - apply: measurable_prod=> /= i _. - apply: (measurable_comp measurableT)=> //=. - exact: measurable_tnth. - (* simplify LHS *) - rewrite [image _ _](_ : _ = (thead X @^-1` B2) `*` E1''); last first. - apply/seteqP; split=> -[x0 x] /=. - case=> x1 [] [] [y0 y] /= [] _ ? <- /[!theadE] ? /eqP /[!xpair_eqE] /andP [] /eqP <- /eqP /= <-. - rewrite [y in E1'' y](_ : _ = y)//. - exact/val_inj. - case=> ? ?. - exists [tuple of x0 :: x]; last by congr pair; apply/val_inj. - split=> //. - by exists (x0, x). - rewrite product_measure2E//=; last first. - by rewrite -[preimage _ _]setTI; exact: measurable_funP. - (* simplify RHS *) - rewrite image_comp [f in image _ f](_ : _ = idfun); last first. - by apply/funext=> -[t0 t] /=; congr pair; exact/val_inj. - rewrite image_id product_measure2E//. - rewrite [X in _ = X * _ * _]probability_setT mul1e /=. - rewrite muleC; congr mule. - rewrite (_ : image _ _ = thead X @^-1` B2 `*` setT); last first. - apply/seteqP; split=> /= -[t0 t] /=. - by case=> x ? /eqP /[!xpair_eqE] /andP [] /eqP <- _. - case=> ? _; exists [tuple of t0 :: t]; rewrite ?theadE//. - by congr pair; exact/val_inj. - rewrite product_measure2E//; last first. - by rewrite -[preimage _ _]setTI; exact: measurable_funP. - by rewrite [X in _ = _ * X]probability_setT mule1. -- admit. -- admit. -rewrite big_ord_recl. -congr (_ * _). - admit. - -under eq_bigr => i _ do rewrite [X in tnth X]tuple_eta tnthS. -rewrite -IH; last 2 first. -- admit. -- admit. -rewrite /Y1/X1/tuple_prod/=. -under eq_fun => x. under eq_bigr => i _. rewrite [X in tnth X]tuple_eta [X in _ (tnth X _)]tuple_eta !tnthS. over. over. -rewrite /=. -rewrite unlock /expectation integral_mpro//. - under eq_fun => x. under eq_bigr => i _. - rewrite (tnth_behead (x.1 :: x.2)) (_ : inord i.+1 = lift ord0 i) ?tnthS; last first. - by apply: val_inj; rewrite /=inordK// ltnS. - over. - over. - simpl. - rewrite -fubini2'/fubini_G/=. - apply: eq_integral => x _/=. - by rewrite integral_cst//= probability_setT mule1. - admit. -admit. -Abort. - Lemma finite_prod n (F : 'I_n -> \bar R) : (forall i, 0 <= F i < +oo) -> \prod_(i < n) F i < +oo. Proof. @@ -1762,174 +1152,6 @@ rewrite big_ord_recl lte_mul_pinfty//. by rewrite ih. Qed. -Lemma sub_independent_RVs d' [T' : measurableType d'] [I : choiceType] [A B : set I] - [X : I -> {RV P >-> T'}]: - A `<=` B -> independent_RVs (P := P) B X -> independent_RVs (P := P) A X. -Proof. -move=> AB [h1 h2]. split. - by move=> i Ai; apply: h1; exact: AB. -move=> J JA E h3. -by apply: h2 => //; apply: subset_trans; first apply: JA. -Qed. - -Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) M: - independent_RVs (P := P) [set: 'I_n] (tnth X) -> - (forall i t, (0 <= tnth X i t <= M)%R) -> - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_P[ \prod_(i < n) (tnth X i) ] = \prod_(i < n) 'E_P[ (tnth X i) ]. -Proof. -elim: n X => [X|n ih X]. - by rewrite !big_ord0 expectation_cst. -move=> /=iRVs boundedX intX. - -rewrite [RHS]big_ord_recl/=. -rewrite [X in _ * X](_ : _ = \prod_(i < n) ('E_P [ (tnth (behead_tuple X) i) ])); last first. - by apply: eq_bigr => i _; congr expectation; apply funext => x; rewrite [in LHS](tuple_eta X) tnthS. -rewrite -ih; last 3 first. -- suffices: independent_RVs (P := P) [set` behead_tuple (ord_tuple n.+1)] (fun i => tnth X i). - rewrite /independent_RVs. move=> [/=h1 h2]. split => /=. - move=> i _. - have := h1 (lift ord0 i). rewrite {1}(tuple_eta X) tnthS. apply. - apply/tnthP. exists i. - rewrite tnth_behead/= tnth_ord_tuple. - by apply: ord_inj; rewrite lift0 inordK// ltnS. - move=> J JIn E h3. - have /=J' := ((@widen_ord n n.+1 (leqnSn n)) @` J)%fset. - have J'In1 : [set` J'] `<=` [set: 'I_n.+1] by exact: subsetT. - (* have := h2 J' J'In1. *) - admit. - exact: (@sub_independent_RVs _ _ _ _ [set: 'I_n.+1]). -- by move=> i t; rewrite tnth_behead boundedX. -- by move=> Xi XiX; rewrite intX// mem_behead. - -pose X1 := (fun x : mtuple n.+1 R => \prod_(i < n.+1) tnth x i)%R. -pose X2 := (fun t : T => [the mtuple n.+1 R of [tuple of [seq tnth X i t | i <- ord_tuple n.+1]]])%R. -have mX1 : measurable_fun setT X1. admit. -have mX2 : measurable_fun setT X2. admit. -pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y1 : {mfun mtuple n.+1 R >-> R} := HB.pack X1 build_mX1. -pose Y2 : {mfun T >-> mtuple n.+1 R} := HB.pack X2 build_mX2. -rewrite [X in 'E_P[X]](_ : _ = Y1 \o Y2)%R; last first. - apply: funext => t. - rewrite /Y1/Y2/X1/X2/=. - under [RHS]eq_bigr => i _ do rewrite tnth_map tnth_ord_tuple. - admit. - -rewrite unlock/expectation -(@integral_pushforward _ _ _ _ _ _ _ _ setT (EFin \o Y1))//=; last first. -- admit. -- exact: measurableT_comp. -pose X3 := (fun t : T => (tnth X ord0 t,[the mtuple n R of [tuple of [seq tnth (behead_tuple X) i t | i <- ord_tuple n]]]))%R. -have mX3 : measurable_fun setT X3. admit. -pose build_mX3 := isMeasurableFun.Build _ _ _ _ _ mX3. -pose Y3 : {mfun T >-> _} := HB.pack X3 build_mX3. -rewrite /X1. -rewrite [LHS](_ : _ = \int[pushforward P mX3]_y (y.1 * \prod_(i < n) tnth y.2 i)%:E); last first. - under eq_integral => y _. - rewrite big_ord_recl/=. - rewrite [X in (_ * X)%R](_ : _ = \prod_(i < n) tnth (behead_tuple y) i )%R; last first. - by apply eq_bigr => j _; rewrite [in LHS](tuple_eta y) tnthS. - over. - simpl. - admit. -rewrite [in LHS]/pushforward/=. - -(* -case: n X => [X|n X]. - by rewrite !big_ord0 expectation_cst. -elim: n X => [X|n IH X] /= iRVX intX. - admit. -rewrite big_ord_recl [in RHS] big_ord_recl. -rewrite expectation_prod; last 3 first. -- apply: (@independent_generators _ _ _ _ _ _ _ _ (fun i => @RGenOInfty.G R)) => //=. - - move=> i _. admit. - - move=> i _. admit. - - admit. - split => /=. - case => _//= A/= []B nB <-. - have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. - apply => //. admit. - have : measurable_fun setT (tnth X ord0) by []. - apply => //. admit. - move=> J _ E JE. - have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. - rewrite setT_bool. - rewrite bigcap_setU1 bigcap_set1. - rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. - case: iRVX => /=H1 H2. - pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else - if i == lift ord0 ord0 then E true - else setT. - pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. - (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) - (* case. case. *) - (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) - (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) - (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) - (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) - (* admit. *) - (* (* have := H2 _ _ _ K1. *) *) - have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). - apply: H2 => //. - case. case. - - move=> i _. rewrite /E'/=. have := JE false. admit. - - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. - by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. -- split => /=. - case => _//= A/= []B nB <-. - have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. - exact. - have : measurable_fun setT (tnth X ord0) by []. - exact. - move=> J _ E JE. - - - have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. - rewrite setT_bool. - rewrite bigcap_setU1 bigcap_set1. - rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. - case: iRVX => /=H1 H2. - pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else - if i == lift ord0 ord0 then E true - else setT. - pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. - (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) - (* case. case. *) - (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) - (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) - (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) - (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) - (* admit. *) - (* (* have := H2 _ _ _ K1. *) *) - have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). - apply: H2 => //. - case. case. - - move=> i _. rewrite /E'/=. have := JE false. admit. - - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. - by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. -- by rewrite intX// mem_tnth. -- rewrite (_ : (\prod_(i < n) tnth X (lift ord0 i))%R = (\prod_(i < n) tnth (behead_tuple X) i)%R); last first. - by apply: eq_bigr => i _; rewrite [in LHS](tuple_eta X) tnthS. - apply: integrable_prod => i. - by rewrite intX// tnth_behead mem_tnth. -rewrite (_ : \prod_(i < n) tnth X (lift ord0 i) = \prod_(i < n) tnth (behead X) i)%R; last first. - apply: eq_bigr => /=i _. rewrite tnth_behead (_ : inord i.+1 = lift ord0 i)//=. - by apply: val_inj; rewrite /=inordK// ltnS. -rewrite IH//=. -- congr (_ * _). - apply: eq_bigr=> i _. - congr expectation. - by rewrite [in RHS](tuple_eta X) tnthS. -- admit. -- by move=> Xi XiX; rewrite intX// mem_behead.*) -Abort. - End properties_of_independence. Section bernoulli. @@ -2085,9 +1307,6 @@ rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. rewrite /bool_to_real/=. case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. by rewrite ler_norm. - (* rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. *) - (* apply: funext => i. *) - (* by rewrite /mmtX/= tnth_map tnth_ord_tuple. *) apply: eq_bigr => /= i _. congr expectation. rewrite /=. diff --git a/theories/sampling_wip.v b/theories/sampling_wip.v new file mode 100644 index 0000000000..d04b48c23d --- /dev/null +++ b/theories/sampling_wip.v @@ -0,0 +1,2636 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect. +From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop. +Require Reals Interval.Tactic. +From mathcomp Require Import (canonicals) Rstruct Rstruct_topology. +From HB Require Import structures. +From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. +From mathcomp Require Import reals ereal interval_inference topology normedtype sequences. +From mathcomp Require Import realfun convex. +From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. +From mathcomp Require Import lebesgue_integral kernel probability. +From mathcomp Require Import independence. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +(**md**************************************************************************) +(* This file copies most of the file sampling.v, to serve as an experiment *) +(* for the formalization of a variant of the sampling theorem *) +(******************************************************************************) + +Reserved Notation "' P [ A | B ]". + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports numFieldNormedType.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Section product_probability2. +Local Open Scope ereal_scope. +Lemma product_probability2_setT : + forall (d1 d2 : measure_display) (T1 : measurableType d1) + (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) + (P2 : probability T2 R), (P1 \x^ P2) setT = 1%E. +Proof. +move=> ? ? ? ? ? P1 P2. +rewrite -setXTT product_measure2E// -[RHS]mul1e. +congr mule. +all: rewrite -[LHS]fineK ?fin_num_measure//. +all: congr EFin=> /=. +all: by rewrite probability_setT. +Qed. + +HB.instance Definition _ (d1 d2 : measure_display) (T1 : measurableType d1) + (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) + (P2 : probability T2 R):= + Measure_isProbability.Build _ _ _ (P1 \x^ P2) (product_probability2_setT P1 P2). +End product_probability2. + +(* NB: most of the contents of this section is in PR 1391 and can soon be removed *) +Section independent_events. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Lemma sub_independent_events (I0 : choiceType) (A B : set I0) (E : I0 -> set T) : + A `<=` B -> independent_events P B E -> independent_events P A E. +Proof. +by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. +Qed. + +Definition kwise_independent (I : choiceType) (A : set I) (E : I -> set T) k := + (forall i, A i -> measurable (E i)) /\ + forall B : {fset I}, [set` B] `<=` A -> (#|` B | <= k)%nat -> + P (\bigcap_(i in [set` B]) E i) = \prod_(i <- B) P (E i). + +Lemma sub_kwise_independent (I : choiceType) (A B : set I) (E : I -> set T) k : + A `<=` B -> kwise_independent B E k -> kwise_independent A E k. +Proof. +by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. +Qed. + +Lemma mutual_indep_is_kwise_indep (I : choiceType) (A : set I) (E : I -> set T) k : + independent_events P A E -> kwise_independent A E k. +Proof. +rewrite /independent_events /kwise_independent. +move=> [mE miE]; split=> // B BleA _. +exact: miE. +Qed. + +Lemma nwise_indep_is_mutual_indep (I : choiceType) (A : {fset I}) (E : I -> set T) n : + #|` A | = n -> kwise_independent [set` A] E n -> independent_events P [set` A] E. +Proof. +rewrite /independent_events /kwise_independent. +move=> nA [mE miE]; split=> // B BleA. +apply: miE => //; rewrite -nA fsubset_leq_card//. +by apply/fsubsetP => x xB; exact: (BleA x). +Qed. + +Lemma mutually_independent_weak (I : choiceType) (E : I -> set T) (B : set I) : + (forall b, ~ B b -> E b = setT) -> + independent_events P [set: I] E <-> + independent_events P B E. +Proof. +move=> BE; split; first exact: sub_independent_events. +move=> [mE h]; split=> [i _|C _]. + by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. +have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. +rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. +rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. +have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. + exists (fset_set ([set` C] `&` B)). + by rewrite fset_setK//; exact: finite_setIl. +rewrite CBD h; last first. + rewrite -CBD; exact: subIsetr. +rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. +rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. + by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. +by rewrite CBD -fsbig_seq. +Qed. + +Lemma kwise_independent_weak (I : choiceType) (E : I -> set T) (B : set I) k : + (forall b, ~ B b -> E b = setT) -> + kwise_independent [set: I] E k <-> + kwise_independent B E k. +Proof. +move=> BE; split; first exact: sub_kwise_independent. +move=> [mE h]; split=> [i _|C _ Ck]. + by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. +have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. +rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. +rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. +have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. + exists (fset_set ([set` C] `&` B)). + by rewrite fset_setK//; exact: finite_setIl. +rewrite CBD h; last 2 first. + - rewrite -CBD; exact: subIsetr. + - rewrite (leq_trans _ Ck)// fsubset_leq_card// -(set_fsetK D) -(set_fsetK C). + by rewrite -fset_set_sub// -CBD; exact: subIsetl. +rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. +rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. + by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. +by rewrite CBD -fsbig_seq. +Qed. + +Lemma kwise_independent_weak01 E1 E2 : + kwise_independent [set: nat] (bigcap2 E1 E2) 2%N <-> + kwise_independent [set 0%N; 1%N] (bigcap2 E1 E2) 2%N. +Proof. +apply: kwise_independent_weak. +by move=> n /= /not_orP[/eqP /negbTE -> /eqP /negbTE ->]. +Qed. + +Lemma independent_events_weak' (I : choiceType) (E : I -> set T) (B : set I) : + (forall b, ~ B b -> E b = setT) -> + independent_events P [set: I] E <-> + independent_events P B E. +Proof. +move=> BE; split; first exact: sub_independent_events. +move=> [mE h]; split=> [i _|C CI]. + by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. +have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. +rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. +rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. +have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. + exists (fset_set ([set` C] `&` B)). + by rewrite fset_setK//; exact: finite_setIl. +rewrite CBD h; last first. + - rewrite -CBD; exact: subIsetr. +rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. +rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. + by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. +by rewrite CBD -fsbig_seq. +Qed. + +Definition pairwise_independent E1 E2 := + kwise_independent [set 0; 1]%N (bigcap2 E1 E2) 2. + +Lemma pairwise_independentM_old (E1 E2 : set T) : + pairwise_independent E1 E2 <-> + [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. +Proof. +split. +- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. + rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. + + by rewrite set_fsetU !set_fset1; exact: subset_refl. + + rewrite cardfs2//. + split => //. + + by apply: (mE1E2 0%N) => /=; left. + + by apply: (mE1E2 1%N) => /=; right. +- move=> [mE1 mE2 E1E2M]. + split => //=. + + by move=> [| [| [|]]]//=. + + move=> B _; have [B0|B0] := boolP (0%N \in B); last first. + have [B1|B1] := boolP (1%N \in B); last first. + rewrite big1_fset; last first. + move=> k kB _; rewrite /bigcap2. + move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. + move: kB B1; case: ifPn => [/eqP -> ->//|_ _ _]. + by rewrite probability_setT. + rewrite bigcapT ?probability_setT// => k/= kB. + move: kB B0 B1; case: ifPn => [/eqP -> ->//|k0]. + by case: ifPn => [/eqP -> ->|]. + rewrite (bigcap_setD1 1%N _ [set` B])//=. + rewrite bigcapT ?setIT; last first. + move=> k [/= kB /eqP /negbTE ->]. + by move: kB B0; case: ifPn => [/eqP -> ->|]. + rewrite (big_fsetD1 1%N)//= big1_fset ?mule1// => k. + rewrite !inE => /andP[/negbTE -> kB] _. + move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. + by rewrite probability_setT. + rewrite (bigcap_setD1 0%N _ [set` B])//. + have [B1|B1] := boolP (1%N \in B); last first. + rewrite bigcapT ?setIT; last first. + move=> k [/= kB /eqP /negbTE ->]. + by move: kB B1; case: ifPn => [/eqP -> ->|]. + rewrite (big_fsetD1 0%N)//= big1_fset ?mule1// => k. + rewrite !inE => /andP[/negbTE -> kB] _. + move: kB B1; case: ifPn => [/eqP -> ->//|k1 kB B1]. + by rewrite probability_setT. + rewrite (bigcap_setD1 1%N _ ([set` B] `\ 0%N))// bigcapT ?setIT; last first. + by move=> n/= [[nB]/eqP/negbTE -> /eqP/negbTE ->]. + rewrite E1E2M (big_fsetD1 0%N)//= (big_fsetD1 1%N)/=; last by rewrite !inE B1. + rewrite big1_fset ?mule1//= => k. + rewrite !inE => -/and3P[/negbTE -> /negbTE -> kB] _; + by rewrite probability_setT. +Qed. + +Lemma pairwise_independentM (E1 E2 : set T) : + pairwise_independent E1 E2 <-> + [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. +Proof. +split. +- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. + rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. + + by rewrite set_fsetU !set_fset1; exact: subset_refl. + + by rewrite cardfs2. + split => //. + + by apply: (mE1E2 0%N) => /=; left. + + by apply: (mE1E2 1%N) => /=; right. +- move=> [mE1 mE2 E1E2M]. + rewrite /pairwise_independent. + split. + + by move=> [| [| [|]]]//=. + + move=> B B01 B2. + have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. + * rewrite B_set0. + move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. + by rewrite big_nil bigcap_set0 probability_setT. + * rewrite B_set0 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set0 fsbig_set1/=. + * rewrite B_set1 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set1 fsbig_set1/=. + * rewrite B_set01 bigcap_setU1 bigcap_set1/=. + rewrite fsbig_seq//= B_set01. + rewrite fsbigU//=; last first. + by move=> n [/= ->]. + by rewrite !fsbig_set1//=. +Qed. + +Lemma pairwise_independent_setC (E1 E2 : set T) : + pairwise_independent E1 E2 -> pairwise_independent E1 (~` E2). +Proof. +rewrite/pairwise_independent. +move/pairwise_independentM=> [mE1 mE2 h]. +apply/pairwise_independentM; split=> //. +- exact: measurableC. +- rewrite -setDE measureD//; last first. + exact: (le_lt_trans (probability_le1 P mE1) (ltry _)). + rewrite probability_setC// muleBr// ?mule1 -?h//. + by rewrite fin_num_measure. +Qed. + +Lemma pairwise_independentC (E1 E2 : set T) : + pairwise_independent E1 E2 -> pairwise_independent E2 E1. +Proof. +rewrite/pairwise_independent/kwise_independent; move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. +rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => h. +split. +- case=> [_|[_|]]//=. + + by apply: (mE1E2 1%N) => /=; right. + + by apply: (mE1E2 0%N) => /=; left. +- move=> B B01 B2. + have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. + + rewrite B_set0. + move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. + by rewrite big_nil bigcap_set0 probability_setT. + + rewrite B_set0 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set0 fsbig_set1/=. + + rewrite B_set1 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set1 fsbig_set1/=. + + rewrite B_set01 bigcap_setU1 bigcap_set1/=. + rewrite fsbig_seq//= B_set01. + rewrite fsbigU//=; last first. + by move=> n [/= ->]. + rewrite !fsbig_set1//= muleC setIC. + apply: h. + * by rewrite set_fsetU !set_fset1; exact: subset_refl. + * by rewrite cardfs2. +Qed. +(* ale: maybe interesting is thm 8.3 and exercise 8.6 from shoup/ntb at this point *) + +End independent_events. + +Section conditional_probability. +Context d (T : measurableType d) (R : realType). +Local Open Scope ereal_scope. + +Definition conditional_probability (P : probability T R) E1 E2 := + (fine (P (E1 `&` E2)) / fine (P E2))%:E. +Local Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). + +Lemma conditional_independence (P : probability T R) E1 E2 : + P E2 != 0 -> pairwise_independent P E1 E2 -> 'P [ E1 | E2 ] = P E1. +Proof. +move=> PE2ne0 iE12. +have /= mE1 := (iE12.1 0%N). +have /= mE2 := (iE12.1 1%N). +rewrite/conditional_probability. +have [_ _ ->] := (pairwise_independentM _ _ _).1 iE12. +rewrite fineM ?fin_num_measure//; [|apply: mE1; left=>//|apply: mE2; right=>//]. +rewrite -mulrA mulfV ?mulr1 ?fineK// ?fin_num_measure//; first by apply: mE1; left. +by rewrite fine_eq0// fin_num_measure//; apply: mE2; right. +Qed. + +(* TODO (klenke thm 8.4): if P B > 0 then 'P[.|B] is a probability measure *) + +Lemma conditional_independent_is_pairwise_independent (P : probability T R) E1 E2 : + d.-measurable E1 -> d.-measurable E2 -> + P E2 != 0 -> + 'P[E1 | E2] = P E1 -> pairwise_independent P E1 E2. +Proof. +rewrite /conditional_probability/pairwise_independent=> mE1 mE2 pE20 pE1E2. +split. +- by case=> [|[|]]//=. +- move=> B B01 B2; have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. + + rewrite B_set0. + move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. + by rewrite big_nil bigcap_set0 probability_setT. + + rewrite B_set0 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set0 fsbig_set1/=. + + rewrite B_set1 bigcap_set1 /=. + by rewrite fsbig_seq//= B_set1 fsbig_set1/=. + + rewrite B_set01 bigcap_setU1 bigcap_set1/=. + rewrite fsbig_seq//= B_set01. + rewrite fsbigU//=; last first. + by move=> n [/= ->]. + rewrite !fsbig_set1//= -pE1E2 -{2}(@fineK _ (P E2)). + rewrite -EFinM -mulrA mulVf ?mulr1 ?fine_eq0// ?fineK//. + all: by apply: fin_num_measure => //; apply: measurableI. +Qed. + +Lemma conditional_independentC (P : probability T R) E1 E2 : + d.-measurable E1 -> d.-measurable E2 -> + P E1 != 0 -> P E2 != 0 -> + reflect ('P[E1 | E2] == P E1) ('P[E2 | E1] == P E2). +Proof. +move=> mE1 mE2 pE10 pE20. +apply/(iffP idP)=>/eqP. ++ move/(@conditional_independent_is_pairwise_independent _ _ _ mE2 mE1 pE10). + move/pairwise_independentC. + by move/(conditional_independence pE20)/eqP. ++ move/(@conditional_independent_is_pairwise_independent _ _ _ mE1 mE2 pE20). + move/pairwise_independentC. + by move/(conditional_independence pE10)/eqP. +Qed. + +(* Lemma summation (I : choiceType) (A : {fset I}) E F (P : probability T R) : *) +(* (* the sets are disjoint *) *) +(* P (\bigcap_(i in [set` A]) F i) = 1 -> P E = \prod_(i <- A) ('P [E | F i] * P (F i)). *) +(* Proof. *) +(* move=> pF1. *) + +Lemma bayes (P : probability T R) E F : + d.-measurable E -> d.-measurable F -> + 'P[ E | F ] = ((fine ('P[F | E] * P E)) / (fine (P F)))%:E. +Proof. +rewrite /conditional_probability => mE mF. +have [PE0|PE0] := eqVneq (P E) 0. + have -> : P (E `&` F) = 0. + by apply/eqP; rewrite eq_le -{1}PE0 (@measureIl _ _ _ P E F mE mF)/= measure_ge0. + by rewrite PE0 fine0 invr0 mulr0 mule0 mul0r. +by rewrite -{2}(@fineK _ (P E)) -?EFinM -?(mulrA (fine _)) ?mulVf ?fine_eq0 ?fin_num_measure// mul1r setIC//. +Qed. + +End conditional_probability. +Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). + +From mathcomp Require Import real_interval. + +Section independent_RVs. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Definition pairwise_independent_RV (X Y : {RV P >-> R}) := + forall s t, pairwise_independent P (X @^-1` s) (Y @^-1` t). + +Lemma conditional_independent_RV (X Y : {RV P >-> R}) : + pairwise_independent_RV X Y -> + forall s t, P (Y @^-1` t) != 0 -> 'P [X @^-1` s | Y @^-1` t] = P (X @^-1` s). +Proof. +move=> iRVXY s t PYtne0. +exact: conditional_independence. +Qed. + +Definition mutually_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := + forall x_ : I -> R, independent_events P A (fun i => X i @^-1` `[(x_ i), +oo[%classic). + +Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := + forall x_ : I -> R, kwise_independent P A (fun i => X i @^-1` `[(x_ i), +oo[%classic) k. + +Lemma nwise_indep_is_mutual_indep_RV (I : choiceType) (A : {fset I}) (X : I -> {RV P >-> R}) n : + #|` A | = n -> kwise_independent_RV [set` A] X n -> mutually_independent_RV [set` A] X. +Proof. +rewrite/mutually_independent_RV/kwise_independent_RV=> nA kwX s. +by apply: nwise_indep_is_mutual_indep; rewrite ?nA. +Qed. + +(* alternative formalization +Definition inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := + forall (s : I -> set R), mutually_independent P A (fun i => X i @^-1` s i). + +Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := + forall (s : I -> set R), kwise_independent P A (fun i => X i @^-1` s i) k. + +this should be equivalent according to wikipedia https://en.wikipedia.org/wiki/Independence_(probability_theory)#For_real_valued_random_variables +*) + +(* Remark 2.15 (i) *) +Lemma prob_inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) : + mutually_independent_RV A X -> + forall J : {fset I}, [set` J] `<=` A -> + forall x_ : I -> R, + P (\bigcap_(i in [set` J]) X i @^-1` `[(x_ i), +oo[%classic) = + \prod_(i <- J) P (X i @^-1` `[(x_ i), +oo[%classic). +Proof. +move=> iRVX J JleA x_. +apply: (iRVX _).2 => //. +Qed. + +End independent_RVs. + +Section bool_to_real. +Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). +Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). + +Lemma measurable_bool_to_real : measurable_fun [set: T] bool_to_real. +Proof. +rewrite /bool_to_real. +apply: measurableT_comp => //=. +exact: (@measurable_funPT _ _ _ _ f). +Qed. +(* HB.about isMeasurableFun.Build. *) +HB.instance Definition _ := + isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. + +HB.instance Definition _ := MeasurableFun.on bool_to_real. + +Definition btr : {RV P >-> R} := bool_to_real. + +End bool_to_real. + +Section independent_RVs_btr. +Context {R : realType} d (T : measurableType d). +Variable P : probability T R. +Local Open Scope ring_scope. + +Lemma independent_RVs_btr + n (X : n.-tuple {mfun T >-> bool}) : + independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] (fun i => btr P (tnth X i)). +Proof. +move=> PIX; split. +- move=> i Ii. + rewrite /g_sigma_algebra_preimage/= /preimage_set_system/= => _ [A mA <-]. + by rewrite setTI; exact/measurable_sfunP. +- move=> J JI E/= JEfX; apply PIX => // j jJ. + have := JEfX _ jJ; rewrite !inE. + rewrite /g_sigma_algebra_preimage /preimage_set_system/= => -[A mA <-]. + by exists ((fun x => x%:R) @^-1` A). +Qed. + +End independent_RVs_btr. + +Section mfunM. +Context {d} (T : measurableType d) {R : realType}. + +HB.instance Definition _ (f g : {mfun T >-> R}) := + @isMeasurableFun.Build d _ _ _ (f \* g)%R + (measurable_funM (@measurable_funPT _ _ _ _ f) + ((@measurable_funPT _ _ _ _ g))). + +End mfunM. + +Section move. + +Lemma sumr_map {R : realType} U d (T : measurableType d) (l : seq U) Q + (f : U -> {mfun T >-> R}) (x : T) : + (\sum_(i <- l | Q i) f i) x = \sum_(i <- l | Q i) f i x. +Proof. by elim/big_ind2 : _ => //= _ g _ h <- <-. Qed. + +Lemma prodr_map {R : realType} U d (T : measurableType d) (l : seq U) Q + (f : U -> {mfun T >-> R}) (x : T) : + (\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x. +Proof. by elim/big_ind2 : _ => //= _ h _ g <- <-. Qed. + +Definition sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : T -> R := + fun x => \sum_(f <- s) f x. + +Lemma measurable_sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : + measurable_fun setT (sumrfct s). +Proof. +apply/measurable_EFinP => /=; apply/measurableT_comp => //. +exact: measurable_sum. +Qed. + +HB.instance Definition _ {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). + +Lemma sum_mfunE {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) x : + ((\sum_(f <- s) f) x = sumrfct s x)%R. +Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. + +End move. + +Section move_to_bigop_nat_lemmas. +Context {T : Type}. +Implicit Types (A : set T). + +Lemma bigcup_mkord_ord n (F : 'I_n.+1 -> set T) : + \bigcup_(i < n.+1) F (inord i) = \big[setU/set0]_(i < n.+1) F i. +Proof. +rewrite bigcup_mkord; apply: eq_bigr => /= i _; congr F. +by apply/val_inj => /=;rewrite inordK. +Qed. + +End move_to_bigop_nat_lemmas. + +(* in master *) +Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : + {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. +Proof. +move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. + by case=> B + <- => -[? | ?]; [left | right]; exists B. +by case=> -[] B FGB <-; exists B=> //; [left | right]. +Qed. + +(* in master *) +Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : + preimage_set_system X f set0 = set0. +Proof. by apply/seteqP; split=> A // []. Qed. + +(* in master *) +Lemma preimage_set_system_funcomp + {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} D : + preimage_set_system D (g \o f) F = + preimage_set_system D f (preimage_set_system setT g F). +Proof. +apply/seteqP; split=> A. + case=> B FB <-. + exists (g @^-1` B)=> //. + exists B=> //. + by rewrite setTI. +case=> B [] C FC <- <-. +exists C=> //. +rewrite !setTI. +by rewrite comp_preimage. +Qed. + +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} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : +g_sigma_preimage (fun i => (f1 i \o g)) = +preimage_set_system [set: T3] g (g_sigma_preimage f1). +Proof. +rewrite {1}/g_sigma_preimage. +rewrite -g_sigma_preimageE; congr (<>). +destruct n as [|n]. + rewrite !big_ord0 /preimage_set_system/=. + by apply/esym; rewrite -subset0 => t/= []. +rewrite predeqE => C; split. +- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]]. + exists (f1 (Ordinal Ii) @^-1` A). + rewrite -bigcup_mkord_ord; exists i => //. + exists A => //; rewrite setTI// (_ : Ordinal _ = inord i)//. + by apply/val_inj => /=;rewrite inordK. + rewrite !setTI// -comp_preimage// (_ : Ordinal _ = inord i)//. + by apply/val_inj => /=;rewrite inordK. +- move=> [A]. + rewrite -bigcup_mkord_ord => -[i Ii [B mB <-{A}]] <-{C}. + rewrite -bigcup_mkord_ord. + exists i => //. + by exists B => //; rewrite !setTI -comp_preimage. +Qed. + +HB.instance Definition _ (n : nat) (T : pointedType) := + isPointed.Build (n.-tuple T) (nseq n point). + +Definition mtuple (n : nat) d (T : measurableType d) : Type := n.-tuple T. + +HB.instance Definition _ (n : nat) d (T : measurableType d) := + Pointed.on (mtuple n T). + +Lemma countable_range_bool d (T : measurableType d) (b : bool) : + countable (range (@cst T _ b)). +Proof. exact: countableP. Qed. + +HB.instance Definition _ d (T : measurableType d) b := + MeasurableFun_isDiscrete.Build d _ T _ (cst b) (countable_range_bool T b). + +Definition measure_tuple_display : measure_display -> measure_display. +Proof. exact. Qed. + +Section measurable_tuple. +Context {d} {T : measurableType d}. +Variable n : nat. + +Let coors := (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) + (mtuple n T) (g_sigma_preimage coors) + (tuple_set0) (tuple_setC) (tuple_bigcup). + +End measurable_tuple. + +(* NB: not used *) +Definition cylinder d {T : measurableType d} m (A : set (m.-tuple T)) + (J : {fset 'I_m}%fset) : set (m.-tuple T) := + \big[setI/setT]_(i <- J) (@tnth _ T ^~ i) @^-1` + ((@tnth _ T ^~ i) @` A). + +(* NB: not used *) +Definition Z d {T : measurableType d} m + (J : {fset 'I_m}%fset) : set_system (m.-tuple T) := + [set B | exists A, B = cylinder A J]. + +Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : + measurable_fun [set: mtuple n 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 cons_measurable_fun. +Context d d1 (T : measurableType d) (T1 : measurableType d1). + +Lemma cons_measurable_funP (n : nat) (h : T -> mtuple n T1) : + measurable_fun setT h <-> + forall i : 'I_n, measurable_fun setT ((@tnth _ T1 ^~ i) \o h). +Proof. +apply: (@iff_trans _ (g_sigma_preimage + (fun i : 'I_n => (@tnth _ T1 ^~ i) \o h) `<=` measurable)). +- rewrite g_sigma_preimage_comp; split=> [mf A [C HC <-]|f12]. + exact: mf. + by move=> _ A mA; apply: f12; exists A. +- split=> [h12|mh]. + move=> i _ A mA. + apply: h12. + apply: sub_sigma_algebra. + destruct n as [|n]. + by case: i => [] []. + rewrite -bigcup_mkord_ord. + exists i => //; first by red. + exists A => //. + rewrite !setTI. + rewrite (_ : inord i = i)//. + by apply/val_inj => /=; rewrite inordK. + apply: smallest_sub; first exact: sigma_algebra_measurable. + destruct n as [|n]. + by rewrite big_ord0. + rewrite -bigcup_mkord_ord. + apply: bigcup_sub => i Ii. + move=> A [C mC <-]. + exact: mh. +Qed. + +(* TODO: rename to measurable_cons *) +Lemma measurable_fun_cons (f : T -> T1) n (g : T -> mtuple n T1) : + measurable_fun setT f -> measurable_fun setT g -> + measurable_fun setT (fun x : T => [the mtuple n.+1 T1 of (f x) :: (g x)]). +Proof. +move=> mf mg; apply/cons_measurable_funP => /= i. +have [->|i0] := eqVneq i ord0. + by rewrite (_ : _ \o _ = f). +have @j : 'I_n. + apply: (@Ordinal _ i.-1). + rewrite prednK//. + have := ltn_ord i. + by rewrite ltnS. + by rewrite lt0n. +rewrite (_ : _ \o _ = (fun x => tnth (g x) j))//. + apply: (@measurableT_comp _ _ _ _ _ _ + (fun x : mtuple n T1 => tnth x j) _ g) => //. + exact: measurable_tnth. +apply/funext => t/=. +rewrite (_ : i = lift ord0 j) ?tnthS//. +apply/val_inj => /=. +by rewrite /bump/= add1n prednK// lt0n. +Qed. + +End cons_measurable_fun. + +Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : + behead t = [tuple (tnth t (lift ord0 i)) | i < n]. +Proof. +destruct n as [|n]. + rewrite !tuple0. + apply: size0nil. + by rewrite size_behead size_tuple. +apply: (@eq_from_nth _ (tnth_default t ord0)). + by rewrite size_behead !size_tuple. +move=> i ti. +rewrite nth_behead/= (nth_map ord0); last first. + rewrite size_enum_ord. + by rewrite size_behead size_tuple in ti. +rewrite (tnth_nth (tnth_default t ord0)). +congr nth. +rewrite /= /bump/= add1n; congr S. +apply/esym. +rewrite size_behead size_tuple in ti. +have := @nth_ord_enum _ ord0 (Ordinal ti). +by move=> ->. +Qed. + +Lemma measurable_behead d (T : measurableType d) n : + measurable_fun setT (fun x : mtuple n.+1 T => [tuple of behead x] : mtuple n T). +Proof. +red=> /=. +move=> _ Y mY. +rewrite setTI. +set bh := (bh in preimage bh). +have bhYE : (bh @^-1` Y) = [set x :: y | x in setT & y in Y]. + rewrite /bh. + apply/seteqP; split=> x /=. + move=> ?; exists (thead x)=> //. + exists [tuple of behead x] => //=. + by rewrite [in RHS](tuple_eta x). + case=> x0 _ [] y Yy xE. + suff->: [tuple of behead x] = y by []. + apply/val_inj=> /=. + by rewrite -xE. +have:= mY. +rewrite /measurable/= => + F [] sF. +pose F' := image_set_system setT bh F. +move=> /(_ F') /=. +have-> : F' Y = F (bh @^-1` Y) by rewrite /F' /image_set_system /= setTI. +move=> /[swap] H; apply; split; first exact: sigma_algebra_image. +move=> A; rewrite /= /F' /image_set_system /= setTI. +set X := (X in X A). +move => XA. +apply: H; rewrite big_ord_recl /=; right. +set X' := (X' in X' (preimage _ _)). +have-> : X' = preimage_set_system setT bh X. + rewrite /X. + rewrite (big_morph _ preimage_set_systemU preimage_set_system0). + apply: eq_bigr=> i _. + rewrite -preimage_set_system_funcomp. + congr preimage_set_system. + apply: funext=> t. + rewrite (tuple_eta t) /bh /= tnthS. + by congr tnth; apply/val_inj. +exists A=> //. +by rewrite setTI. +Qed. + +Section pro1. +Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} + (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). + +Definition pro1 := product_measure1 P1 P2. + +HB.instance Definition _ := Measure.on pro1. + +Lemma pro1_setT : pro1 setT = 1%E. +Proof. +rewrite /pro1 -setXTT product_measure1E// -[RHS]mule1. +by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). +Qed. + +HB.instance Definition _ := + Measure_isProbability.Build _ _ _ pro1 pro1_setT. +End pro1. + +Section pro2. +Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} + (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). + +Definition pro2 := product_measure2 P1 P2. + +HB.instance Definition _ := Measure.on pro2. + +Lemma pro2_setT : pro2 setT = 1%E. +Proof. +rewrite /pro2 -setXTT product_measure2E// -[RHS]mule1. +by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). +Qed. + +HB.instance Definition _ := + Measure_isProbability.Build _ _ _ pro2 pro2_setT. +End pro2. + +Section pro. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Fixpoint mpro (n : nat) : set (mtuple n T) -> \bar R := + match n with + | 0%N => \d_([::] : mtuple 0 T) + | m.+1 => fun A => (P \x^ @mpro m)%E [set (thead x, [tuple of behead x]) | x in A] + end. + +Lemma mpro_measure n : @mpro n set0 = 0 /\ (forall A, (0 <= @mpro n A)%E) + /\ semi_sigma_additive (@mpro n). +Proof. +elim: n => //= [|n ih]. + by repeat split => //; exact: measure_semi_sigma_additive. +pose build_Mpro := isMeasure.Build _ _ _ (@mpro n) ih.1 ih.2.1 ih.2.2. +pose Mpro : measure _ R := HB.pack (@mpro n) build_Mpro. +pose ppro : measure _ R := (P \x^ Mpro)%E. +split. + rewrite image_set0 /product_measure2 /=. + under eq_fun => x do rewrite ysection0 measure0 (_ : 0 = cst 0 x)//. + rewrite (_ : @mpro n = Mpro)//. + by rewrite integral_cst// mul0e. +split. + by move => A; rewrite (_ : @mpro n = Mpro). +rewrite (_ : @mpro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. +move=> F mF dF mUF. +rewrite image_bigcup. +move=> [:save]. +apply: measure_semi_sigma_additive. +- abstract: save. + move=> i. + pose f (t : n.+1.-tuple T) := (@thead n T t, [the mtuple _ T of behead t]). + pose f' (x : T * mtuple n T) := [the mtuple n.+1 T of x.1 :: x.2]. + rewrite [X in measurable X](_ : _ = f' @^-1` F i); last first. + apply/seteqP; split=> [x/= [t Fit] <-{x}|[x1 x2] /= Fif']. + rewrite /f'/=. + by rewrite (tuple_eta t) in Fit. + exists (f' (x1, x2)) => //. + rewrite /f' /= theadE//; congr pair. + exact/val_inj. + rewrite -[X in measurable X]setTI. + suff: measurable_fun setT f' by exact. + rewrite /= /f'. + exact: measurable_fun_cons. +- (* TODO: lemma? *) + apply/trivIsetP => i j _ _ ij. + move/trivIsetP : dF => /(_ i j Logic.I Logic.I ij). + rewrite -!subset0 => ij0 /= [_ _] [[t Fit] [<- <-]]/=. + move=> [u Fju [hut tut]]. + have := ij0 t; apply; split => //. + suff: t = u by move=> ->. + rewrite (tuple_eta t) (tuple_eta u) hut. + by apply/val_inj => /=; rewrite tut. +- apply: bigcup_measurable => j _. + exact: save. +Qed. + +HB.instance Definition _ n := isMeasure.Build _ _ _ (@mpro n) + (@mpro_measure n).1 (@mpro_measure n).2.1 (@mpro_measure n).2.2. + +Lemma mpro_setT n : @mpro n setT = 1%E. +Proof. +elim: n => //=; first by rewrite diracT. +move=> n ih. +rewrite /product_measure2/ysection/=. +under eq_fun => x. + rewrite [X in P X](_ : _ = [set: T]); last first. + under eq_fun => y. rewrite [X in _ \in X](_ : _ = setT); last first. + apply: funext=> z/=. + apply: propT. + exists (z.1 :: z.2) => //=. + case: z => z1 z2/=. + congr pair. + exact/val_inj. + over. + by apply: funext => y/=; rewrite in_setT trueE. + rewrite probability_setT. + over. +by rewrite integral_cst// mul1e. +Qed. + +HB.instance Definition _ n := + Measure_isProbability.Build _ _ _ (@mpro n) (@mpro_setT n). + +Definition pro (n : nat) : probability (mtuple n T) R := @mpro n. + +End pro. +Arguments pro {d T R} P n. + +Notation "\X_ n P" := (pro P n) (at level 10, n, P at next level, + format "\X_ n P"). + +Lemma fubini2' : +forall [d1 d2 : measure_display] [T1 : measurableType d1] + [T2 : measurableType d2] [R : realType] + [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] + f -> (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f intf. +rewrite fubini2//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC. +rewrite /=. +by rewrite product_measure2E. +Qed. + +Lemma fubini1' : +forall [d1 d2 : measure_display] [T1 : measurableType d1] + [T2 : measurableType d2] [R : realType] + [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] + f -> (\int[m1]_x fubini_F m2 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f intf. +rewrite fubini1//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC. +rewrite /=. +by rewrite product_measure2E. +Qed. + +Lemma integrable_prodP : +forall [d1 d2 : measure_display] [T1 : measurableType d1] [T2 : measurableType d2] + [R : realType] [m1 : {sigma_finite_measure set T1 -> \bar R}] + [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], +(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f -> +(m1 \x^ m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f. +Proof. +move=> d1 d2 T1 T2 R m1 m2 f /integrableP[mf intf]; apply/integrableP; split => //. + rewrite -fubini2'//=. + rewrite fubini2//=. + apply/integrableP; split => //. + by apply/measurableT_comp => //. + by under eq_integral do rewrite abse_id. + apply/integrableP; split => //. + by apply/measurableT_comp => //. + by under eq_integral do rewrite abse_id. +Qed. + +Section proS. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. +Variable n : nat. + +Definition phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. + +Lemma mphi : measurable_fun [set: T * mtuple _ _] phi. +Proof. exact: measurable_fun_cons. Qed. + +Definition psi := fun (w : mtuple n.+1 T) => (thead w, [the mtuple _ _ of behead w]). + +Lemma mpsi : measurable_fun [set: mtuple _ _] psi. +Proof. +apply/measurable_fun_prod => /=. + exact: measurable_tnth. +exact: measurable_behead. +Qed. + +Lemma phiK : cancel phi psi. +Proof. +by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. +Qed. + +Let psiK : cancel psi phi. +Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. + +Lemma integral_mpro (f : n.+1.-tuple T -> R) : + (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f) -> + \int[\X_n.+1 P]_w (f w)%:E = + \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. +Proof. +move=> /integrableP[mf intf]. +rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ setT + (fun x : mtuple n.+1 T => (f x)%:E)); [|by []| |by []]. + apply: eq_measure_integral => A mA _. + rewrite /=. + rewrite /pushforward. + rewrite /pro2. + rewrite /phi/=. + rewrite /preimage/=. + congr (_ _). + apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. + move: At. + by rewrite {1}(tuple_eta t)//. + exists (x.1 :: x.2) => //=. + destruct x as [x1 x2] => //=. + congr pair. + exact/val_inj. +rewrite /=. +apply/integrable_prodP. +rewrite /=. +apply/integrableP; split => /=. + apply: measurableT_comp => //=. + exact: mphi. +apply: le_lt_trans (intf). +rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x + ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. + by apply: eq_integral => x _ /=; rewrite psiK. +rewrite le_eqVlt; apply/orP; left; apply/eqP. +rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT + (fun x : T * mtuple n T => ((abse \o (EFin \o (f \o phi))) x)))//. +- apply: eq_measure_integral => // A mA _. + apply: product_measure_unique => // B C mB mC. + rewrite /= /pushforward/=. + rewrite -product_measure2E//=. + congr (_ _). + (* TODO: lemma *) + apply/seteqP; split => [[x1 x2]/= [t [Bt Ct]] [<- <-//]|]. + move=> [x1 x2] [B1 C2] /=. + exists (x1 :: x2) => //=. + split=> //. + rewrite [X in C X](_ : _ = x2)//. + exact/val_inj. + congr pair => //. + exact/val_inj. +- apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + apply: measurableT_comp => //=. + by apply/measurable_EFinP. + exact: mphi. +- have : (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f). + exact/integrableP. +- apply: le_integrable => //=. + + apply: measurableT_comp => //=; last exact: mpsi. + apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + apply: measurableT_comp => //=; last exact: mphi. + by apply/measurable_EFinP => //=. + + move=> x _. + by rewrite normr_id// psiK. +Qed. + +End proS. + +Section integrable_theory. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}). +Variables (D : set T) (mD : measurable D). +Implicit Type f g : T -> \bar R. + +Let ltnP_sumbool (a b : nat) : {(a < b)%N} + {(a >= b)%N}. +Proof. by case: ltnP => _; [left|right]. Qed. + +(* TODO: clean, move near integrable_sum, refactor *) +Lemma integrable_sum_ord n (t : 'I_n -> (T -> \bar R)) : + (forall i, mu.-integrable D (t i)) -> + mu.-integrable D (fun x => \sum_(i < n) t i x). +Proof. +move=> intt. +pose s0 := fun k => match ltnP_sumbool k n with + | left kn => t (Ordinal kn) + | right _ => cst 0%E + end. +pose s := [tuple of map s0 (index_iota 0 n)]. +suff: mu.-integrable D (fun x => (\sum_(i <- s) i x)%R). + apply: eq_integrable => // i iT. + rewrite big_map/=. + rewrite big_mkord. + apply: eq_bigr => /= j _. + rewrite /s0. + case: ltnP_sumbool => // jn. + f_equal. + exact/val_inj. + have := ltn_ord j. + by rewrite ltnNge jn. +apply: (@integrable_sum d T R mu D mD s) => /= h /mapP[/= k]. +rewrite mem_index_iota leq0n/= => kn ->{h}. +have := intt (Ordinal kn). +rewrite /s0. +case: ltnP_sumbool => //. +by rewrite leqNgt kn. +Qed. + +End integrable_theory. + +(* TODO: clean, move near integrableD, refactor *) +Section integral_sum. +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). +Variables (I : eqType) (f : I -> (T -> \bar R)). +Hypothesis intf : forall n, mu.-integrable D (f n). + +Lemma integral_sum (s : seq I) : + \int[mu]_(x in D) (\sum_(k <- s) f k x) = + \sum_(k <- s) \int[mu]_(x in D) (f k x). +Proof. +elim: s => [|h t ih]. + under eq_integral do rewrite big_nil. + by rewrite integral0 big_nil. +rewrite big_cons -ih -integralD//. + by apply: eq_integral => x xD; rewrite big_cons. +rewrite [X in _.-integrable _ X](_ : _ = + (fun x => (\sum_(h0 <- [seq f i | i <- t]) h0 x))); last first. + by apply/funext => x; rewrite big_map. +apply: integrable_sum => //= g /mapP[i ti ->{g}]. +exact: intf. +Qed. + +End integral_sum. + +(* TODO: integral_fune_lt_pinfty does not look useful a lemma *) + +Section integrable_thead. +Context d (T : measurableType d) (R : realType). +Variables (P : probability T R) (n : nat) (X : n.+1.-tuple {RV P >-> R}). + +Lemma integrable_thead : P.-integrable setT (EFin \o thead X) -> + (\X_n.+1 P).-integrable [set: mtuple n.+1 T] + (EFin \o (fun x => thead X (thead x))). +Proof. +move=> intX. +apply/integrableP; split. + apply: measurableT_comp => //. + apply: measurableT_comp => //. + exact: measurable_tnth. +rewrite integral_mpro. +- rewrite -fubini1'//=. + + move/integrableP : (intX) => [_]. + + apply: le_lt_trans. + rewrite le_eqVlt; apply/orP; left; apply/eqP. + apply: eq_integral => x _. + rewrite /fubini_F/=. + admit. + + apply/fubini1b => //=. + * admit. + * admit. +- apply/integrableP; split. + + admit. + + rewrite integral_mpro. +Abort. + +End integrable_thead. + +Lemma bounded_RV_integrable d (T : measurableType d) (R : realType) + (P : probability T R) (X : T -> R) M : + measurable_fun setT X -> + (forall t, (0 <= X t <= M)%R) -> P.-integrable setT (EFin \o X). +Proof. +move=> mf XM. +apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). +- exact/measurable_EFinP. +- move=> t _ /=; rewrite lee_fin/=. + rewrite !ger0_norm//. + + by have /andP[] := XM t. + + by rewrite (@le_trans _ _ (X t))//; have /andP[] := XM t. + + by have /andP[] := XM t. +- exact: finite_measure_integrable_cst. +Qed. +Arguments bounded_RV_integrable {d T R P X} M. + +Module with_interval. +Declare Scope bigQ_scope. +Import Reals. +Import Rstruct. +Import Interval.Tactic. + +Section expR2_le8. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. + +Lemma expR2_le8 : expR 2 <= 8 :> R. +Proof. +rewrite (_ : 2 = 1 + 1)//. +rewrite exp.expRD -RmultE. +rewrite (_ : 8 = 8%R); last first. + by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. +rewrite (_ : 1 = INR 1%N)//=. +rewrite -Rstruct_topology.RexpE. +apply/RleP. +by interval. +Qed. + +End expR2_le8. +End with_interval. + +Section taylor_ln_le. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. + +Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. +Proof. +move=> x01; rewrite -subr_ge0. +pose f (x : R^o) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). +have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. +rewrite [leRHS](_ : _ = f x) // -f0. +evar (df0 : R -> R); evar (df : R -> R). +have idf (y : R^o) : 0 < 1 + y -> is_derive y (1:R) f (df y). + move=> y1. + rewrite (_ : df y = df0 y). + apply: is_deriveB; last exact: is_deriveD. + apply: is_deriveM=> //. + apply: is_derive1_comp=> //. + exact: is_derive1_ln. + rewrite /df0. + rewrite deriveD// derive_cst derive_id. + rewrite /GRing.scale /= !(mulr0,add0r,mulr1). + rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. + instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). + reflexivity. +clear df0. +have y1cc y : y \in `[0, 1] -> 0 < 1 + y. + rewrite in_itv /= => /andP [] y0 ?. + by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. +have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. +have dfge0 y : y \in `]0, 1[ -> 0 <= df y. + move=> y01. + have:= y01. + rewrite /df in_itv /= => /andP [] y0 y1. + rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. + rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. + pose iy:= Itv01 (ltW y0) (ltW y1). + have y1E: 1 + y = @convex.conv _ R^o iy 1 2. + rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. + by rewrite addrACA (addrC (- y)) subrr addr0. + rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. + rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. + rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. + rewrite ler_pdivrMr//. + rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. + rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. + rewrite !exprS expr0 mulr1 -!natrM mulnE /=. + by rewrite with_interval.expR2_le8. +apply: (@ger0_derive1_homo R f 0 1 true false). +- by move=> y /y1oo /idf /@ex_derive. +- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. +- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. +- by rewrite bound_itvE. +- exact: subset_itv_oo_cc. +- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. +Qed. + +End taylor_ln_le. + +Section tuple_sum. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := + (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. + +Lemma measurable_tuple_sum n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (tuple_sum s). +Proof. +apply: measurable_sum => i/=; apply/measurableT_comp => //. +exact: measurable_tnth. +Qed. + +HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (tuple_sum s) (measurable_tuple_sum s). + +Definition tuple_prod n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := + (fun x => \prod_(i < n) (tnth s i) (tnth x i))%R. + +Lemma measurable_tuple_prod n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (tuple_prod s). +Proof. +apply: measurable_prod => /= i _; apply/measurableT_comp => //. +exact: measurable_tnth. +Qed. + +HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (tuple_prod s) (measurable_tuple_prod s). + +End tuple_sum. + +Section properties_of_expectation. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) M : + (forall i t, (0 <= tnth X i t <= M)%R) -> + 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). +Proof. +elim: n X => [X|n IH X] /= XM. + rewrite /tuple_sum. + under eq_fun do rewrite big_ord0. + by rewrite big_ord0 expectation_cst. +pose X0 := thead X. +have intX0 : P.-integrable [set: T] (EFin \o X0). + apply: (bounded_RV_integrable M) => // t. + exact: XM. +have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). + move=> /tnthP[i XiXi]. + apply: (bounded_RV_integrable M) => // t. + rewrite XiXi. + exact: XM. +rewrite big_ord_recl/=. +rewrite /tuple_sum/=. +under eq_fun do rewrite big_ord_recl/=. +pose X1 (x : mtuple n.+1 T) := + (\sum_(i < n) (tnth X (lift ord0 i)) (tnth x (lift ord0 i)))%R. +have mX1 : measurable_fun setT X1. + apply: measurable_sum => /= i; apply: measurableT_comp => //. + exact: measurable_tnth. +pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. +pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. +pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). +have mX2 : measurable_fun setT X2. +rewrite /X2 /=. + by apply: measurableT_comp => //; exact: measurable_tnth. +pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. +pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. +rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. +rewrite expectationD; last 2 first. + apply: (bounded_RV_integrable M) => // t. + exact: XM. + rewrite (_ : _ \o _ = fun x => (\sum_(i < n) + (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. + by apply/funext => t/=; rewrite sumEFin. + apply: integrable_sum_ord => // i. + have : measurable_fun setT (fun x : mtuple n.+1 T => + (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). + apply/measurableT_comp => //=. + exact: measurable_tnth. + by move/(bounded_RV_integrable M); exact. +congr (_ + _). +- rewrite /Y2 /X2/= unlock /expectation. + (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) + pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). + have mphi : measurable_fun setT phi. + exact: measurable_tnth. + rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ setT + (fun w => (tnth X ord0 w)%:E)); last 3 first. + exact/measurable_EFinP. + apply: (bounded_RV_integrable M). + by []. + move=> t. + by apply: XM. + by []. + apply: eq_measure_integral => //= A mA _. + rewrite /pushforward. + rewrite /pro/= /phi. + rewrite [X in (_ \x^ _) X = _](_ : + [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] + = A `*` setT); last first. + apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. + move=> [x1 x2]/= [Ax1 _]. + exists [the mtuple _ _ of x1 :: x2] => //=. + by rewrite theadE; congr pair => //; exact/val_inj. + by rewrite product_measure2E//= probability_setT mule1. +- rewrite /Y1 /X1/=. + transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. + apply: eq_bigr => /= i _. + congr expectation. + rewrite tnth_behead. + congr (tnth X). + apply/val_inj => /=. + by rewrite /bump/= add1n/= inordK// ltnS. + rewrite -IH; last first. + move=> i t. + rewrite tnth_behead. + exact: XM. + transitivity ('E_\X_n P[(fun x : mtuple n T => + (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). + rewrite unlock /expectation. + transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). + rewrite integral_mpro//. + apply: eq_integral => /= -[w1 w2] _. + rewrite -!sumEFin. + apply: eq_bigr => i _ /=. + by rewrite tnthS//. + rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) + (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. + by apply/funext => t/=; rewrite sumEFin. + apply: integrable_sum_ord => // i. + have : measurable_fun setT (fun x : mtuple n.+1 T => + (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). + apply/measurableT_comp => //=. + exact: measurable_tnth. + by move/(bounded_RV_integrable M); exact. + rewrite /pro2. + rewrite -fubini2'/=; last first. + rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) + (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. + by apply/funext => t/=; rewrite sumEFin. + apply: integrable_sum_ord => //= i. + have : measurable_fun setT (fun x : T * mtuple n T => (tnth X (lift ord0 i) (tnth x.2 i))). + apply/measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n _ => tnth x i) _ snd) => //=. + exact: measurable_tnth. + move/(@bounded_RV_integrable _ _ R (pro1 P (mpro P (n:=n)))%E _ M) => /=. + apply => t. + by apply: XM. + apply: eq_integral => t _. + rewrite /fubini_G. + transitivity (\sum_(i < n) + (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). + rewrite -[RHS]integral_sum//. + by apply: eq_integral => x _; rewrite sumEFin. + move=> /= i. + exact: finite_measure_integrable_cst. + rewrite -sumEFin. + apply: eq_bigr => /= i _. + rewrite integral_cst//. + rewrite [X in _ * X]probability_setT mule1. + rewrite tnth_behead//=. + congr (tnth X _ _)%:E. + apply/val_inj => /=. + by rewrite inordK// ltnS. + by []. +Qed. + +Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) + (P1 : probability T1 R) (P2 : probability T2 R) + (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : + P1.-integrable setT (EFin \o X) -> + P2.-integrable setT (EFin \o Y) -> +(* independent_RVs2 P X Y -> NB: independence not used *) + let XY := fun (x : T1 * T2) => (X x.1 * Y x.2)%R in + 'E_(pro2 P1 P2)[XY] = 'E_P1[X] * 'E_P2[Y]. +Proof. +move=> intX intY/=. +rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. + apply/fubini1b. + - apply/measurable_EFinP => //=. + by apply: measurable_funM => //=; apply: measurableT_comp. + - under eq_integral. + move=> t _. + under eq_integral. + move=> x _. + rewrite /= normrM EFinM muleC. + over. + rewrite /= integralZl//; last first. + by move/integrable_abse : intX. + over. + rewrite /=. + rewrite ge0_integralZr//; last 2 first. + apply/measurable_EFinP => //. + by apply/measurableT_comp => //. + by apply: integral_ge0 => //. + rewrite lte_mul_pinfty//. + by apply: integral_ge0 => //. + apply: integral_fune_fin_num => //. + by move/integrable_abse : intY. + by move/integrableP : intX => []. +rewrite /fubini_F/=. +under eq_integral => x _. + under eq_integral => y _ do rewrite EFinM. + rewrite integralZl//. + rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. + over. +rewrite /=integralZr//. +by rewrite fineK// integral_fune_fin_num. +Qed. + +End properties_of_expectation. + +Section mv_to_inde. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Variable n : nat. + +Lemma independent_RVsD1_ord (*(I : {fset 'I_n.+1})*) (X : n.+1.-tuple {RV P >-> R}) : + independent_RVs (P := P) [set: 'I_n.+1] (tnth X) -> independent_RVs (P := P) ([set: 'I_n.+1] `\ ord0) (tnth X). +Proof. +move=> H. +split => [/= i|/= J JIi0 E EK]. + case=> // ii0 iI. + by apply H. +by apply H => //. +(*move=> /= x /JIi0 /=. +by case.*) +Qed. + +End mv_to_inde. + +Section properties_of_independence. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Lemma independent_mmt_gen_fun n (X : n.-tuple {RV P >-> bool}) t : + let mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* (btr P (tnth X i)) in + independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] mmtX. +Proof. +rewrite /= => PnX. +apply: independent_RVs_comp => //. +apply: independent_RVs_scale => //=. +exact: independent_RVs_btr. +Qed. + +Lemma boundedM U (f g : U -> R) (A : set U) : + [bounded f x | x in A] -> + [bounded g x | x in A] -> + [bounded (f x * g x)%R | x in A]. +Proof. +move=> bF bG. +rewrite/bounded_near. +case: bF => M1 [M1real M1f]. +case: bG => M2 [M2real M2g]. +near=> M. +rewrite/globally/= => x xA. +rewrite normrM. +rewrite (@le_trans _ _ (`|M1 + 1| * `|M2 + 1|)%R)//. +rewrite ler_pM//. + by rewrite M1f// (lt_le_trans _ (ler_norm _))// ltrDl. +by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. +Unshelve. all: by end_near. +Qed. + + +Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : + (forall i t, (0 <= tnth X i t <= M)%R) -> + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. +Proof. +elim: n X => [X|n IH X] /= boundedX intX. + rewrite /tuple_prod. + under eq_fun do rewrite big_ord0. + by rewrite big_ord0 expectation_cst. +rewrite big_ord_recl/=. +rewrite unlock /expectation integral_mpro /pro2; last first. + apply: (bounded_RV_integrable (M^+n.+1)%R) => // t. + rewrite /tuple_prod. + apply/andP. split. + rewrite prodr_ge0//= => i _. + by have /andP[] := boundedX i (tnth t i). + rewrite -[in leRHS](subn0 n.+1) -prodr_const_nat. + by rewrite big_mkord ler_prod. +rewrite /tuple_prod/=. +under eq_fun => x do (rewrite big_ord_recl/= tnth0; under eq_bigr => i do rewrite tnthS). +rewrite -fubini1' /fubini_F/=; last first. + apply: measurable_bounded_integrable => //=. + - rewrite /product_measure1/=. + apply: (@le_lt_trans _ _ 1); last exact: ltry. + rewrite -(mule1 1) -{2}(@probability_setT _ _ _ P) -(integral_cst P _ 1)//. + apply: ge0_le_integral => //=. + exact: measurable_fun_xsection. + by move=> x _; apply: probability_le1; exact: measurable_xsection. + - apply: measurable_funM => //=. + exact: measurableT_comp. + apply: measurable_prod => //=i ?. + apply: measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n T => @tnth n T x i) _ snd) => //=. + exact: measurable_tnth. + apply: boundedM. + apply/ex_bound. exact: (@globally_properfilter _ _ point). (* TODO: need to automate globally_properfilter *) + exists M; rewrite /globally/= => x _. + have /andP[? ?] := boundedX ord0 x.1. + by rewrite ger0_norm. + apply/ex_bound; first exact: (@globally_properfilter _ _ point). + exists (M^+n)%R. rewrite /globally/= => x _. + rewrite normr_prod -[in leRHS](subn0 n) -prodr_const_nat. + rewrite big_mkord ler_prod => //=i _. + have /andP[? ?] := boundedX (lift ord0 i) (tnth x.2 i). + by rewrite normr_ge0/= ger0_norm. +have ? : (mpro P (n:=n)).-integrable [set: mtuple n T] + (fun x : mtuple n T => (\prod_(i < n) tnth X (lift ord0 i) (tnth x i))%:E). + apply: (bounded_RV_integrable (M^+n)%R) => //=. + apply: measurable_prod => /=i _. + apply: measurableT_comp => //. + exact: measurable_tnth. + move=> t. apply/andP. split. + by rewrite prodr_ge0//= => i _; have /andP[] := boundedX (lift ord0 i) (tnth t i). + by rewrite -[in leRHS](subn0 n) -prodr_const_nat big_mkord ler_prod. +under eq_fun => x. + under eq_fun => y do rewrite/= EFinM. + rewrite integralZl//= -[X in _*X]fineK ?integral_fune_fin_num//=. + over. +rewrite integralZr//; last by rewrite intX// (tuple_eta X) tnth0 mem_head. +congr (_ * _). +rewrite fineK ?integral_fune_fin_num//=. +under eq_fun => x. + under eq_bigr => i _. + rewrite [X in tnth X]tuple_eta tnthS. + over. + over. +simpl. +rewrite [LHS](_ : _ = 'E_(\X_n P)[ tuple_prod (behead_tuple X) ]); last first. + by rewrite [in RHS]unlock /expectation [in RHS]/tuple_prod. +rewrite IH; last 2 first. +- by move=> i t; rewrite tnth_behead. +- by move=> Xi XiX; apply: intX; rewrite mem_behead. +apply: eq_bigr => /=i _. +rewrite unlock /expectation. +apply: eq_integral => x _. +congr EFin. +by rewrite [in RHS](tuple_eta X) tnthS. +Qed. + +Section fset. +Local Open Scope fset_scope. +Lemma fset_bool : forall B : {fset bool}, + [\/ B == [fset true], B == [fset false], B == fset0 | B == [fset true; false]]. +Proof. +move=> B. +have:= set_bool [set` B]. +rewrite -!set_fset1 -set_fset0. +rewrite (_ : [set: bool] = [set` [fset true; false]]); last first. + by apply/seteqP; split=> -[]; rewrite /= !inE eqxx. +by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; + [apply: Or41|apply: Or42|apply: Or43|apply: Or44]. +Qed. +End fset. + +Section tmp. +Variable n : nat. + +Definition In1 := 'I_n.+1. +HB.instance Definition _ := Choice.on In1. +HB.instance Definition _ := isPointed.Build In1 ord0. + +Variable X : n.+1.-tuple {RV P >-> R}. + +Lemma expectation_prod_independent_RVs : + independent_RVs (P := P) [set: 'I_n.+1] (tnth X) -> + independent_RVs2 (P := P) (thead X) (\prod_(i < n) (tnth (behead_tuple X) i))%R. +Proof. +rewrite /independent_RVs2. +rewrite /independent_RVs. +move=> H. +pose I_ (b : bool) : set 'I_n.+1 := if b then setT `\ ord0 else [set ord0]. +have H1 : trivIset [set` [fset false; true]%fset] I_. + admit. +have H2 : (forall k : bool, k \in [fset false; true]%fset -> I_ k `<=` [set: 'I_n.+1]). + admit. +evar (h : 'I_n.+1 -> set_system T). +rewrite /=. +have := @mutual_independence_bigcup R _ T P bool In1 [fset false; true]%fset I_ [set: 'I_n.+1] + h H1 H2 H. +rewrite (_ : [set` [fset false; true]%fset] = setT); last admit. +rewrite /=. +suff: (fun k : bool => \bigcup_(i in I_ k) h i) = + (fun i : Datatypes_bool__canonical__choice_Choice => + g_sigma_algebra_preimage + (if i then (\prod_(i0 < n) tnth (behead_tuple X) i0)%R else thead X)). + by move=> ->. +rewrite /=. +apply/funext => -[|]. + rewrite /I_. + rewrite /g_sigma_algebra_preimage. + rewrite /preimage_set_system. + apply/seteqP; split. + move=> A [i/= [_ /eqP i0]] hiA. + rewrite /h in hiA. + case: hiA => Y mY. + rewrite setTI => <-. + set x := [set r | exists t, A t /\ r = (\prod_(i < n) tnth (behead_tuple X) i t)%R]. + exists x. + admit. + rewrite setTI. + apply/seteqP; split => [z|z]. + rewrite /= => -[t [At]]. + admit. +(* +elim: n X => [|n ih X]. + admit. +move=> H. +split. + admit. +move=> /= J _ A JA. +have [| | |/eqP JE]:= fset_bool J. + admit. + admit. + admit. +set X' := behead_tuple X. +have @X'' : n.+1.-tuple {RV P >-> R}. + admit. +have X''E : forall (i : 'I_n.+1) t, + (tnth X'' i) t = if i == ord_max then ((tnth X' i t) * (thead X') t)%R else (tnth X' i) t. + admit. +have ih' : independent_RVs P [set: 'I_n.+1] (tnth X''). +(* have H1 : independent_RVs P ([set: 'I_n.+2] `\ ord0) (tnth X). + by apply: independent_RVsD1_ord => //.*) + split => /=. + admit. + move=> K _ E KE. + case: H => /= H1 H2. + pose K' : {fset 'I_n.+2} := ((fun x : 'I_n.+1 => lift ord0 x) @` K)%fset. + pose E' (i : 'I_n.+2) := if i == inord ((@ord_max n.+1)) then setT else E (inord i.-1). + have K'E' : (forall i : 'I_n.+2, i \in K' -> E' i \in g_sigma_algebra_preimage (tnth X i)). + move=> _ /imfsetP[/= j jK ->]. + rewrite /E' /=. + case: ifPn => [_|j0]. + rewrite inE. + exists setT => //. + by rewrite preimage_setT setTI. + rewrite inE. + have := KE _ jK. + rewrite inE => -[Y mY YEj]. + exists Y => //. + rewrite setTI. + rewrite setTI in YEj. + have : forall t, tnth X'' j t = tnth X (lift ord0 j) t. + move=> r. + rewrite X''E. + rewrite ifF; last first. + apply/negbTE. + apply: contra j0 => /eqP jE. + rewrite jE. + apply/eqP/val_inj => /=. + by rewrite /bump/= inordK//. + rewrite tnth_behead/=. + congr (tnth X _ r). + apply/val_inj => /=. + rewrite inordK; last first. + by rewrite ltnS. + by rewrite /bump/= add1n. + move/funext. + move=> <-. + rewrite YEj. + congr E. + apply/val_inj => /=. + by rewrite inordK. + have {}H2 := H2 K' (@subsetT _ _) E' K'E'. + + admit. +have {}ih := ih X'' ih'. +case: ih => /= ih1 ih2. + +case: H => /= H1 H2. +have : (g_sigma_algebra_preimage (thead X)) (A false). + admit. +case=> Y1 mY1. +rewrite setTI => AfalseE. +have : (g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth (behead_tuple X) i0)%R) (A true). + admit. +case=> /= Y2 mY2. +rewrite setTI => AtrueE. + +apply ih2 => //. +case => _. + rewrite inE. + exists Y2 => //=. + rewrite setTI. + rewrite big_ord_recl /= in AtrueE. + rewrite -AtrueE. + congr (_ @^-1` Y2). + apply/funext => t. + rewrite /= fctE. + destruct n. + admit. + rewrite [in LHS]big_ord_recr/=. + rewrite [in RHS]big_ord_recr/=. + rewrite mulrCA; congr *%R. + admit. + rewrite tnth_behead. + rewrite [in LHS]X''E/= ifT//; last first. + apply/eqP. + apply: val_inj => /=. + by rewrite inordK. + rewrite /X' mulrC. + rewrite !tnth_behead. + congr *%R. + rewrite /thead. + by rewrite tnth_behead//. + congr (tnth X _ t). + apply/val_inj => /=. + by rewrite !inordK//. +rewrite inE. +exists Y1 => //. +rewrite setTI. +rewrite /thead. +have : forall t, thead X t = tnth X'' ord0 t. + move=> t. + rewrite X''E. + rewrite ifF; last first. + apply/negbTE. + apply/eqP. + move=> /(congr1 val) /=. + admit. + rewrite tnth_behead//. + rewrite /thead. +Abort. +*) +Abort. + +End tmp. + +Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : + independent_RVs (P := P) [set: 'I_n] (tnth X) -> + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. +Proof. +elim: n X => [X|n IH X] /= iRVX intX. + rewrite /tuple_prod. + under eq_fun do rewrite big_ord0. + by rewrite big_ord0 expectation_cst. +pose X0 := thead X. +have intX0 : P.-integrable [set: T] (EFin \o X0). + by apply: intX; rewrite mem_tnth. +have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). + by move=> XiX; exact: intX. + +pose X1 (x : mtuple n.+1 T) := + (\prod_(i < n) tnth X (lift ord0 i) (tnth x (lift ord0 i)))%R. +have mX1 : measurable_fun setT X1. + apply: measurable_prod => /= i ?. apply: measurableT_comp => //. + exact: measurable_tnth. +pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. +pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. +pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). +have mX2 : measurable_fun setT X2. +rewrite /X2 /=. + by apply: measurableT_comp => //; exact: measurable_tnth. +pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. +pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. +rewrite /tuple_prod. +under eq_fun => x /=. rewrite big_ord_recl/=. over. +rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. +simpl in Y1, Y2. + +rewrite expectation_prod; last 3 first. +- split. + move=> i /= _ A. + case: ifP=> Hi /=. + by case=> B mB <-; exact: (mX1). + by case=> B mB <-; exact: (mX2). + move=> /= J ? E Ei. + case: (fset_bool J)=> /eqP HJ; rewrite -> HJ in * |- *; clear J HJ. + + by rewrite !big_seq_fset1. + + by rewrite !big_seq_fset1. + + rewrite !big_seq_fset0. + suff-> : [set (thead x, [tuple of behead x]) | x in [set: mtuple n.+1 T]] = setT. + by rewrite probability_setT. + apply/seteqP; split=> -[t1 t2] //= _. + exists [tuple of t1 :: t2] => //=. + by rewrite theadE; congr pair; exact/val_inj. + + rewrite !big_fsetU1 ?inE//= !big_seq_fset1. + set E1 := E true. + set E2 := E false. + have EX1 : E1 \in g_sigma_algebra_preimage X1. + by have:= Ei true; rewrite !inE eqxx=> /(_ erefl). + have EX2 : E2 \in g_sigma_algebra_preimage X2. + by have:= Ei false; rewrite !inE eqxx orbT=> /(_ erefl). + clear Ei X0 intX0 intX Y1 Y2 build_mX1 build_mX2. + (* analyze EX2 *) + have:= EX2. + rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. + under [f in image _ f]funext=> /= B do rewrite setTI. + rewrite inE/=. + case=> B2 mB2. + move=> /[dup] EX2' <-. + (* analyze EX1 *) + have:= EX1. + rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. + under [f in image _ f]funext=> /= B. + rewrite setTI. + rewrite (_ : mkset _ = [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth (behead_tuple t) (i : 'I_n.+1.-1)))%R]); last first. + apply/eq_set=> t. + rewrite /X1 [in LHS](tuple_eta t) [in LHS](tuple_eta X). + by under eq_bigr do rewrite !tnthS. + rewrite + (_ : + mkset _ = + image (setT `*` + [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth t i))%R]) + (fun t => [tuple of t.1 :: t.2]) ); last first. + apply/seteqP; split=> t; rewrite (tuple_eta t) /=. + have-> : behead_tuple [tuple of thead t :: behead t] = behead_tuple t by exact/val_inj. + by move=> H; exists (thead t, behead_tuple t) => //; split. + case=> -[x0 x] [] _ /= H <-. + by have-> : behead_tuple [tuple of x0 :: x] = x by exact/val_inj. + over. + set X' : n.-tuple _ := behead_tuple X. + rewrite inE /=. + case=> B' mB'. + move<-. + (* simplify LHS *) + set E1'' := mkset _. + have mE1'' : measurable (E1'' : set (mtuple _ _)). + rewrite /E1'' -/(preimage _ _). + set f : mtuple n T -> R := (f in preimage f). + suff: measurable_fun setT f by rewrite -[preimage _ _]setTI; exact. + rewrite /f. + apply: measurable_prod=> /= i _. + apply: (measurable_comp measurableT)=> //=. + exact: measurable_tnth. + (* simplify LHS *) + rewrite [image _ _](_ : _ = (thead X @^-1` B2) `*` E1''); last first. + apply/seteqP; split=> -[x0 x] /=. + case=> x1 [] [] [y0 y] /= [] _ ? <- /[!theadE] ? /eqP /[!xpair_eqE] /andP [] /eqP <- /eqP /= <-. + rewrite [y in E1'' y](_ : _ = y)//. + exact/val_inj. + case=> ? ?. + exists [tuple of x0 :: x]; last by congr pair; apply/val_inj. + split=> //. + by exists (x0, x). + rewrite product_measure2E//=; last first. + by rewrite -[preimage _ _]setTI; exact: measurable_funP. + (* simplify RHS *) + rewrite image_comp [f in image _ f](_ : _ = idfun); last first. + by apply/funext=> -[t0 t] /=; congr pair; exact/val_inj. + rewrite image_id product_measure2E//. + rewrite [X in _ = X * _ * _]probability_setT mul1e /=. + rewrite muleC; congr mule. + rewrite (_ : image _ _ = thead X @^-1` B2 `*` setT); last first. + apply/seteqP; split=> /= -[t0 t] /=. + by case=> x ? /eqP /[!xpair_eqE] /andP [] /eqP <- _. + case=> ? _; exists [tuple of t0 :: t]; rewrite ?theadE//. + by congr pair; exact/val_inj. + rewrite product_measure2E//; last first. + by rewrite -[preimage _ _]setTI; exact: measurable_funP. + by rewrite [X in _ = _ * X]probability_setT mule1. +- admit. +- admit. +rewrite big_ord_recl. +congr (_ * _). + admit. + +under eq_bigr => i _ do rewrite [X in tnth X]tuple_eta tnthS. +rewrite -IH; last 2 first. +- admit. +- admit. +rewrite /Y1/X1/tuple_prod/=. +under eq_fun => x. under eq_bigr => i _. rewrite [X in tnth X]tuple_eta [X in _ (tnth X _)]tuple_eta !tnthS. over. over. +rewrite /=. +rewrite unlock /expectation integral_mpro//. + under eq_fun => x. under eq_bigr => i _. + rewrite (tnth_behead (x.1 :: x.2)) (_ : inord i.+1 = lift ord0 i) ?tnthS; last first. + by apply: val_inj; rewrite /=inordK// ltnS. + over. + over. + simpl. + rewrite -fubini2'/fubini_G/=. + apply: eq_integral => x _/=. + by rewrite integral_cst//= probability_setT mule1. + admit. +admit. +Abort. + +Lemma finite_prod n (F : 'I_n -> \bar R) : + (forall i, 0 <= F i < +oo) -> \prod_(i < n) F i < +oo. +Proof. +move: F; elim: n => n; first by rewrite big_ord0 ltry. +move=> ih F Foo. +rewrite big_ord_recl lte_mul_pinfty//. +- by have /andP[] := Foo ord0. +- rewrite fin_numElt. + have /andP[F0 ->] := Foo ord0. + by rewrite (@lt_le_trans _ _ 0). +by rewrite ih. +Qed. + +Lemma sub_independent_RVs d' [T' : measurableType d'] [I : choiceType] [A B : set I] + [X : I -> {RV P >-> T'}]: + A `<=` B -> independent_RVs (P := P) B X -> independent_RVs (P := P) A X. +Proof. +move=> AB [h1 h2]. split. + by move=> i Ai; apply: h1; exact: AB. +move=> J JA E h3. +by apply: h2 => //; apply: subset_trans; first apply: JA. +Qed. + +Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) M: + independent_RVs (P := P) [set: 'I_n] (tnth X) -> + (forall i t, (0 <= tnth X i t <= M)%R) -> + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_P[ \prod_(i < n) (tnth X i) ] = \prod_(i < n) 'E_P[ (tnth X i) ]. +Proof. +elim: n X => [X|n ih X]. + by rewrite !big_ord0 expectation_cst. +move=> /=iRVs boundedX intX. + +rewrite [RHS]big_ord_recl/=. +rewrite [X in _ * X](_ : _ = \prod_(i < n) ('E_P [ (tnth (behead_tuple X) i) ])); last first. + by apply: eq_bigr => i _; congr expectation; apply funext => x; rewrite [in LHS](tuple_eta X) tnthS. +rewrite -ih; last 3 first. +- suffices: independent_RVs (P := P) [set` behead_tuple (ord_tuple n.+1)] (fun i => tnth X i). + rewrite /independent_RVs. move=> [/=h1 h2]. split => /=. + move=> i _. + have := h1 (lift ord0 i). rewrite {1}(tuple_eta X) tnthS. apply. + apply/tnthP. exists i. + rewrite tnth_behead/= tnth_ord_tuple. + by apply: ord_inj; rewrite lift0 inordK// ltnS. + move=> J JIn E h3. + have /=J' := ((@widen_ord n n.+1 (leqnSn n)) @` J)%fset. + have J'In1 : [set` J'] `<=` [set: 'I_n.+1] by exact: subsetT. + (* have := h2 J' J'In1. *) + admit. + exact: (@sub_independent_RVs _ _ _ _ [set: 'I_n.+1]). +- by move=> i t; rewrite tnth_behead boundedX. +- by move=> Xi XiX; rewrite intX// mem_behead. + +pose X1 := (fun x : mtuple n.+1 R => \prod_(i < n.+1) tnth x i)%R. +pose X2 := (fun t : T => [the mtuple n.+1 R of [tuple of [seq tnth X i t | i <- ord_tuple n.+1]]])%R. +have mX1 : measurable_fun setT X1. admit. +have mX2 : measurable_fun setT X2. admit. +pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. +pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. +pose Y1 : {mfun mtuple n.+1 R >-> R} := HB.pack X1 build_mX1. +pose Y2 : {mfun T >-> mtuple n.+1 R} := HB.pack X2 build_mX2. +rewrite [X in 'E_P[X]](_ : _ = Y1 \o Y2)%R; last first. + apply: funext => t. + rewrite /Y1/Y2/X1/X2/=. + under [RHS]eq_bigr => i _ do rewrite tnth_map tnth_ord_tuple. + admit. + +rewrite unlock/expectation -(@integral_pushforward _ _ _ _ _ _ _ _ setT (EFin \o Y1))//=; last first. +- admit. +- exact: measurableT_comp. +pose X3 := (fun t : T => (tnth X ord0 t,[the mtuple n R of [tuple of [seq tnth (behead_tuple X) i t | i <- ord_tuple n]]]))%R. +have mX3 : measurable_fun setT X3. admit. +pose build_mX3 := isMeasurableFun.Build _ _ _ _ _ mX3. +pose Y3 : {mfun T >-> _} := HB.pack X3 build_mX3. +rewrite /X1. +rewrite [LHS](_ : _ = \int[pushforward P mX3]_y (y.1 * \prod_(i < n) tnth y.2 i)%:E); last first. + under eq_integral => y _. + rewrite big_ord_recl/=. + rewrite [X in (_ * X)%R](_ : _ = \prod_(i < n) tnth (behead_tuple y) i )%R; last first. + by apply eq_bigr => j _; rewrite [in LHS](tuple_eta y) tnthS. + over. + simpl. + admit. +rewrite [in LHS]/pushforward/=. + +(* +case: n X => [X|n X]. + by rewrite !big_ord0 expectation_cst. +elim: n X => [X|n IH X] /= iRVX intX. + admit. +rewrite big_ord_recl [in RHS] big_ord_recl. +rewrite expectation_prod; last 3 first. +- apply: (@independent_generators _ _ _ _ _ _ _ _ (fun i => @RGenOInfty.G R)) => //=. + - move=> i _. admit. + - move=> i _. admit. + - admit. + split => /=. + case => _//= A/= []B nB <-. + have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. + apply => //. admit. + have : measurable_fun setT (tnth X ord0) by []. + apply => //. admit. + move=> J _ E JE. + have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. + rewrite setT_bool. + rewrite bigcap_setU1 bigcap_set1. + rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. + case: iRVX => /=H1 H2. + pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else + if i == lift ord0 ord0 then E true + else setT. + pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. + (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) + (* case. case. *) + (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) + (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) + (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) + (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) + (* admit. *) + (* (* have := H2 _ _ _ K1. *) *) + have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). + apply: H2 => //. + case. case. + - move=> i _. rewrite /E'/=. have := JE false. admit. + - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. + by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. +- split => /=. + case => _//= A/= []B nB <-. + have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. + exact. + have : measurable_fun setT (tnth X ord0) by []. + exact. + move=> J _ E JE. + + + have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set1 fset_set1 big_seq_fset1. + - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. + rewrite setT_bool. + rewrite bigcap_setU1 bigcap_set1. + rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. + case: iRVX => /=H1 H2. + pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else + if i == lift ord0 ord0 then E true + else setT. + pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. + (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) + (* case. case. *) + (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) + (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) + (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) + (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) + (* admit. *) + (* (* have := H2 _ _ _ K1. *) *) + have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). + apply: H2 => //. + case. case. + - move=> i _. rewrite /E'/=. have := JE false. admit. + - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. + by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. +- by rewrite intX// mem_tnth. +- rewrite (_ : (\prod_(i < n) tnth X (lift ord0 i))%R = (\prod_(i < n) tnth (behead_tuple X) i)%R); last first. + by apply: eq_bigr => i _; rewrite [in LHS](tuple_eta X) tnthS. + apply: integrable_prod => i. + by rewrite intX// tnth_behead mem_tnth. +rewrite (_ : \prod_(i < n) tnth X (lift ord0 i) = \prod_(i < n) tnth (behead X) i)%R; last first. + apply: eq_bigr => /=i _. rewrite tnth_behead (_ : inord i.+1 = lift ord0 i)//=. + by apply: val_inj; rewrite /=inordK// ltnS. +rewrite IH//=. +- congr (_ * _). + apply: eq_bigr=> i _. + congr expectation. + by rewrite [in RHS](tuple_eta X) tnthS. +- admit. +- by move=> Xi XiX; rewrite intX// mem_behead.*) +Abort. + +End properties_of_independence. + +Section bernoulli. + +Local Open Scope ereal_scope. +Let R := Rdefinitions.R. +Context d (T : measurableType d) (P : probability T R). +Variable p : R. +Hypothesis p01 : (0 <= p <= 1)%R. + +Definition bernoulli_RV (X : {RV P >-> bool}) := + distribution P X = bernoulli p. + +Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> + P [set i | X i == 1%R] = p%:E. +Proof. +move=> /(congr1 (fun f => f [set 1%:R])). +rewrite bernoulliE//. +rewrite /mscale/=. +rewrite diracE/= mem_set// mule1// diracE/= memNset//. +rewrite mule0 adde0. +rewrite /distribution /= => <-. +congr (P _). +rewrite /preimage/=. +by apply/seteqP; split => [x /eqP H//|x /eqP]. +Qed. + +Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> + P [set i | X i == 0%R] = (`1-p)%:E. +Proof. +move=> /(congr1 (fun f => f [set 0%:R])). +rewrite bernoulliE//. +rewrite /mscale/=. +rewrite diracE/= memNset//. +rewrite mule0// diracE/= mem_set// add0e mule1. +rewrite /distribution /= => <-. +congr (P _). +rewrite /preimage/=. +by apply/seteqP; split => [x /eqP H//|x /eqP]. +Qed. + +Lemma bernoulli_expectation (X : {RV P >-> bool}) : + bernoulli_RV X -> 'E_P[btr P X] = p%:E. +Proof. +move=> bX. +rewrite unlock /btr. +rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. + by move=> y //=. +rewrite /bernoulli/=. +rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. + by move=> A mA _/=; rewrite (_ : distribution P X = bernoulli p). +rewrite integral_bernoulli//=. +by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. +Qed. + +Lemma integrable_bernoulli (X : {RV P >-> bool}) : + bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). +Proof. +move=> bX. +apply/integrableP; split. + by apply: measurableT_comp => //; exact: measurable_bool_to_real. +have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. + rewrite unlock /expectation. + apply: eq_integral => x _. + by rewrite gee0_abs //= lee_fin. +by rewrite bernoulli_expectation// ltry. +Qed. + +Lemma bool_RV_sqr (X : {dRV P >-> bool}) : + ((btr P X ^+ 2) = btr P X :> (T -> R))%R. +Proof. +apply: funext => x /=. +rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. +by case: (X x) => /=; rewrite ?mulr1 ?mulr0. +Qed. + +Lemma bernoulli_variance (X : {dRV P >-> bool}) : + bernoulli_RV X -> 'V_P[btr P X] = (p * (`1-p))%:E. +Proof. +move=> b. +rewrite (@varianceE _ _ _ _ (btr P X)); + [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. +rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. +by rewrite expe2 -EFinD onemMr. +Qed. + +(* TODO: define a mixin *) +Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := + (forall i : 'I_n, bernoulli_RV (tnth X i)). + +Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R : realType} := + tuple_sum [the n.-tuple _ of (map (btr P) + (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. + +(* +was wrong +Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := + (\sum_(i-> bool}) : + is_bernoulli_trial X -> 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. +Proof. +move=> bRV. rewrite /bernoulli_trial. +transitivity ('E_(\X_n P)[tuple_sum (map (btr P) X)]). + congr expectation; apply/funext => t. + by apply: eq_bigr => /= i _; rewrite !tnth_map. +rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. + move=> i t. + rewrite tnth_map//. + rewrite /btr/= /bool_to_real/=. + by case: (tnth X i t) => /=; rewrite !lexx !ler01. +transitivity (\sum_(i < n) p%:E). + apply: eq_bigr => k _. + rewrite tnth_map bernoulli_expectation//. +by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. +Qed. + +Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> + (forall t, 0 <= bernoulli_trial X t)%R. +Proof. +move=> bRV t. +rewrite /bernoulli_trial. +apply/sumr_ge0 => /= i _. +by rewrite !tnth_map. +Qed. + +Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : + is_bernoulli_trial X_ -> + let X := bernoulli_trial X_ in + 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. +Proof. +move=> bRVX/=. +pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* btr P (tnth X_ i). +transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. + congr expectation => /=; apply: funext => x/=. + rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. + by rewrite !tnth_map /mmtX/= tnth_ord_tuple. +rewrite /mmtX. +rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. +- move=> i ?. + apply/andP. split. + by rewrite tnth_mktuple/= expR_ge0. + rewrite tnth_mktuple/=/bool_to_real/=. + rewrite ler_expR -[leRHS]mul1r. + have [t0|t0] := leP 0%R t. + by rewrite ger0_norm// ler_pM//; case: (tnth X_ i _). + rewrite (@le_trans _ _ 0%R)//. + by rewrite mulr_ge0_le0// ltW. +- move=> _ /mapP[/= i _ ->]. + apply: (bounded_RV_integrable (expR `|t|)) => // t0. + rewrite expR_ge0/= ler_expR/=. + rewrite /bool_to_real/=. + case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. + by rewrite ler_norm. + (* rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. *) + (* apply: funext => i. *) + (* by rewrite /mmtX/= tnth_map tnth_ord_tuple. *) +apply: eq_bigr => /= i _. +congr expectation. +rewrite /=. +by rewrite tnth_map/= tnth_ord_tuple. +Qed. + +Arguments sub_countable [T U]. +Arguments card_le_finite [T U]. + +Lemma bernoulli_mmt_gen_fun (X : {RV P >-> bool}) (t : R) : + bernoulli_RV X -> 'M_(btr P X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. +Proof. +move=> bX. rewrite/mmt_gen_fun. +pose mmtX : {RV P >-> R : realType} := expR \o t \o* (btr P X). +set A := X @^-1` [set true]. +set B := X @^-1` [set false]. +have mA: measurable A by exact: measurable_sfunP. +have mB: measurable B by exact: measurable_sfunP. +have dAB: [disjoint A & B] + by rewrite /disj_set /A /B preimage_true preimage_false setICr. +have TAB: setT = A `|` B by rewrite -preimage_setU -setT_bool preimage_setT. +rewrite unlock. +rewrite TAB integral_setU_EFin -?TAB//. +under eq_integral. + move=> x /=. + rewrite /A inE /bool_to_real /= => ->. + rewrite mul1r. + over. +rewrite integral_cst//. +under eq_integral. + move=> x /=. + rewrite /B inE /bool_to_real /= => ->. + rewrite mul0r. + over. +rewrite integral_cst//. +rewrite /A /B /preimage /=. +under eq_set do rewrite (propext (rwP eqP)). +rewrite (bernoulli_RV1 bX). +under eq_set do rewrite (propext (rwP eqP)). +rewrite (bernoulli_RV2 bX). +rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. +by rewrite expR0 mulr1. +Qed. + +(* wrong lemma *) +Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : + is_bernoulli_trial X_ -> + let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in + 'M_X t = ((p * expR t + (1 - p))`^(n%:R))%:E. +Proof. +move: p01 => /andP[p0 p1] bX/=. +rewrite bernoulli_trial_mmt_gen_fun//. +under eq_bigr => i _ do rewrite bernoulli_mmt_gen_fun//. +rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. +by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. +Qed. + +Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : + (0 <= t)%R -> + is_bernoulli_trial X_ -> + let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in + 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. +Proof. +move=> t_ge0 bX/=. +have /andP[p0 p1] := p01. +rewrite binomial_mmt_gen_fun// lee_fin. +rewrite expectation_bernoulli_trial//. +rewrite addrCA -{2}(mulr1 p) -mulrN -mulrDr. +rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. + by rewrite addr_ge0// mulr_ge0// subr_ge0 -expR0 ler_expR. +exact: expR_ge1Dx. +Qed. + +Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : + is_bernoulli_trial X_ -> + (0 < delta)%R -> + let X := @bernoulli_trial n X_ in + let mu := 'E_(\X_n P)[X] in + let t := ln (1 + delta) in + (expR (expR t - 1) `^ fine mu)%:E * + (expR (- t * (1 + delta)) `^ fine mu)%:E <= + ((expR delta / (1 + delta) `^ (1 + delta)) `^ fine mu)%:E. +Proof. +move=> bX d0 /=. +rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. +- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). +- by rewrite mulr_ge0// expR_ge0. +- by rewrite divr_ge0 ?expR_ge0// powR_ge0. +- rewrite lnK ?posrE ?addr_gt0// addrAC subrr add0r ler_wpM2l ?expR_ge0//. + by rewrite -powRN mulNr -mulrN expRM lnK// posrE addr_gt0. +Qed. + +(* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) +Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {RV P >-> bool}) (delta : R) : + is_bernoulli_trial X_ -> + (0 < delta)%R -> + let X := @bernoulli_trial n X_ in + let mu := 'E_(\X_n P)[X] in + (\X_n P) [set i | X i >= (1 + delta) * fine mu]%R <= + ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. +Proof. +rewrite /= => bX delta0. +set X := @bernoulli_trial n X_. +set mu := 'E_(\X_n P)[X]. +set t := ln (1 + delta). +have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. +apply: (le_trans (chernoff _ _ t0)). +apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * + (expR (- (t * ((1 + delta) * fine mu))))%:E)). + rewrite lee_pmul2r ?lte_fin ?expR_gt0//. + by apply: (mmt_gen_fun_expectation _ bX); rewrite ltW. +rewrite mulrC expRM -mulNr mulrA expRM. +exact: (end_thm24 _ bX). +Qed. + +(* theorem 2.5 *) +Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) : + is_bernoulli_trial X -> + let X' := @bernoulli_trial n X in + let mu := 'E_(\X_n P)[X'] in + (0 < n)%nat -> + (0 < delta < 1)%R -> + (\X_n P) [set i | X' i >= (1 + delta) * fine mu]%R <= + (expR (- (fine mu * delta ^+ 2) / 3))%:E. +Proof. +move=> bX X' mu n0 /[dup] delta01 /andP[delta0 _]. +apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). + rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. + apply: (bernoulli_trial_inequality1 bX) => //. +apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). + rewrite lee_fin ler_expR ler_wpM2r//. + by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: (bernoulli_trial_ge0 bX). + rewrite lerB//. + apply: taylor_ln_le. + by rewrite in_itv /=. +rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. +by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. +Qed. + +(* TODO: move (to exp.v?) *) +Lemma norm_expR : normr \o expR = (expR : R -> R). +Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. + +(* Rajani thm 2.6 / mu-book thm 4.5.(2) *) +Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : + is_bernoulli_trial X -> (0 < delta < 1)%R -> + let X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType} in + let mu := 'E_(\X_n P)[X'] in + (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. +Proof. +move=> bX /andP[delta0 delta1] /=. +set X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType}. +set mu := 'E_(\X_n P)[X']. +have /andP[p0 p1] := p01. +apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). + (* using Markov's inequality somewhere, see mu's book page 66 *) + have H1 t : (t < 0)%R -> + (\X_n P) [set i | (X' i <= (1 - delta) * fine mu)%R] = (\X_n P) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. + move=> t0; apply: congr1; apply: eq_set => x /=. + rewrite lee_fin ger0_norm ?expR_ge0// ler_expR (mulrC _ t) -mulrA. + by rewrite -[in RHS]ler_ndivrMl// mulrA mulVf ?lt_eqF// mul1r. + set t := ln (1 - delta). + have ln1delta : (t < 0)%R. + (* TODO: lacking a lemma here *) + rewrite -oppr0 ltrNr -lnV ?posrE ?subr_gt0// ln_gt0//. + by rewrite invf_gt1// ?subr_gt0// ltrBlDr ltrDl. + have {H1}-> := H1 _ ln1delta. + apply: (@le_trans _ _ (((fine 'E_(\X_n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). + rewrite EFinM lee_pdivlMr ?expR_gt0// muleC fineK. + apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X' : {RV (\X_n P) >-> R : realType}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + - by apply: expR_gt0. + - rewrite norm_expR. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. + by rewrite (binomial_mmt_gen_fun _ bX)//. + apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). + rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. + rewrite (binomial_mmt_gen_fun _ bX)/=. + rewrite /mu /X' (expectation_bernoulli_trial bX)/=. + rewrite !lnK ?posrE ?subr_gt0//. + rewrite expRM powRrM powRAC. + rewrite ge0_ler_powR ?ler0n// ?nnegrE ?powR_ge0//. + by rewrite addr_ge0 ?mulr_ge0// subr_ge0// ltW. + rewrite addrAC subrr sub0r -expRM. + rewrite addrCA -{2}(mulr1 p) -mulrBr addrAC subrr sub0r mulrC mulNr. + by apply: expR_ge1Dx. + rewrite !lnK ?posrE ?subr_gt0//. + rewrite -addrAC subrr sub0r -mulrA [X in (_ / X)%R]expRM lnK ?posrE ?subr_gt0//. + rewrite -[in leRHS]powR_inv1 ?powR_ge0// powRM// ?expR_ge0 ?invr_ge0 ?powR_ge0//. + by rewrite powRAC powR_inv1 ?powR_ge0// powRrM expRM. +rewrite lee_fin. +rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. +- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). +- by rewrite divr_ge0 ?expR_ge0// powR_ge0. +- by rewrite expR_ge0. +- rewrite -ler_ln ?posrE ?divr_gt0 ?expR_gt0 ?powR_gt0 ?subr_gt0//. + rewrite expRK// ln_div ?posrE ?expR_gt0 ?powR_gt0 ?subr_gt0//. + rewrite expRK//. + rewrite /powR (*TODO: lemma ln of powR*) gt_eqF ?subr_gt0// expRK. + (* requires analytical argument: see p.66 of mu's book *) + Local Open Scope ring_scope. + rewrite -(@ler_pM2r _ 2)// -mulrA mulVf// mulr1 mulrDl. + rewrite -subr_le0 mulNr opprK. + rewrite addrC !addrA. + have->: delta ^+ 2 - delta * 2 = (1 - delta)^+2 - 1. + rewrite sqrrB expr1n mul1r [RHS]addrC !addrA addNr add0r addrC -mulNrn. + by rewrite -(mulr_natr (- delta) 2) mulNr. + rewrite addrAC subr_le0. + set f := fun (x : R) => x ^+ 2 + - (x * ln x) * 2. + have @idf (x : R^o) : 0 < x -> {df | is_derive x 1 (f : R^o -> R^o) df}. + move=> x0; evar (df : (R : Type)); exists df. + apply: is_deriveD; first by []. + apply: is_deriveM; last by []. + apply: is_deriveN. + apply: is_deriveM; first by []. + exact: is_derive1_ln. + suff: forall x : R, x \in `]0, 1[ -> f x <= 1. + by apply; rewrite memB_itv0 in_itv /= delta0 delta1. + move=> x x01. + have->: 1 = f 1 by rewrite /f expr1n ln1 mulr0 oppr0 mul0r addr0. + apply: (@ger0_derive1_homo _ f 0 1 false false)=> //. + - move=> t /[!in_itv] /= /andP [] + _. + by case/idf=> ? /@ex_derive. + - move=> t /[!in_itv] /= /andP [] t0 t1. + Local Arguments derive_val {R V W a v f df}. + rewrite (derive_val (svalP (idf _ t0))) /=. + clear idf. + rewrite exp_derive derive_cst derive_id . + rewrite scaler0 add0r /GRing.scale /= !mulr1 expr1. + rewrite -mulrDr mulr_ge0// divff ?lt0r_neq0//. + rewrite opprD addrA subr_ge0 -ler_expR. + have:= t0; rewrite -lnK_eq => /eqP ->. + by rewrite -[leLHS]addr0 -(subrr 1) addrCA expR_ge1Dx. + - apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _. + by case/idf=> ? /@ex_derive. + - by apply: (subset_itvW_bound _ _ x01); rewrite bnd_simp. + - by rewrite in_itv /= ltr01 lexx. + - by move: x01; rewrite in_itv=> /= /andP [] _ /ltW. +Qed. +Local Open Scope ereal_scope. + +(* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) +Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : R) : + is_bernoulli_trial X -> (0 < delta < 1)%R -> + (0 < n)%nat -> + (0 < p)%R -> + let X' := @bernoulli_trial n X in + let mu := 'E_(\X_n P)[X'] in + (\X_n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= + (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. +Proof. +move=> bX /andP[d0 d1] n0 p0 /=. +set X' := @bernoulli_trial n X. +set mu := 'E_(\X_n P)[X']. +under eq_set => x. + rewrite ler_normr. + rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. + rewrite -lerBDr -(lerN2 (- _)%R) opprK opprB. + rewrite -{2}(mul1r (fine mu)) -mulrBl. + rewrite -!lee_fin. + over. +rewrite /=. +rewrite set_orb. +rewrite measureU; last 3 first. +- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. + apply: emeasurable_fun_le => //. + apply: measurableT_comp => //. +- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. + apply: emeasurable_fun_le => //. + apply: measurableT_comp => //. +- rewrite disjoints_subset => x /=. + rewrite /mem /in_mem/= => X0; apply/negP. + rewrite -ltNge. + apply: (@lt_le_trans _ _ _ _ _ _ X0). + rewrite !EFinM. + rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. + by rewrite fineK /mu/X' (expectation_bernoulli_trial bX)// lte_fin mulr_gt0 ?ltr0n. +rewrite mulr2n EFinD leeD//=. +- by apply: (bernoulli_trial_inequality2 bX); rewrite //d0 d1. +- have d01 : (0 < delta < 1)%R by rewrite d0. + apply: (le_trans (@bernoulli_trial_inequality3 _ X delta bX d01)). + rewrite lee_fin ler_expR !mulNr lerN2. + rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. + rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. + rewrite /mu unlock /expectation integral_ge0// => x _. + by rewrite /X' lee_fin; apply: (bernoulli_trial_ge0 bX). +Qed. + +(* Rajani thm 3.1 / mu-book thm 4.7 *) +Theorem sampling n (X : n.-tuple {RV P >-> bool}) (theta delta : R) : + let X_sum := bernoulli_trial X in + let X' x := (X_sum x) / n%:R in + (0 < p)%R -> + is_bernoulli_trial X -> + (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> + (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> + (\X_n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. +Proof. +move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. +have E_X_sum: 'E_(\X_n P)[X_sum] = (p * n%:R)%:E. + by rewrite /X_sum expectation_bernoulli_trial// mulrC. +have /andP[_ p1] := p01. +set epsilon := theta / p. +have epsilon01 : (0 < epsilon < 1)%R. + by rewrite /epsilon ?ltr_pdivrMr ?divr_gt0 ?mul1r. +have thetaE : theta = (epsilon * p)%R. + by rewrite /epsilon -mulrA mulVf ?mulr1// gt_eqF. +have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= + ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. + rewrite [X in (\X_n P) X <= _](_ : _ = + [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. + apply/seteqP; split => [t|t]/=. + move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. + rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R)// -normrM mulrBl. + by rewrite -mulrA mulVf ?mulr1// gt_eqF ?ltr0n. + move/(@ler_wpM2r _ n%:R^-1); rewrite invr_ge0// ler0n => /(_ erefl). + rewrite -(mulrA _ _ n%:R^-1) divff ?mulr1 ?gt_eqF ?ltr0n//. + move=> /le_trans; apply. + rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R^-1)// -normrM mulrBl. + by rewrite -mulrA divff ?mulr1// gt_eqF// ltr0n. + rewrite -mulrA. + have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. + rewrite -E_X_sum. + exact: (@bernoulli_trial_inequality4 _ X epsilon bX). +have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= + ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. + rewrite thetaE; move/le_trans : step1; apply. + rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. + rewrite -2![in leRHS]mulrA [in leRHS]mulrCA. + rewrite /epsilon -mulrA mulVf ?gt_eqF// mulr1 -!mulrA !ler_wpM2l ?(ltW theta0)//. + rewrite mulrCA ler_wpM2l ?(ltW theta0)//. + rewrite [X in (_ * X)%R]mulrA mulVf ?gt_eqF// -[leLHS]mul1r [in leRHS]mul1r. + by rewrite ler_wpM2r// invf_ge1. +suff : delta%:E >= (\X_n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. + rewrite [X in (\X_n P) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. + apply/seteqP; split => [t|t]/=. + by rewrite leNgt => /negP. + by rewrite ltNge => /negP/negPn. + have ? : measurable [set i | (`|X' i - p| < theta)%R]. + under eq_set => x do rewrite -lte_fin. + rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. + by apply: emeasurable_fun_lt => //; apply: measurableT_comp => //; + apply: measurableT_comp => //; apply: measurable_funD => //; + apply: measurable_funM. + rewrite probability_setC// lee_subel_addr//. + rewrite -lee_subel_addl//; last by rewrite fin_num_measure. + move=> /le_trans; apply. + rewrite le_measure ?inE//. + under eq_set => x do rewrite -lee_fin. + rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. + by apply: emeasurable_fun_le => //; apply: measurableT_comp => //; + apply: measurableT_comp => //; apply: measurable_funD => //; + apply: measurable_funM. + by move=> t/= /ltW. +(* NB: last step in the pdf *) +apply: (le_trans step2). +rewrite lee_fin -(mulr_natr _ 2) -ler_pdivlMr//. +rewrite -(@lnK _ (delta / 2)); last by rewrite posrE divr_gt0. +rewrite ler_expR mulNr lerNl -lnV; last by rewrite posrE divr_gt0. +rewrite invf_div ler_pdivlMr// mulrC. +rewrite -ler_pdivrMr; last by rewrite exprn_gt0. +by rewrite mulrAC. +Qed. + +End bernoulli. From dcef898bec4f89f3ce64661c66317bbeaec88e50 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Mon, 17 Mar 2025 12:20:55 +0900 Subject: [PATCH 59/73] introduced type bernoulliRV --- theories/sampling.v | 159 +++++++++++++++++++++----------------------- 1 file changed, 76 insertions(+), 83 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 682c7ff4de..c03ebac643 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1154,6 +1154,18 @@ Qed. End properties_of_independence. + +HB.about isMeasurableFun. +HB.mixin Record RV_isBernoulli d (T : measurableType d) (R : realType) + (P : probability T R) (p : R) (X : T -> bool) of @isMeasurableFun d _ T bool X := { + bernoulliP : distribution P X = bernoulli p }. + +#[short(type=bernoulliRV)] +HB.structure Definition BernoulliRV d (T : measurableType d) (R : realType) + (P : probability T R) (p : R) := + {X of @RV_isBernoulli _ _ _ P p X}. +Arguments bernoulliRV {d T R}. + Section bernoulli. Local Open Scope ereal_scope. @@ -1162,13 +1174,10 @@ Context d (T : measurableType d) (P : probability T R). Variable p : R. Hypothesis p01 : (0 <= p <= 1)%R. -Definition bernoulli_RV (X : {RV P >-> bool}) := - distribution P X = bernoulli p. - -Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> +Lemma bernoulli_RV1 (X : bernoulliRV P p) : P [set i | X i == 1%R] = p%:E. Proof. -move=> /(congr1 (fun f => f [set 1%:R])). +have/(congr1 (fun f => f [set 1%:R])):= @bernoulliP _ _ _ _ _ X. rewrite bernoulliE//. rewrite /mscale/=. rewrite diracE/= mem_set// mule1// diracE/= memNset//. @@ -1179,10 +1188,10 @@ rewrite /preimage/=. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. -Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> +Lemma bernoulli_RV2 (X : bernoulliRV P p) : P [set i | X i == 0%R] = (`1-p)%:E. Proof. -move=> /(congr1 (fun f => f [set 0%:R])). +have/(congr1 (fun f => f [set 0%:R])):= @bernoulliP _ _ _ _ _ X. rewrite bernoulliE//. rewrite /mscale/=. rewrite diracE/= memNset//. @@ -1193,24 +1202,22 @@ rewrite /preimage/=. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. -Lemma bernoulli_expectation (X : {RV P >-> bool}) : - bernoulli_RV X -> 'E_P[btr P X] = p%:E. +Lemma bernoulli_expectation (X : bernoulliRV P p) : + 'E_P[btr P X] = p%:E. Proof. -move=> bX. rewrite unlock /btr. rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. by move=> y //=. rewrite /bernoulli/=. rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. - by move=> A mA _/=; rewrite (_ : distribution P X = bernoulli p). + by move=> A mA _ /=; congr (_ _); exact: bernoulliP. rewrite integral_bernoulli//=. by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. Qed. -Lemma integrable_bernoulli (X : {RV P >-> bool}) : - bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). +Lemma integrable_bernoulli (X : bernoulliRV P p) : + P.-integrable [set: T] (EFin \o btr P X). Proof. -move=> bX. apply/integrableP; split. by apply: measurableT_comp => //; exact: measurable_bool_to_real. have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. @@ -1220,7 +1227,7 @@ have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. by rewrite bernoulli_expectation// ltry. Qed. -Lemma bool_RV_sqr (X : {dRV P >-> bool}) : +Lemma bool_RV_sqr (X : {RV P >-> bool}) : ((btr P X ^+ 2) = btr P X :> (T -> R))%R. Proof. apply: funext => x /=. @@ -1228,23 +1235,18 @@ rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. by case: (X x) => /=; rewrite ?mulr1 ?mulr0. Qed. -Lemma bernoulli_variance (X : {dRV P >-> bool}) : - bernoulli_RV X -> 'V_P[btr P X] = (p * (`1-p))%:E. +Lemma bernoulli_variance (X : bernoulliRV P p) : + 'V_P[btr P X] = (p * (`1-p))%:E. Proof. -move=> b. rewrite (@varianceE _ _ _ _ (btr P X)); [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. by rewrite expe2 -EFinD onemMr. Qed. -(* TODO: define a mixin *) -Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := - (forall i : 'I_n, bernoulli_RV (tnth X i)). - -Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R : realType} := +Definition bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : {RV (\X_n P) >-> R : realType} := tuple_sum [the n.-tuple _ of (map (btr P) - (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. + (map (fun t : bernoulliRV P p => t : {mfun T >-> bool}) X))]. (* was wrong @@ -1252,39 +1254,36 @@ Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} : (\sum_(i-> bool}) : - is_bernoulli_trial X -> 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. +Lemma btr_ge0 (X : {RV P >-> bool}) t : (0 <= btr P X t)%R. +Proof. by []. Qed. + +Lemma btr_le1 (X : {RV P >-> bool}) t : (btr P X t <= 1)%R. +Proof. by rewrite /btr/=/bool_to_real/=; case: (X t). Qed. + +Lemma expectation_bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : + 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. Proof. -move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(\X_n P)[tuple_sum (map (btr P) X)]). - congr expectation; apply/funext => t. - by apply: eq_bigr => /= i _; rewrite !tnth_map. +rewrite /bernoulli_trial. rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. - move=> i t. - rewrite tnth_map//. - rewrite /btr/= /bool_to_real/=. - by case: (tnth X i t) => /=; rewrite !lexx !ler01. + by move=> i t; rewrite tnth_map// btr_ge0 btr_le1. transitivity (\sum_(i < n) p%:E). - apply: eq_bigr => k _. - rewrite tnth_map bernoulli_expectation//. + by apply: eq_bigr => k _; rewrite !tnth_map bernoulli_expectation. by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. Qed. -Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> +Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) : (forall t, 0 <= bernoulli_trial X t)%R. Proof. -move=> bRV t. +move=> t. rewrite /bernoulli_trial. apply/sumr_ge0 => /= i _. by rewrite !tnth_map. Qed. -Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : - is_bernoulli_trial X_ -> +Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : let X := bernoulli_trial X_ in 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. -move=> bRVX/=. pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* btr P (tnth X_ i). transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. congr expectation => /=; apply: funext => x/=. @@ -1316,10 +1315,10 @@ Qed. Arguments sub_countable [T U]. Arguments card_le_finite [T U]. -Lemma bernoulli_mmt_gen_fun (X : {RV P >-> bool}) (t : R) : - bernoulli_RV X -> 'M_(btr P X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. +Lemma bernoulli_mmt_gen_fun (X : bernoulliRV P p) (t : R) : + 'M_(btr P X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. Proof. -move=> bX. rewrite/mmt_gen_fun. +rewrite/mmt_gen_fun. pose mmtX : {RV P >-> R : realType} := expR \o t \o* (btr P X). set A := X @^-1` [set true]. set B := X @^-1` [set false]. @@ -1344,16 +1343,15 @@ under eq_integral. rewrite integral_cst//. rewrite /A /B /preimage /=. under eq_set do rewrite (propext (rwP eqP)). -rewrite (bernoulli_RV1 bX). +rewrite bernoulli_RV1. under eq_set do rewrite (propext (rwP eqP)). -rewrite (bernoulli_RV2 bX). +rewrite bernoulli_RV2. rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. by rewrite expR0 mulr1. Qed. (* wrong lemma *) -Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : - is_bernoulli_trial X_ -> +Lemma binomial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in 'M_X t = ((p * expR t + (1 - p))`^(n%:R))%:E. Proof. @@ -1364,13 +1362,12 @@ rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. Qed. -Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : +Lemma mmt_gen_fun_expectation n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : (0 <= t)%R -> - is_bernoulli_trial X_ -> let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. Proof. -move=> t_ge0 bX/=. +move=> t_ge0/=. have /andP[p0 p1] := p01. rewrite binomial_mmt_gen_fun// lee_fin. rewrite expectation_bernoulli_trial//. @@ -1380,8 +1377,7 @@ rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. exact: expR_ge1Dx. Qed. -Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : - is_bernoulli_trial X_ -> +Lemma end_thm24 n (X_ : n.-tuple (bernoulliRV P p)) (t delta : R) : (0 < delta)%R -> let X := @bernoulli_trial n X_ in let mu := 'E_(\X_n P)[X] in @@ -1390,9 +1386,9 @@ Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : (expR (- t * (1 + delta)) `^ fine mu)%:E <= ((expR delta / (1 + delta) `^ (1 + delta)) `^ fine mu)%:E. Proof. -move=> bX d0 /=. +move=> d0 /=. rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. -- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). +- by rewrite fine_ge0// expectation_ge0// => x; exact: bernoulli_trial_ge0. - by rewrite mulr_ge0// expR_ge0. - by rewrite divr_ge0 ?expR_ge0// powR_ge0. - rewrite lnK ?posrE ?addr_gt0// addrAC subrr add0r ler_wpM2l ?expR_ge0//. @@ -1400,15 +1396,14 @@ rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. Qed. (* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) -Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X_ -> +Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta)%R -> let X := @bernoulli_trial n X_ in let mu := 'E_(\X_n P)[X] in (\X_n P) [set i | X i >= (1 + delta) * fine mu]%R <= ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. Proof. -rewrite /= => bX delta0. +rewrite /= => delta0. set X := @bernoulli_trial n X_. set mu := 'E_(\X_n P)[X]. set t := ln (1 + delta). @@ -1417,14 +1412,13 @@ apply: (le_trans (chernoff _ _ t0)). apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * (expR (- (t * ((1 + delta) * fine mu))))%:E)). rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - by apply: (mmt_gen_fun_expectation _ bX); rewrite ltW. + by apply: mmt_gen_fun_expectation; rewrite ltW. rewrite mulrC expRM -mulNr mulrA expRM. -exact: (end_thm24 _ bX). +exact: end_thm24. Qed. (* theorem 2.5 *) -Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X -> +Theorem bernoulli_trial_inequality2 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : let X' := @bernoulli_trial n X in let mu := 'E_(\X_n P)[X'] in (0 < n)%nat -> @@ -1432,13 +1426,13 @@ Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) (\X_n P) [set i | X' i >= (1 + delta) * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3))%:E. Proof. -move=> bX X' mu n0 /[dup] delta01 /andP[delta0 _]. +move=> X' mu n0 /[dup] delta01 /andP[delta0 _]. apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. - apply: (bernoulli_trial_inequality1 bX) => //. + exact: bernoulli_trial_inequality1. apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). rewrite lee_fin ler_expR ler_wpM2r//. - by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: (bernoulli_trial_ge0 bX). + by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: bernoulli_trial_ge0. rewrite lerB//. apply: taylor_ln_le. by rewrite in_itv /=. @@ -1451,13 +1445,13 @@ Lemma norm_expR : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) -Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X -> (0 < delta < 1)%R -> +Theorem bernoulli_trial_inequality3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : + (0 < delta < 1)%R -> let X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType} in let mu := 'E_(\X_n P)[X'] in (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. Proof. -move=> bX /andP[delta0 delta1] /=. +move=> /andP[delta0 delta1] /=. set X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType}. set mu := 'E_(\X_n P)[X']. have /andP[p0 p1] := p01. @@ -1480,12 +1474,12 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine - by apply: expR_gt0. - rewrite norm_expR. have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. - by rewrite (binomial_mmt_gen_fun _ bX)//. + by rewrite binomial_mmt_gen_fun. apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. - rewrite (binomial_mmt_gen_fun _ bX)/=. - rewrite /mu /X' (expectation_bernoulli_trial bX)/=. + rewrite binomial_mmt_gen_fun. + rewrite /mu /X' expectation_bernoulli_trial. rewrite !lnK ?posrE ?subr_gt0//. rewrite expRM powRrM powRAC. rewrite ge0_ler_powR ?ler0n// ?nnegrE ?powR_ge0//. @@ -1499,7 +1493,7 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine by rewrite powRAC powR_inv1 ?powR_ge0// powRrM expRM. rewrite lee_fin. rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. -- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). +- by rewrite fine_ge0// expectation_ge0// => x; exact: bernoulli_trial_ge0. - by rewrite divr_ge0 ?expR_ge0// powR_ge0. - by rewrite expR_ge0. - rewrite -ler_ln ?posrE ?divr_gt0 ?expR_gt0 ?powR_gt0 ?subr_gt0//. @@ -1549,8 +1543,8 @@ Qed. Local Open Scope ereal_scope. (* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) -Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X -> (0 < delta < 1)%R -> +Corollary bernoulli_trial_inequality4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : + (0 < delta < 1)%R -> (0 < n)%nat -> (0 < p)%R -> let X' := @bernoulli_trial n X in @@ -1558,7 +1552,7 @@ Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : (\X_n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. Proof. -move=> bX /andP[d0 d1] n0 p0 /=. +move=> /andP[d0 d1] n0 p0 /=. set X' := @bernoulli_trial n X. set mu := 'E_(\X_n P)[X']. under eq_set => x. @@ -1583,29 +1577,28 @@ rewrite measureU; last 3 first. apply: (@lt_le_trans _ _ _ _ _ _ X0). rewrite !EFinM. rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. - by rewrite fineK /mu/X' (expectation_bernoulli_trial bX)// lte_fin mulr_gt0 ?ltr0n. + by rewrite fineK /mu/X' expectation_bernoulli_trial// lte_fin mulr_gt0 ?ltr0n. rewrite mulr2n EFinD leeD//=. -- by apply: (bernoulli_trial_inequality2 bX); rewrite //d0 d1. +- by apply: bernoulli_trial_inequality2; rewrite //d0 d1. - have d01 : (0 < delta < 1)%R by rewrite d0. - apply: (le_trans (@bernoulli_trial_inequality3 _ X delta bX d01)). + apply: (le_trans (@bernoulli_trial_inequality3 _ X delta d01)). rewrite lee_fin ler_expR !mulNr lerN2. rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. rewrite /mu unlock /expectation integral_ge0// => x _. - by rewrite /X' lee_fin; apply: (bernoulli_trial_ge0 bX). + by rewrite /X' lee_fin; exact: bernoulli_trial_ge0. Qed. (* Rajani thm 3.1 / mu-book thm 4.7 *) -Theorem sampling n (X : n.-tuple {RV P >-> bool}) (theta delta : R) : +Theorem sampling n (X : n.-tuple (bernoulliRV P p)) (theta delta : R) : let X_sum := bernoulli_trial X in let X' x := (X_sum x) / n%:R in (0 < p)%R -> - is_bernoulli_trial X -> (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> (\X_n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. Proof. -move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. +move=> X_sum X' p0 /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. have E_X_sum: 'E_(\X_n P)[X_sum] = (p * n%:R)%:E. by rewrite /X_sum expectation_bernoulli_trial// mulrC. have /andP[_ p1] := p01. @@ -1630,7 +1623,7 @@ have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -E_X_sum. - exact: (@bernoulli_trial_inequality4 _ X epsilon bX). + exact: (@bernoulli_trial_inequality4 _ X epsilon). have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. From 8060dc983cb5a8dfa1c2d28b0a9291a664487bcc Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 17 Mar 2025 12:22:49 +0900 Subject: [PATCH 60/73] rm tuple_sum, tuple_prod --- theories/sampling.v | 158 ++++++++++++++++++++++++++++++-------------- 1 file changed, 109 insertions(+), 49 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index c03ebac643..b18cdd6095 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -92,23 +92,31 @@ Lemma prodr_map {R : realType} U d (T : measurableType d) (l : seq U) Q (\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x. Proof. by elim/big_ind2 : _ => //= _ h _ g <- <-. Qed. +Definition sumrfct_tuple {R : realType} d {T : measurableType d} + n (s : n.-tuple {mfun T >-> R}) : T -> R := + \sum_(f <- s) f. + +Lemma measurable_sumrfct_tuple {R : realType} d {T : measurableType d} + n (s : n.-tuple {mfun T >-> R}) : + measurable_fun setT (sumrfct_tuple s). +Proof. by apply/measurable_EFinP => /=; exact/measurableT_comp. Qed. + +HB.instance Definition _ {R : realType} d {T : measurableType d} + n (s : n.-tuple {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (sumrfct_tuple s) (measurable_sumrfct_tuple s). + Definition sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : T -> R := - fun x => \sum_(f <- s) f x. + \sum_(f <- s) f. Lemma measurable_sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : measurable_fun setT (sumrfct s). Proof. -apply/measurable_EFinP => /=; apply/measurableT_comp => //. -exact: measurable_sum. +by apply/measurable_EFinP => /=; apply/measurableT_comp => //. Qed. HB.instance Definition _ {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) := isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). -Lemma sum_mfunE {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) x : - ((\sum_(f <- s) f) x = sumrfct s x)%R. -Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. - End move. Section move_to_bigop_nat_lemmas. @@ -810,34 +818,55 @@ Qed. End taylor_ln_le. +(* TODO: move to functions. *) +Lemma fct_prodE (I : Type) (T : pointedType) (M : comRingType) r (P : {pred I}) (f : I -> T -> M) + (x : T) : + (\prod_(i <- r | P i) f i) x = \prod_(i <- r | P i) f i x. +Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. + +HB.instance Definition _ (n : nat) := isPointed.Build 'I_n.+1 ord0. + +HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_display + 'I_n.+1 discrete_measurable discrete_measurable0 + discrete_measurableC discrete_measurableU. + Section tuple_sum. Context d (T : measurableType d) (R : realType) (P : probability T R). -Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := - (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. +Definition Tnth n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) : mtuple n T -> R := + fun t => (tnth X i) (tnth t i). + +Lemma measurable_Tnth n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) : + measurable_fun [set: mtuple n T] (Tnth X i). +Proof. by apply: measurableT_comp => //; exact: measurable_tnth. Qed. -Lemma measurable_tuple_sum n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (tuple_sum s). +HB.instance Definition _ n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) := + isMeasurableFun.Build _ _ _ _ (Tnth X i) (measurable_Tnth X i). + +Lemma measurable_tuple_sum n (X : n.-tuple {mfun T >-> R}) : + measurable_fun setT (\sum_(i < n) Tnth X i)%R. Proof. +rewrite [X in measurable_fun _ X](_ : _ + = (fun x => \sum_(i < n) Tnth X i x)); last first. + by apply/funext => x; rewrite fct_sumE. apply: measurable_sum => i/=; apply/measurableT_comp => //. exact: measurable_tnth. Qed. HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (tuple_sum s) (measurable_tuple_sum s). - -Definition tuple_prod n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := - (fun x => \prod_(i < n) (tnth s i) (tnth x i))%R. + isMeasurableFun.Build _ _ _ _ (\sum_(i < n) Tnth s i)%R (measurable_tuple_sum s). -Lemma measurable_tuple_prod n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (tuple_prod s). +Lemma measurable_tuple_prod m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) : + measurable_fun setT (\prod_(i < n) Tnth s (f i))%R. Proof. -apply: measurable_prod => /= i _; apply/measurableT_comp => //. -exact: measurable_tnth. +rewrite [X in measurable_fun _ X](_ : _ + = (fun x => \prod_(i < n) Tnth s (f i) x)); last first. + by apply/funext => x; rewrite fct_prodE. +by apply: measurable_prod => /= i _; apply/measurableT_comp => //. Qed. -HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (tuple_prod s) (measurable_tuple_prod s). +HB.instance Definition _ m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) := + isMeasurableFun.Build _ _ _ _ (\prod_(i < n) Tnth s (f i))%R (measurable_tuple_prod s f). End tuple_sum. @@ -847,12 +876,10 @@ Local Open Scope ereal_scope. Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) M : (forall i t, (0 <= tnth X i t <= M)%R) -> - 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). + 'E_(\X_n P)[\sum_(i < n) Tnth X i] = \sum_(i < n) ('E_P[(tnth X i)]). Proof. elim: n X => [X|n IH X] /= XM. - rewrite /tuple_sum. - under eq_fun do rewrite big_ord0. - by rewrite big_ord0 expectation_cst. + by rewrite !big_ord0 expectation_cst. pose X0 := thead X. have intX0 : P.-integrable [set: T] (EFin \o X0). apply: (bounded_RV_integrable M) => // t. @@ -863,8 +890,7 @@ have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). rewrite XiXi. exact: XM. rewrite big_ord_recl/=. -rewrite /tuple_sum/=. -under eq_fun do rewrite big_ord_recl/=. +rewrite big_ord_recl/=. pose X1 (x : mtuple n.+1 T) := (\sum_(i < n) (tnth X (lift ord0 i)) (tnth x (lift ord0 i)))%R. have mX1 : measurable_fun setT X1. @@ -878,7 +904,12 @@ rewrite /X2 /=. by apply: measurableT_comp => //; exact: measurable_tnth. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. -rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. +rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1); last first. + rewrite /Y2 /Y1/=. + rewrite /X2 /X1/=. + apply/funext => t. + rewrite !fctE. + by rewrite fct_sumE. rewrite expectationD; last 2 first. apply: (bounded_RV_integrable M) => // t. exact: XM. @@ -975,7 +1006,9 @@ congr (_ + _). congr (tnth X _ _)%:E. apply/val_inj => /=. by rewrite inordK// ltnS. - by []. + congr expectation. + apply/funext => t. + by rewrite fct_sumE. Qed. Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) @@ -1048,23 +1081,31 @@ Qed. Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : (forall i t, (0 <= tnth X i t <= M)%R) -> (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. + 'E_(\X_n P)[ \prod_(i < n) Tnth X i] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. elim: n X => [X|n IH X] /= boundedX intX. - rewrite /tuple_prod. - under eq_fun do rewrite big_ord0. - by rewrite big_ord0 expectation_cst. -rewrite big_ord_recl/=. + by rewrite !big_ord0 expectation_cst. rewrite unlock /expectation integral_mpro /pro2; last first. - apply: (bounded_RV_integrable (M^+n.+1)%R) => // t. - rewrite /tuple_prod. - apply/andP. split. + apply: (bounded_RV_integrable (M^+n.+1)%R) => //. + exact: measurable_tuple_prod. + move=> t; apply/andP; split. + rewrite fct_prodE. rewrite prodr_ge0//= => i _. by have /andP[] := boundedX i (tnth t i). rewrite -[in leRHS](subn0 n.+1) -prodr_const_nat. - by rewrite big_mkord ler_prod. -rewrite /tuple_prod/=. -under eq_fun => x do (rewrite big_ord_recl/= tnth0; under eq_bigr => i do rewrite tnthS). + rewrite fct_prodE big_mkord. + by rewrite ler_prod// => i _; exact: boundedX. +under eq_fun. + move=> x. + rewrite big_ord_recl/=. + rewrite /Tnth/= fctE tnth0. + rewrite fct_prodE. + under eq_bigr. + move=> i _. + rewrite tnthS. + over. + over. +rewrite /=. rewrite -fubini1' /fubini_F/=; last first. apply: measurable_bounded_integrable => //=. - rewrite /product_measure1/=. @@ -1104,6 +1145,7 @@ under eq_fun => x. rewrite integralZl//= -[X in _*X]fineK ?integral_fune_fin_num//=. over. rewrite integralZr//; last by rewrite intX// (tuple_eta X) tnth0 mem_head. +rewrite big_ord_recl/=. congr (_ * _). rewrite fineK ?integral_fune_fin_num//=. under eq_fun => x. @@ -1112,8 +1154,10 @@ under eq_fun => x. over. over. simpl. -rewrite [LHS](_ : _ = 'E_(\X_n P)[ tuple_prod (behead_tuple X) ]); last first. - by rewrite [in RHS]unlock /expectation [in RHS]/tuple_prod. +rewrite [LHS](_ : _ = 'E_(\X_n P)[ \prod_(i < n) Tnth (behead_tuple X) i]); last first. + rewrite [in RHS]unlock /expectation. + apply: eq_integral => t _; congr EFin. + by rewrite fct_prodE. rewrite IH; last 2 first. - by move=> i t; rewrite tnth_behead. - by move=> Xi XiX; apply: intX; rewrite mem_behead. @@ -1245,8 +1289,8 @@ by rewrite expe2 -EFinD onemMr. Qed. Definition bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : {RV (\X_n P) >-> R : realType} := - tuple_sum [the n.-tuple _ of (map (btr P) - (map (fun t : bernoulliRV P p => t : {mfun T >-> bool}) X))]. + (\sum_(i < n) Tnth [the n.-tuple _ of (map (btr P) + (map (fun t : bernoulliRV P p => t : {mfun T >-> bool}) X))] i)%R. (* was wrong @@ -1264,6 +1308,15 @@ Lemma expectation_bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. Proof. rewrite /bernoulli_trial. +(*======= +move=> bRV. rewrite /bernoulli_trial. +transitivity ('E_(\X_n P)[\sum_(i < n) Tnth (map (btr P) X) i]). + congr expectation; apply/funext => t. + rewrite /Tnth/=. + rewrite !fct_sumE/=. + apply: eq_bigr => /= i _. + by rewrite /Tnth !tnth_map. +>>>>>>> 8b8db025 (rm tuple_sum)*) rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. by move=> i t; rewrite tnth_map// btr_ge0 btr_le1. transitivity (\sum_(i < n) p%:E). @@ -1276,7 +1329,9 @@ Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) : Proof. move=> t. rewrite /bernoulli_trial. +rewrite [leRHS]fct_sumE. apply/sumr_ge0 => /= i _. +rewrite /Tnth. by rewrite !tnth_map. Qed. @@ -1285,10 +1340,13 @@ Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. Proof. pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* btr P (tnth X_ i). -transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. +transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ])%R. congr expectation => /=; apply: funext => x/=. - rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. - by rewrite !tnth_map /mmtX/= tnth_ord_tuple. + rewrite fct_sumE. + rewrite big_distrl/= expR_sum. + rewrite [in RHS]fct_prodE. + apply: eq_bigr => i _. + by rewrite /Tnth !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. - move=> i ?. @@ -1567,10 +1625,12 @@ rewrite set_orb. rewrite measureU; last 3 first. - rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. apply: emeasurable_fun_le => //. - apply: measurableT_comp => //. + apply/measurable_EFinP. + exact: measurableT_comp. - rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. apply: emeasurable_fun_le => //. - apply: measurableT_comp => //. + apply/measurable_EFinP. + exact: measurableT_comp. - rewrite disjoints_subset => x /=. rewrite /mem /in_mem/= => X0; apply/negP. rewrite -ltNge. From 6cd952446378c373e18c91635ff2786469d726b9 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 17 Mar 2025 14:30:03 +0900 Subject: [PATCH 61/73] bernoulli_trial -> bool_trial_value --- theories/sampling.v | 91 ++++++++++++++++++++++----------------------- 1 file changed, 45 insertions(+), 46 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index b18cdd6095..f0756a1eeb 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -66,7 +66,9 @@ HB.instance Definition _ := HB.instance Definition _ := MeasurableFun.on bool_to_real. -Definition btr : {RV P >-> R} := bool_to_real. +(*Definition btr : {RV P >-> R} := bool_to_real. + +HB.instance Definition _ := MeasurableFun.on btr.*) End bool_to_real. @@ -1198,8 +1200,6 @@ Qed. End properties_of_independence. - -HB.about isMeasurableFun. HB.mixin Record RV_isBernoulli d (T : measurableType d) (R : realType) (P : probability T R) (p : R) (X : T -> bool) of @isMeasurableFun d _ T bool X := { bernoulliP : distribution P X = bernoulli p }. @@ -1247,9 +1247,9 @@ by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. Lemma bernoulli_expectation (X : bernoulliRV P p) : - 'E_P[btr P X] = p%:E. + 'E_P[bool_to_real R X] = p%:E. Proof. -rewrite unlock /btr. +rewrite unlock. rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. by move=> y //=. rewrite /bernoulli/=. @@ -1260,11 +1260,11 @@ by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. Qed. Lemma integrable_bernoulli (X : bernoulliRV P p) : - P.-integrable [set: T] (EFin \o btr P X). + P.-integrable [set: T] (EFin \o bool_to_real R X). Proof. apply/integrableP; split. by apply: measurableT_comp => //; exact: measurable_bool_to_real. -have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. +have -> : \int[P]_x `|(EFin \o bool_to_real R X) x| = 'E_P[bool_to_real R X]. rewrite unlock /expectation. apply: eq_integral => x _. by rewrite gee0_abs //= lee_fin. @@ -1272,45 +1272,48 @@ by rewrite bernoulli_expectation// ltry. Qed. Lemma bool_RV_sqr (X : {RV P >-> bool}) : - ((btr P X ^+ 2) = btr P X :> (T -> R))%R. + ((bool_to_real R X ^+ 2) = bool_to_real R X :> (T -> R))%R. Proof. apply: funext => x /=. -rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. +rewrite /GRing.exp /bool_to_real /GRing.mul/=. by case: (X x) => /=; rewrite ?mulr1 ?mulr0. Qed. Lemma bernoulli_variance (X : bernoulliRV P p) : - 'V_P[btr P X] = (p * (`1-p))%:E. + 'V_P[bool_to_real R X] = (p * (`1-p))%:E. Proof. -rewrite (@varianceE _ _ _ _ (btr P X)); +rewrite (@varianceE _ _ _ _ (bool_to_real R X)); [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. by rewrite expe2 -EFinD onemMr. Qed. -Definition bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : {RV (\X_n P) >-> R : realType} := - (\sum_(i < n) Tnth [the n.-tuple _ of (map (btr P) - (map (fun t : bernoulliRV P p => t : {mfun T >-> bool}) X))] i)%R. +Definition real_of_bool n : _ -> n.-tuple _ := + map_tuple (bool_to_real R : bernoulliRV P p -> {mfun _ >-> _}). + +Definition trial_value n (X : n.-tuple {RV P >-> _}) : {RV (\X_n P) >-> R : realType} := + (\sum_(i < n) Tnth X i)%R. + +Definition bool_trial_value n := @trial_value n \o @real_of_bool n. (* was wrong Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := - (\sum_(i-> bool}) t : (0 <= btr P X t)%R. +Lemma btr_ge0 (X : {RV P >-> bool}) t : (0 <= bool_to_real R X t)%R. Proof. by []. Qed. -Lemma btr_le1 (X : {RV P >-> bool}) t : (btr P X t <= 1)%R. -Proof. by rewrite /btr/=/bool_to_real/=; case: (X t). Qed. +Lemma btr_le1 (X : {RV P >-> bool}) t : (bool_to_real R X t <= 1)%R. +Proof. by rewrite /bool_to_real/=; case: (X t). Qed. Lemma expectation_bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : - 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. + 'E_(\X_n P)[bool_trial_value X] = (n%:R * p)%:E. Proof. -rewrite /bernoulli_trial. (*======= move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(\X_n P)[\sum_(i < n) Tnth (map (btr P) X) i]). +transitivity ('E_(\X_n P)[\sum_(i < n) Tnth (map (bool_to_real R) X) i]). congr expectation; apply/funext => t. rewrite /Tnth/=. rewrite !fct_sumE/=. @@ -1325,10 +1328,9 @@ by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. Qed. Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) : - (forall t, 0 <= bernoulli_trial X t)%R. + (forall t, 0 <= bool_trial_value X t)%R. Proof. move=> t. -rewrite /bernoulli_trial. rewrite [leRHS]fct_sumE. apply/sumr_ge0 => /= i _. rewrite /Tnth. @@ -1336,10 +1338,10 @@ by rewrite !tnth_map. Qed. Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : - let X := bernoulli_trial X_ in - 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. + let X := bool_trial_value X_ in + 'M_X t = \prod_(i < n) 'M_(bool_to_real R (tnth X_ i) : {RV P >-> _}) t. Proof. -pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* btr P (tnth X_ i). +pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* bool_to_real R (tnth X_ i). transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ])%R. congr expectation => /=; apply: funext => x/=. rewrite fct_sumE. @@ -1374,10 +1376,10 @@ Arguments sub_countable [T U]. Arguments card_le_finite [T U]. Lemma bernoulli_mmt_gen_fun (X : bernoulliRV P p) (t : R) : - 'M_(btr P X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. + 'M_(bool_to_real R X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. Proof. rewrite/mmt_gen_fun. -pose mmtX : {RV P >-> R : realType} := expR \o t \o* (btr P X). +pose mmtX : {RV P >-> R : realType} := expR \o t \o* (bool_to_real R X). set A := X @^-1` [set true]. set B := X @^-1` [set false]. have mA: measurable A by exact: measurable_sfunP. @@ -1410,7 +1412,7 @@ Qed. (* wrong lemma *) Lemma binomial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : - let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in + let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in 'M_X t = ((p * expR t + (1 - p))`^(n%:R))%:E. Proof. move: p01 => /andP[p0 p1] bX/=. @@ -1422,7 +1424,7 @@ Qed. Lemma mmt_gen_fun_expectation n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : (0 <= t)%R -> - let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in + let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. Proof. move=> t_ge0/=. @@ -1437,7 +1439,7 @@ Qed. Lemma end_thm24 n (X_ : n.-tuple (bernoulliRV P p)) (t delta : R) : (0 < delta)%R -> - let X := @bernoulli_trial n X_ in + let X := bool_trial_value X_ in let mu := 'E_(\X_n P)[X] in let t := ln (1 + delta) in (expR (expR t - 1) `^ fine mu)%:E * @@ -1456,13 +1458,13 @@ Qed. (* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta)%R -> - let X := @bernoulli_trial n X_ in + let X := bool_trial_value X_ in let mu := 'E_(\X_n P)[X] in (\X_n P) [set i | X i >= (1 + delta) * fine mu]%R <= ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. Proof. rewrite /= => delta0. -set X := @bernoulli_trial n X_. +set X := bool_trial_value X_. set mu := 'E_(\X_n P)[X]. set t := ln (1 + delta). have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. @@ -1477,7 +1479,7 @@ Qed. (* theorem 2.5 *) Theorem bernoulli_trial_inequality2 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : - let X' := @bernoulli_trial n X in + let X' := bool_trial_value X in let mu := 'E_(\X_n P)[X'] in (0 < n)%nat -> (0 < delta < 1)%R -> @@ -1505,12 +1507,12 @@ Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. (* Rajani thm 2.6 / mu-book thm 4.5.(2) *) Theorem bernoulli_trial_inequality3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> - let X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType} in + let X' := bool_trial_value X : {RV \X_n P >-> R : realType} in let mu := 'E_(\X_n P)[X'] in (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. Proof. move=> /andP[delta0 delta1] /=. -set X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType}. +set X' := bool_trial_value X : {RV \X_n P >-> R : realType}. set mu := 'E_(\X_n P)[X']. have /andP[p0 p1] := p01. apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). @@ -1605,13 +1607,13 @@ Corollary bernoulli_trial_inequality4 n (X : n.-tuple (bernoulliRV P p)) (delta (0 < delta < 1)%R -> (0 < n)%nat -> (0 < p)%R -> - let X' := @bernoulli_trial n X in + let X' := bool_trial_value X in let mu := 'E_(\X_n P)[X'] in (\X_n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. Proof. move=> /andP[d0 d1] n0 p0 /=. -set X' := @bernoulli_trial n X. +set X' := bool_trial_value X. set mu := 'E_(\X_n P)[X']. under eq_set => x. rewrite ler_normr. @@ -1651,16 +1653,13 @@ Qed. (* Rajani thm 3.1 / mu-book thm 4.7 *) Theorem sampling n (X : n.-tuple (bernoulliRV P p)) (theta delta : R) : - let X_sum := bernoulli_trial X in - let X' x := (X_sum x) / n%:R in + let X' x := (bool_trial_value X x) / n%:R in (0 < p)%R -> (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> (\X_n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. Proof. -move=> X_sum X' p0 /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. -have E_X_sum: 'E_(\X_n P)[X_sum] = (p * n%:R)%:E. - by rewrite /X_sum expectation_bernoulli_trial// mulrC. +move=> X' p0 /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. have /andP[_ p1] := p01. set epsilon := theta / p. have epsilon01 : (0 < epsilon < 1)%R. @@ -1670,11 +1669,11 @@ have thetaE : theta = (epsilon * p)%R. have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. rewrite [X in (\X_n P) X <= _](_ : _ = - [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. + [set i | `| bool_trial_value X i - p * n%:R | >= epsilon * p * n%:R]%R); last first. apply/seteqP; split => [t|t]/=. move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R)// -normrM mulrBl. - by rewrite -mulrA mulVf ?mulr1// gt_eqF ?ltr0n. + by rewrite -mulrA mulVf ?mulr1// ?gt_eqF ?ltr0n. move/(@ler_wpM2r _ n%:R^-1); rewrite invr_ge0// ler0n => /(_ erefl). rewrite -(mulrA _ _ n%:R^-1) divff ?mulr1 ?gt_eqF ?ltr0n//. move=> /le_trans; apply. @@ -1682,7 +1681,7 @@ have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= by rewrite -mulrA divff ?mulr1// gt_eqF// ltr0n. rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. - rewrite -E_X_sum. + rewrite -(mulrC _ p) -(expectation_bernoulli_trial X). exact: (@bernoulli_trial_inequality4 _ X epsilon). have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. From 72036d8b45f6cce7eb741674ebefb68574575985 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 17 Mar 2025 14:48:01 +0900 Subject: [PATCH 62/73] split the sampling theorem in two sections - no mtuple anymore --- theories/sampling.v | 1184 ++++++++++++++++++++----------------------- 1 file changed, 553 insertions(+), 631 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index f0756a1eeb..35d50455c1 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -8,7 +8,7 @@ From mathcomp Require Import (canonicals) Rstruct Rstruct_topology. From HB Require Import structures. From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. From mathcomp Require Import reals ereal interval_inference topology normedtype. -From mathcomp Require Import sequences realfun convex. +From mathcomp Require Import sequences realfun convex real_interval. From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral kernel probability. From mathcomp Require Import independence. @@ -18,7 +18,28 @@ Unset Strict Implicit. Unset Printing Implicit Defensive. (**md**************************************************************************) -(* This file contains the formalization of a sampling theorem *) +(* # A Sampling Theorem *) +(* *) +(* This file contains a formalization of a sampling theorem. The proof is *) +(* decompose in two sections: sampling_theorem_part1 and *) +(* sampling_theorem_part2. *) +(* *) +(* References: *) +(* - Samir Rajani. Applications of Chernoff bounds, 2019 *) +(* http://math.uchicago.edu/~may/REU2019/REUPapers/Rajani.pdf *) +(* - Michael Mitzenmacher and Eli Upfal. Probability and Computing—Randomized *) +(* Algorithms and Probabilistic Analysis. Cambridge University Press, 2005 *) +(* *) +(* 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 *) +(* Tnth == TODO *) +(* pro1 P Q == the probability measure P \x Q *) +(* P and Q are probability measures. *) +(* pro2 P Q == the probability measure P \x^ Q *) +(* P and Q are probability measures. *) +(* \X_n P == the product probability measure P \x P \x ... \x P *) (******************************************************************************) Import Order.TTheory GRing.Theory Num.Def Num.Theory. @@ -27,29 +48,6 @@ Import numFieldTopology.Exports numFieldNormedType.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -Section product_probability2. -Local Open Scope ereal_scope. -Lemma product_probability2_setT : - forall (d1 d2 : measure_display) (T1 : measurableType d1) - (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) - (P2 : probability T2 R), (P1 \x^ P2) setT = 1%E. -Proof. -move=> ? ? ? ? ? P1 P2. -rewrite -setXTT product_measure2E// -[RHS]mul1e. -congr mule. -all: rewrite -[LHS]fineK ?fin_num_measure//. -all: congr EFin=> /=. -all: by rewrite probability_setT. -Qed. - -HB.instance Definition _ (d1 d2 : measure_display) (T1 : measurableType d1) - (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) - (P2 : probability T2 R):= - Measure_isProbability.Build _ _ _ (P1 \x^ P2) (product_probability2_setT P1 P2). -End product_probability2. - -From mathcomp Require Import real_interval. - Section bool_to_real. Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). @@ -66,10 +64,6 @@ HB.instance Definition _ := HB.instance Definition _ := MeasurableFun.on bool_to_real. -(*Definition btr : {RV P >-> R} := bool_to_real. - -HB.instance Definition _ := MeasurableFun.on btr.*) - End bool_to_real. Section mfunM. @@ -82,6 +76,10 @@ HB.instance Definition _ (f g : {mfun T >-> R}) := End mfunM. +(* TODO: move (to exp.v?) *) +Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). +Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. + Section move. Lemma sumr_map {R : realType} U d (T : measurableType d) (l : seq U) Q @@ -121,6 +119,18 @@ HB.instance Definition _ {R : realType} d {T : measurableType d} (s : seq {mfun End move. +(* TODO: move to functions. *) +Lemma fct_prodE (I : Type) (T : pointedType) (M : comRingType) r (P : {pred I}) (f : I -> T -> M) + (x : T) : + (\prod_(i <- r | P i) f i) x = \prod_(i <- r | P i) f i x. +Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. + +HB.instance Definition _ (n : nat) := isPointed.Build 'I_n.+1 ord0. + +HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_display + 'I_n.+1 discrete_measurable discrete_measurable0 + discrete_measurableC discrete_measurableU. + Section move_to_bigop_nat_lemmas. Context {T : Type}. Implicit Types (A : set T). @@ -134,35 +144,160 @@ Qed. End move_to_bigop_nat_lemmas. -(* in master *) -Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : - {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. +Section fset. +Local Open Scope fset_scope. +Lemma fset_bool : forall B : {fset bool}, + [\/ B == [fset true], B == [fset false], B == fset0 | B == [fset true; false]]. +Proof. +move=> B. +have:= set_bool [set` B]. +rewrite -!set_fset1 -set_fset0. +rewrite (_ : [set: bool] = [set` [fset true; false]]); last first. + by apply/seteqP; split=> -[]; rewrite /= !inE eqxx. +by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; + [apply: Or41|apply: Or42|apply: Or43|apply: Or44]. +Qed. +End fset. + +Lemma finite_prod {R : realType} n (F : 'I_n -> \bar R) : + (forall i, 0 <= F i < +oo)%E -> (\prod_(i < n) F i < +oo)%E. Proof. -move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. - by case=> B + <- => -[? | ?]; [left | right]; exists B. -by case=> -[] B FGB <-; exists B=> //; [left | right]. +move: F; elim: n => n; first by rewrite big_ord0 ltry. +move=> ih F Foo. +rewrite big_ord_recl lte_mul_pinfty//. +- by have /andP[] := Foo ord0. +- rewrite fin_numElt. + have /andP[F0 ->] := Foo ord0. + by rewrite (@lt_le_trans _ _ 0%E). +by rewrite ih. Qed. -(* in master *) -Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : - preimage_set_system X f set0 = set0. -Proof. by apply/seteqP; split=> A // []. Qed. +Section integrable_theory. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}). +Variables (D : set T) (mD : measurable D). +Implicit Type f g : T -> \bar R. -(* in master *) -Lemma preimage_set_system_funcomp - {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} D : - preimage_set_system D (g \o f) F = - preimage_set_system D f (preimage_set_system setT g F). +Let ltnP_sumbool (a b : nat) : {(a < b)%N} + {(a >= b)%N}. +Proof. by case: ltnP => _; [left|right]. Qed. + +(* TODO: clean, move near integrable_sum, refactor *) +Lemma integrable_sum_ord n (t : 'I_n -> (T -> \bar R)) : + (forall i, mu.-integrable D (t i)) -> + mu.-integrable D (fun x => \sum_(i < n) t i x). Proof. -apply/seteqP; split=> A. - case=> B FB <-. - exists (g @^-1` B)=> //. - exists B=> //. - by rewrite setTI. -case=> B [] C FC <- <-. -exists C=> //. -rewrite !setTI. -by rewrite comp_preimage. +move=> intt. +pose s0 := fun k => match ltnP_sumbool k n with + | left kn => t (Ordinal kn) + | right _ => cst 0%E + end. +pose s := [tuple of map s0 (index_iota 0 n)]. +suff: mu.-integrable D (fun x => (\sum_(i <- s) i x)%R). + apply: eq_integrable => // i iT. + rewrite big_map/=. + rewrite big_mkord. + apply: eq_bigr => /= j _. + rewrite /s0. + case: ltnP_sumbool => // jn. + f_equal. + exact/val_inj. + have := ltn_ord j. + by rewrite ltnNge jn. +apply: (@integrable_sum d T R mu D mD s) => /= h /mapP[/= k]. +rewrite mem_index_iota leq0n/= => kn ->{h}. +have := intt (Ordinal kn). +rewrite /s0. +case: ltnP_sumbool => //. +by rewrite leqNgt kn. +Qed. + +End integrable_theory. + +(* TODO: clean, move near integrableD, refactor *) +Section integral_sum. +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). +Variables (I : eqType) (f : I -> (T -> \bar R)). +Hypothesis intf : forall n, mu.-integrable D (f n). + +Lemma integral_sum (s : seq I) : + \int[mu]_(x in D) (\sum_(k <- s) f k x) = + \sum_(k <- s) \int[mu]_(x in D) (f k x). +Proof. +elim: s => [|h t ih]. + under eq_integral do rewrite big_nil. + by rewrite integral0 big_nil. +rewrite big_cons -ih -integralD//. + by apply: eq_integral => x xD; rewrite big_cons. +rewrite [X in _.-integrable _ X](_ : _ = + (fun x => (\sum_(h0 <- [seq f i | i <- t]) h0 x))); last first. + by apply/funext => x; rewrite big_map. +apply: integrable_sum => //= g /mapP[i ti ->{g}]. +exact: intf. +Qed. + +End integral_sum. + +(* TODO: integral_fune_lt_pinfty does not look useful a lemma *) + +Lemma bounded_RV_integrable d (T : measurableType d) (R : realType) + (P : probability T R) (X : T -> R) M : + measurable_fun setT X -> + (forall t, (0 <= X t <= M)%R) -> P.-integrable setT (EFin \o X). +Proof. +move=> mf XM. +apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). +- exact/measurable_EFinP. +- move=> t _ /=; rewrite lee_fin/=. + rewrite !ger0_norm//. + + by have /andP[] := XM t. + + by rewrite (@le_trans _ _ (X t))//; have /andP[] := XM t. + + by have /andP[] := XM t. +- exact: finite_measure_integrable_cst. +Qed. +Arguments bounded_RV_integrable {d T R P X} M. + +Lemma fubini2' {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} + {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) + (m2 : {sigma_finite_measure set T2 -> \bar R}) (f : T1 * T2 -> \bar R) : + (m1 \x m2)%E.-integrable [set: T1 * T2] f -> + (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> intf; rewrite fubini2//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC/=. +by rewrite product_measure2E. +Qed. + +Lemma fubini1' {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} + {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) + (m2 : {sigma_finite_measure set T2 -> \bar R}) (f : T1 * T2 -> \bar R) : + (m1 \x m2)%E.-integrable [set: T1 * T2] f -> + (\int[m1]_x fubini_F m2 f x = \int[(m1 \x^ m2)%E]_z f z)%E. +Proof. +move=> intf; rewrite fubini1//. +apply: eq_measure_integral => //= A mA _. +apply: product_measure_unique => // B C mB mC/=. +by rewrite product_measure2E. +Qed. + +Lemma integrable_prodP {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} + {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) + (m2 : {sigma_finite_measure set T2 -> \bar R}) (f : T1 * T2 -> \bar R) : + (m1 \x m2)%E.-integrable [set: T1 * T2] f -> + (m1 \x^ m2)%E.-integrable [set: T1 * T2] f. +Proof. +move=> /integrableP[mf intf]; apply/integrableP; split => //. +rewrite -fubini2'//=. + rewrite fubini2//=. + apply/integrableP; split => //. + exact/measurableT_comp. + by under eq_integral do rewrite abse_id. +apply/integrableP; split => //. + exact/measurableT_comp. +by under eq_integral do rewrite abse_id. Qed. Definition g_sigma_preimage d (rT : semiRingOfSetsType d) (aT : Type) @@ -170,9 +305,9 @@ Definition g_sigma_preimage d (rT : semiRingOfSetsType d) (aT : Type) <>. Lemma g_sigma_preimage_comp d1 {T1 : semiRingOfSetsType d1} n - {T : pointedType} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : -g_sigma_preimage (fun i => (f1 i \o g)) = -preimage_set_system [set: T3] g (g_sigma_preimage f1). + {T : pointedType} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : + g_sigma_preimage (fun i => f1 i \o g) = + preimage_set_system [set: T3] g (g_sigma_preimage f1). Proof. rewrite {1}/g_sigma_preimage. rewrite -g_sigma_preimageE; congr (<>). @@ -197,11 +332,6 @@ Qed. HB.instance Definition _ (n : nat) (T : pointedType) := isPointed.Build (n.-tuple T) (nseq n point). -Definition mtuple (n : nat) d (T : measurableType d) : Type := n.-tuple T. - -HB.instance Definition _ (n : nat) d (T : measurableType d) := - Pointed.on (mtuple n T). - Lemma countable_range_bool d (T : measurableType d) (b : bool) : countable (range (@cst T _ b)). Proof. exact: countableP. Qed. @@ -216,7 +346,7 @@ Section measurable_tuple. Context {d} {T : measurableType d}. Variable n : nat. -Let coors := (fun i x => @tnth n T x i). +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. @@ -224,41 +354,27 @@ 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)) -> +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) - (mtuple n T) (g_sigma_preimage coors) - (tuple_set0) (tuple_setC) (tuple_bigcup). +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. -(* NB: not used *) -Definition cylinder d {T : measurableType d} m (A : set (m.-tuple T)) - (J : {fset 'I_m}%fset) : set (m.-tuple T) := - \big[setI/setT]_(i <- J) (@tnth _ T ^~ i) @^-1` - ((@tnth _ T ^~ i) @` A). - -(* NB: not used *) -Definition Z d {T : measurableType d} m - (J : {fset 'I_m}%fset) : set_system (m.-tuple T) := - [set B | exists A, B = cylinder A J]. - Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : - measurable_fun [set: mtuple n T] (@tnth _ T ^~ i). + 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 cons_measurable_fun. +Section measurable_cons. Context d d1 (T : measurableType d) (T1 : measurableType d1). -Lemma cons_measurable_funP (n : nat) (h : T -> mtuple n T1) : +Lemma cons_measurable_funP (n : nat) (h : T -> n.-tuple T1) : measurable_fun setT h <-> forall i : 'I_n, measurable_fun setT ((@tnth _ T1 ^~ i) \o h). Proof. @@ -288,10 +404,9 @@ apply: (@iff_trans _ (g_sigma_preimage exact: mh. Qed. -(* TODO: rename to measurable_cons *) -Lemma measurable_fun_cons (f : T -> T1) n (g : T -> mtuple n T1) : +Lemma measurable_cons (f : T -> T1) n (g : T -> n.-tuple T1) : measurable_fun setT f -> measurable_fun setT g -> - measurable_fun setT (fun x : T => [the mtuple n.+1 T1 of (f x) :: (g x)]). + measurable_fun setT (fun x : T => [the n.+1.-tuple T1 of (f x) :: (g x)]). Proof. move=> mf mg; apply/cons_measurable_funP => /= i. have [->|i0] := eqVneq i ord0. @@ -304,7 +419,7 @@ have @j : 'I_n. by rewrite lt0n. rewrite (_ : _ \o _ = (fun x => tnth (g x) j))//. apply: (@measurableT_comp _ _ _ _ _ _ - (fun x : mtuple n T1 => tnth x j) _ g) => //. + (fun x : n.-tuple T1 => tnth x j) _ g) => //. exact: measurable_tnth. apply/funext => t/=. rewrite (_ : i = lift ord0 j) ?tnthS//. @@ -312,8 +427,9 @@ apply/val_inj => /=. by rewrite /bump/= add1n prednK// lt0n. Qed. -End cons_measurable_fun. +End measurable_cons. +(* NB: not used *) Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : behead t = [tuple (tnth t (lift ord0 i)) | i < n]. Proof. @@ -337,7 +453,7 @@ by move=> ->. Qed. Lemma measurable_behead d (T : measurableType d) n : - measurable_fun setT (fun x : mtuple n.+1 T => [tuple of behead x] : mtuple n T). + measurable_fun setT (fun x : n.+1.-tuple T => [tuple of behead x] : n.-tuple T). Proof. red=> /=. move=> _ Y mY. @@ -366,9 +482,9 @@ apply: H; rewrite big_ord_recl /=; right. set X' := (X' in X' (preimage _ _)). have-> : X' = preimage_set_system setT bh X. rewrite /X. - rewrite (big_morph _ preimage_set_systemU preimage_set_system0). + rewrite (big_morph _ (preimage_set_systemU _ _) (preimage_set_system0 _ _)). apply: eq_bigr=> i _. - rewrite -preimage_set_system_funcomp. + rewrite -preimage_set_system_comp. congr preimage_set_system. apply: funext=> t. rewrite (tuple_eta t) /bh /= tnthS. @@ -377,11 +493,58 @@ exists A=> //. by rewrite setTI. Qed. +Section tuple_sum. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Definition Tnth n (X : n.-tuple {mfun T >-> R}) i : n.-tuple T -> R := + fun t => (tnth X i) (tnth t i). + +Lemma measurable_Tnth n (X : n.-tuple {mfun T >-> R}) i : + measurable_fun [set: n.-tuple T] (Tnth X i). +Proof. by apply: measurableT_comp => //; exact: measurable_tnth. Qed. + +HB.instance Definition _ n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) := + isMeasurableFun.Build _ _ _ _ (Tnth X i) (measurable_Tnth X i). + +Lemma Tnth_tnth n (X : n.+1.-tuple {mfun T >-> R}) x : + (Tnth X ord0) (x :: nseq n point) = (tnth X ord0) x. +Proof. +rewrite /Tnth/=. +rewrite tnth0. +Abort. + +Lemma measurable_tuple_sum n (X : n.-tuple {mfun T >-> R}) : + measurable_fun setT (\sum_(i < n) (Tnth X i))%R. +Proof. +rewrite [X in measurable_fun _ X](_ : _ + = (fun x => \sum_(i < n) Tnth X i x)); last first. + by apply/funext => x; rewrite fct_sumE. +apply: measurable_sum => i/=; apply/measurableT_comp => //. +exact: measurable_tnth. +Qed. + +HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := + isMeasurableFun.Build _ _ _ _ (\sum_(i < n) Tnth s i)%R (measurable_tuple_sum s). + +Lemma measurable_tuple_prod m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) : + measurable_fun setT (\prod_(i < n) Tnth s (f i))%R. +Proof. +rewrite [X in measurable_fun _ X](_ : _ + = (fun x => \prod_(i < n) Tnth s (f i) x)); last first. + by apply/funext => x; rewrite fct_prodE. +by apply: measurable_prod => /= i _; apply/measurableT_comp => //. +Qed. + +HB.instance Definition _ m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) := + isMeasurableFun.Build _ _ _ _ (\prod_(i < n) Tnth s (f i))%R (measurable_tuple_prod s f). + +End tuple_sum. + Section pro1. Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). -Definition pro1 := product_measure1 P1 P2. +Definition pro1 := (P1 \x P2)%E. HB.instance Definition _ := Measure.on pro1. @@ -391,15 +554,14 @@ rewrite /pro1 -setXTT product_measure1E// -[RHS]mule1. by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). Qed. -HB.instance Definition _ := - Measure_isProbability.Build _ _ _ pro1 pro1_setT. +HB.instance Definition _ := Measure_isProbability.Build _ _ _ pro1 pro1_setT. End pro1. Section pro2. Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). -Definition pro2 := product_measure2 P1 P2. +Definition pro2 := (P1 \x^ P2)%E. HB.instance Definition _ := Measure.on pro2. @@ -409,43 +571,41 @@ rewrite /pro2 -setXTT product_measure2E// -[RHS]mule1. by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). Qed. -HB.instance Definition _ := - Measure_isProbability.Build _ _ _ pro2 pro2_setT. +HB.instance Definition _ := Measure_isProbability.Build _ _ _ pro2 pro2_setT. End pro2. -Section pro. +Section iterated_product_of_probability_measures. Context d (T : measurableType d) (R : realType) (P : probability T R). -Fixpoint mpro (n : nat) : set (mtuple n T) -> \bar R := +Fixpoint ipro (n : nat) : set (n.-tuple T) -> \bar R := match n with - | 0%N => \d_([::] : mtuple 0 T) - | m.+1 => fun A => (P \x^ @mpro m)%E [set (thead x, [tuple of behead x]) | x in A] + | 0%N => \d_([::] : 0.-tuple T) + | m.+1 => fun A => (P \x^ @ipro m)%E [set (thead x, [tuple of behead x]) | x in A] end. -Lemma mpro_measure n : @mpro n set0 = 0 /\ (forall A, (0 <= @mpro n A)%E) - /\ semi_sigma_additive (@mpro n). +Lemma ipro_measure n : @ipro n set0 = 0 /\ (forall A, 0 <= @ipro n A)%E + /\ semi_sigma_additive (@ipro n). Proof. elim: n => //= [|n ih]. by repeat split => //; exact: measure_semi_sigma_additive. -pose build_Mpro := isMeasure.Build _ _ _ (@mpro n) ih.1 ih.2.1 ih.2.2. -pose Mpro : measure _ R := HB.pack (@mpro n) build_Mpro. +pose build_Mpro := isMeasure.Build _ _ _ (@ipro n) ih.1 ih.2.1 ih.2.2. +pose Mpro : measure _ R := HB.pack (@ipro n) build_Mpro. pose ppro : measure _ R := (P \x^ Mpro)%E. split. rewrite image_set0 /product_measure2 /=. under eq_fun => x do rewrite ysection0 measure0 (_ : 0 = cst 0 x)//. - rewrite (_ : @mpro n = Mpro)//. - by rewrite integral_cst// mul0e. + by rewrite (_ : @ipro n = Mpro)// integral_cst// mul0e. split. - by move => A; rewrite (_ : @mpro n = Mpro). -rewrite (_ : @mpro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. + by move => A; rewrite (_ : @ipro n = Mpro). +rewrite (_ : @ipro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. move=> F mF dF mUF. rewrite image_bigcup. move=> [:save]. apply: measure_semi_sigma_additive. - abstract: save. move=> i. - pose f (t : n.+1.-tuple T) := (@thead n T t, [the mtuple _ T of behead t]). - pose f' (x : T * mtuple n T) := [the mtuple n.+1 T of x.1 :: x.2]. + pose f (t : n.+1.-tuple T) := (@thead n T t, [the _.-tuple T of behead t]). + pose f' (x : T * n.-tuple T) := [the n.+1.-tuple T of x.1 :: x.2]. rewrite [X in measurable X](_ : _ = f' @^-1` F i); last first. apply/seteqP; split=> [x/= [t Fit] <-{x}|[x1 x2] /= Fif']. rewrite /f'/=. @@ -455,8 +615,7 @@ apply: measure_semi_sigma_additive. exact/val_inj. rewrite -[X in measurable X]setTI. suff: measurable_fun setT f' by exact. - rewrite /= /f'. - exact: measurable_fun_cons. + exact: measurable_cons. - (* TODO: lemma? *) apply/trivIsetP => i j _ _ ij. move/trivIsetP : dF => /(_ i j Logic.I Logic.I ij). @@ -470,413 +629,138 @@ apply: measure_semi_sigma_additive. exact: save. Qed. -HB.instance Definition _ n := isMeasure.Build _ _ _ (@mpro n) - (@mpro_measure n).1 (@mpro_measure n).2.1 (@mpro_measure n).2.2. +HB.instance Definition _ n := isMeasure.Build _ _ _ (@ipro n) + (@ipro_measure n).1 (@ipro_measure n).2.1 (@ipro_measure n).2.2. -Lemma mpro_setT n : @mpro n setT = 1%E. +Lemma ipro_setT n : @ipro n setT = 1%E. Proof. -elim: n => //=; first by rewrite diracT. -move=> n ih. -rewrite /product_measure2/ysection/=. +elim: n => [|n ih]/=; first by rewrite diracT. +rewrite /product_measure2 /ysection/=. under eq_fun => x. rewrite [X in P X](_ : _ = [set: T]); last first. - under eq_fun => y. rewrite [X in _ \in X](_ : _ = setT); last first. - apply: funext=> z/=. - apply: propT. - exists (z.1 :: z.2) => //=. - case: z => z1 z2/=. - congr pair. - exact/val_inj. + under eq_fun => y. + rewrite [X in _ \in X](_ : _ = setT); last first. + apply: funext=> z/=. + apply: propT. + exists (z.1 :: z.2) => //=. + case: z => z1 z2/=. + congr pair. + exact/val_inj. over. - by apply: funext => y/=; rewrite in_setT trueE. + by apply: funext => y /=; rewrite in_setT trueE. rewrite probability_setT. over. by rewrite integral_cst// mul1e. Qed. HB.instance Definition _ n := - Measure_isProbability.Build _ _ _ (@mpro n) (@mpro_setT n). - -Definition pro (n : nat) : probability (mtuple n T) R := @mpro n. + Measure_isProbability.Build _ _ _ (@ipro n) (@ipro_setT n). -End pro. -Arguments pro {d T R} P n. +End iterated_product_of_probability_measures. +Arguments ipro {d T R} P n. -Notation "\X_ n P" := (pro P n) (at level 10, n, P at next level, +Notation "\X_ n P" := (ipro P n) (at level 10, n, P at next level, format "\X_ n P"). -Lemma fubini2' : -forall [d1 d2 : measure_display] [T1 : measurableType d1] - [T2 : measurableType d2] [R : realType] - [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] - f -> (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f intf. -rewrite fubini2//. -apply: eq_measure_integral => //= A mA _. -apply: product_measure_unique => // B C mB mC. -rewrite /=. -by rewrite product_measure2E. -Qed. - -Lemma fubini1' : -forall [d1 d2 : measure_display] [T1 : measurableType d1] - [T2 : measurableType d2] [R : realType] - [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] - f -> (\int[m1]_x fubini_F m2 f x = \int[(m1 \x^ m2)%E]_z f z)%E. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f intf. -rewrite fubini1//. -apply: eq_measure_integral => //= A mA _. -apply: product_measure_unique => // B C mB mC. -rewrite /=. -by rewrite product_measure2E. -Qed. - -Lemma integrable_prodP : -forall [d1 d2 : measure_display] [T1 : measurableType d1] [T2 : measurableType d2] - [R : realType] [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f -> -(m1 \x^ m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f /integrableP[mf intf]; apply/integrableP; split => //. - rewrite -fubini2'//=. - rewrite fubini2//=. - apply/integrableP; split => //. - by apply/measurableT_comp => //. - by under eq_integral do rewrite abse_id. - apply/integrableP; split => //. - by apply/measurableT_comp => //. - by under eq_integral do rewrite abse_id. -Qed. - -Section proS. +Section integral_ipro. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. Variable n : nat. -Definition phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. +Definition phi := fun w : T * n.-tuple T => [the _.-tuple _ of w.1 :: w.2]. -Lemma mphi : measurable_fun [set: T * mtuple _ _] phi. -Proof. exact: measurable_fun_cons. Qed. +Lemma mphi : measurable_fun [set: T * _.-tuple _] phi. +Proof. exact: measurable_cons. Qed. -Definition psi := fun (w : mtuple n.+1 T) => (thead w, [the mtuple _ _ of behead w]). - -Lemma mpsi : measurable_fun [set: mtuple _ _] psi. -Proof. -apply/measurable_fun_prod => /=. - exact: measurable_tnth. -exact: measurable_behead. -Qed. +Definition psi := fun w : n.+1.-tuple T => (thead w, [the _.-tuple _ of behead w]). -Lemma phiK : cancel phi psi. +Lemma mpsi : measurable_fun [set: _.-tuple _] psi. Proof. -by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. +by apply/measurable_fun_prod => /=; + [exact: measurable_tnth|exact: measurable_behead]. Qed. -Let psiK : cancel psi phi. -Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. - -Lemma integral_mpro (f : n.+1.-tuple T -> R) : - (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f) -> - \int[\X_n.+1 P]_w (f w)%:E = - \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. -Proof. -move=> /integrableP[mf intf]. -rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ setT - (fun x : mtuple n.+1 T => (f x)%:E)); [|by []| |by []]. - apply: eq_measure_integral => A mA _. - rewrite /=. - rewrite /pushforward. - rewrite /pro2. - rewrite /phi/=. - rewrite /preimage/=. - congr (_ _). - apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. - move: At. - by rewrite {1}(tuple_eta t)//. - exists (x.1 :: x.2) => //=. - destruct x as [x1 x2] => //=. - congr pair. - exact/val_inj. -rewrite /=. -apply/integrable_prodP. -rewrite /=. -apply/integrableP; split => /=. - apply: measurableT_comp => //=. - exact: mphi. -apply: le_lt_trans (intf). -rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x - ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. - by apply: eq_integral => x _ /=; rewrite psiK. -rewrite le_eqVlt; apply/orP; left; apply/eqP. -rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT - (fun x : T * mtuple n T => ((abse \o (EFin \o (f \o phi))) x)))//. -- apply: eq_measure_integral => // A mA _. - apply: product_measure_unique => // B C mB mC. - rewrite /= /pushforward/=. - rewrite -product_measure2E//=. - congr (_ _). - (* TODO: lemma *) - apply/seteqP; split => [[x1 x2]/= [t [Bt Ct]] [<- <-//]|]. - move=> [x1 x2] [B1 C2] /=. - exists (x1 :: x2) => //=. - split=> //. - rewrite [X in C X](_ : _ = x2)//. - exact/val_inj. - congr pair => //. - exact/val_inj. -- apply/measurable_EFinP => //=. - apply: measurableT_comp => //=. - apply: measurableT_comp => //=. - by apply/measurable_EFinP. - exact: mphi. -- have : (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f). - exact/integrableP. -- apply: le_integrable => //=. - + apply: measurableT_comp => //=; last exact: mpsi. - apply/measurable_EFinP => //=. - apply: measurableT_comp => //=. - apply: measurableT_comp => //=; last exact: mphi. - by apply/measurable_EFinP => //=. - + move=> x _. - by rewrite normr_id// psiK. -Qed. - -End proS. - -Section integrable_theory. -Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}). -Variables (D : set T) (mD : measurable D). -Implicit Type f g : T -> \bar R. - -Let ltnP_sumbool (a b : nat) : {(a < b)%N} + {(a >= b)%N}. -Proof. by case: ltnP => _; [left|right]. Qed. - -(* TODO: clean, move near integrable_sum, refactor *) -Lemma integrable_sum_ord n (t : 'I_n -> (T -> \bar R)) : - (forall i, mu.-integrable D (t i)) -> - mu.-integrable D (fun x => \sum_(i < n) t i x). -Proof. -move=> intt. -pose s0 := fun k => match ltnP_sumbool k n with - | left kn => t (Ordinal kn) - | right _ => cst 0%E - end. -pose s := [tuple of map s0 (index_iota 0 n)]. -suff: mu.-integrable D (fun x => (\sum_(i <- s) i x)%R). - apply: eq_integrable => // i iT. - rewrite big_map/=. - rewrite big_mkord. - apply: eq_bigr => /= j _. - rewrite /s0. - case: ltnP_sumbool => // jn. - f_equal. - exact/val_inj. - have := ltn_ord j. - by rewrite ltnNge jn. -apply: (@integrable_sum d T R mu D mD s) => /= h /mapP[/= k]. -rewrite mem_index_iota leq0n/= => kn ->{h}. -have := intt (Ordinal kn). -rewrite /s0. -case: ltnP_sumbool => //. -by rewrite leqNgt kn. -Qed. - -End integrable_theory. - -(* TODO: clean, move near integrableD, refactor *) -Section integral_sum. -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). -Variables (I : eqType) (f : I -> (T -> \bar R)). -Hypothesis intf : forall n, mu.-integrable D (f n). - -Lemma integral_sum (s : seq I) : - \int[mu]_(x in D) (\sum_(k <- s) f k x) = - \sum_(k <- s) \int[mu]_(x in D) (f k x). -Proof. -elim: s => [|h t ih]. - under eq_integral do rewrite big_nil. - by rewrite integral0 big_nil. -rewrite big_cons -ih -integralD//. - by apply: eq_integral => x xD; rewrite big_cons. -rewrite [X in _.-integrable _ X](_ : _ = - (fun x => (\sum_(h0 <- [seq f i | i <- t]) h0 x))); last first. - by apply/funext => x; rewrite big_map. -apply: integrable_sum => //= g /mapP[i ti ->{g}]. -exact: intf. -Qed. - -End integral_sum. - -(* TODO: integral_fune_lt_pinfty does not look useful a lemma *) - -Lemma bounded_RV_integrable d (T : measurableType d) (R : realType) - (P : probability T R) (X : T -> R) M : - measurable_fun setT X -> - (forall t, (0 <= X t <= M)%R) -> P.-integrable setT (EFin \o X). -Proof. -move=> mf XM. -apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). -- exact/measurable_EFinP. -- move=> t _ /=; rewrite lee_fin/=. - rewrite !ger0_norm//. - + by have /andP[] := XM t. - + by rewrite (@le_trans _ _ (X t))//; have /andP[] := XM t. - + by have /andP[] := XM t. -- exact: finite_measure_integrable_cst. -Qed. -Arguments bounded_RV_integrable {d T R P X} M. - -Module with_interval. -Declare Scope bigQ_scope. -Import Reals. -Import Rstruct Rstruct_topology. -Import Interval.Tactic. - -Section expR2_le8. -Let R := Rdefinitions.R. -Local Open Scope ring_scope. - -Lemma expR2_le8 : expR 2 <= 8 :> R. -Proof. -rewrite (_ : 2 = 1 + 1)//. -rewrite exp.expRD -RmultE. -rewrite (_ : 8 = 8%R); last first. - by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. -rewrite (_ : 1 = INR 1%N)//=. -rewrite -RexpE. -apply/RleP. -by interval. -Qed. - -End expR2_le8. -End with_interval. - -Section taylor_ln_le. -Let R := Rdefinitions.R. -Local Open Scope ring_scope. - -Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. -Proof. -move=> x01; rewrite -subr_ge0. -pose f (x : R^o) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). -have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. -rewrite [leRHS](_ : _ = f x) // -f0. -evar (df0 : R -> R); evar (df : R -> R). -have idf (y : R^o) : 0 < 1 + y -> is_derive y (1:R) f (df y). - move=> y1. - rewrite (_ : df y = df0 y). - apply: is_deriveB; last exact: is_deriveD. - apply: is_deriveM=> //. - apply: is_derive1_comp=> //. - exact: is_derive1_ln. - rewrite /df0. - rewrite deriveD// derive_cst derive_id. - rewrite /GRing.scale /= !(mulr0,add0r,mulr1). - rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. - instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). - reflexivity. -clear df0. -have y1cc y : y \in `[0, 1] -> 0 < 1 + y. - rewrite in_itv /= => /andP [] y0 ?. - by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. -have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. -have dfge0 y : y \in `]0, 1[ -> 0 <= df y. - move=> y01. - have:= y01. - rewrite /df in_itv /= => /andP [] y0 y1. - rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. - rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. - pose iy:= Itv01 (ltW y0) (ltW y1). - have y1E: 1 + y = @convex.conv _ R^o iy 1 2. - rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. - by rewrite addrACA (addrC (- y)) subrr addr0. - rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. - rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. - rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. - rewrite ler_pdivrMr//. - rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. - rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. - rewrite !exprS expr0 mulr1 -!natrM mulnE /=. - by rewrite with_interval.expR2_le8. -apply: (@ger0_derive1_homo R f 0 1 true false). -- by move=> y /y1oo /idf /@ex_derive. -- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. -- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. -- by rewrite bound_itvE. -- exact: subset_itv_oo_cc. -- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. -Qed. - -End taylor_ln_le. - -(* TODO: move to functions. *) -Lemma fct_prodE (I : Type) (T : pointedType) (M : comRingType) r (P : {pred I}) (f : I -> T -> M) - (x : T) : - (\prod_(i <- r | P i) f i) x = \prod_(i <- r | P i) f i x. -Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. - -HB.instance Definition _ (n : nat) := isPointed.Build 'I_n.+1 ord0. - -HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_display - 'I_n.+1 discrete_measurable discrete_measurable0 - discrete_measurableC discrete_measurableU. - -Section tuple_sum. -Context d (T : measurableType d) (R : realType) (P : probability T R). - -Definition Tnth n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) : mtuple n T -> R := - fun t => (tnth X i) (tnth t i). - -Lemma measurable_Tnth n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) : - measurable_fun [set: mtuple n T] (Tnth X i). -Proof. by apply: measurableT_comp => //; exact: measurable_tnth. Qed. - -HB.instance Definition _ n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) := - isMeasurableFun.Build _ _ _ _ (Tnth X i) (measurable_Tnth X i). - -Lemma measurable_tuple_sum n (X : n.-tuple {mfun T >-> R}) : - measurable_fun setT (\sum_(i < n) Tnth X i)%R. +Lemma phiK : cancel phi psi. Proof. -rewrite [X in measurable_fun _ X](_ : _ - = (fun x => \sum_(i < n) Tnth X i x)); last first. - by apply/funext => x; rewrite fct_sumE. -apply: measurable_sum => i/=; apply/measurableT_comp => //. -exact: measurable_tnth. +by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. Qed. -HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (\sum_(i < n) Tnth s i)%R (measurable_tuple_sum s). +Let psiK : cancel psi phi. +Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. -Lemma measurable_tuple_prod m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) : - measurable_fun setT (\prod_(i < n) Tnth s (f i))%R. +Lemma integral_ipro (f : n.+1.-tuple T -> R) : + (\X_n.+1 P).-integrable [set: n.+1.-tuple T] (EFin \o f) -> + \int[\X_n.+1 P]_w (f w)%:E = + \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. -rewrite [X in measurable_fun _ X](_ : _ - = (fun x => \prod_(i < n) Tnth s (f i) x)); last first. - by apply/funext => x; rewrite fct_prodE. -by apply: measurable_prod => /= i _; apply/measurableT_comp => //. +move=> /integrableP[mf intf]. +rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ setT + (fun x : n.+1.-tuple T => (f x)%:E)); [|by []| |by []]. + apply: eq_measure_integral => A mA _. + rewrite /=. + rewrite /pushforward. + rewrite /pro2. + rewrite /phi/=. + rewrite /preimage/=. + congr (_ _). + apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. + move: At. + by rewrite {1}(tuple_eta t)//. + exists (x.1 :: x.2) => //=. + destruct x as [x1 x2] => //=. + congr pair. + exact/val_inj. +rewrite /=. +apply/integrable_prodP. +rewrite /=. +apply/integrableP; split => /=. + apply: measurableT_comp => //=. + exact: mphi. +apply: le_lt_trans (intf). +rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x + ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. + by apply: eq_integral => x _ /=; rewrite psiK. +rewrite le_eqVlt; apply/orP; left; apply/eqP. +rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT + (fun x : T * n.-tuple T => ((abse \o (EFin \o (f \o phi))) x)))//. +- apply: eq_measure_integral => // A mA _. + apply: product_measure_unique => // B C mB mC. + rewrite /= /pushforward/=. + rewrite -product_measure2E//=. + congr (_ _). + (* TODO: lemma *) + apply/seteqP; split => [[x1 x2]/= [t [Bt Ct]] [<- <-//]|]. + move=> [x1 x2] [B1 C2] /=. + exists (x1 :: x2) => //=. + split=> //. + rewrite [X in C X](_ : _ = x2)//. + exact/val_inj. + congr pair => //. + exact/val_inj. +- apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + apply: measurableT_comp => //=. + exact/measurable_EFinP. + exact: mphi. +- have : (\X_n.+1 P).-integrable [set: n.+1.-tuple T] (EFin \o f). + exact/integrableP. +- apply: le_integrable => //=. + + apply: measurableT_comp => //=; last exact: mpsi. + apply/measurable_EFinP => //=. + apply: measurableT_comp => //=. + apply: measurableT_comp => //=; last exact: mphi. + by apply/measurable_EFinP => //=. + + move=> x _. + by rewrite normr_id// psiK. Qed. -HB.instance Definition _ m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) := - isMeasurableFun.Build _ _ _ _ (\prod_(i < n) Tnth s (f i))%R (measurable_tuple_prod s f). - -End tuple_sum. +End integral_ipro. Section properties_of_expectation. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) M : +Lemma expectation_sum_ipro n (X : n.-tuple {RV P >-> R}) M : (forall i t, (0 <= tnth X i t <= M)%R) -> 'E_(\X_n P)[\sum_(i < n) Tnth X i] = \sum_(i < n) ('E_P[(tnth X i)]). Proof. @@ -893,25 +777,22 @@ have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). exact: XM. rewrite big_ord_recl/=. rewrite big_ord_recl/=. -pose X1 (x : mtuple n.+1 T) := +pose X1 (x : n.+1.-tuple T) := (\sum_(i < n) (tnth X (lift ord0 i)) (tnth x (lift ord0 i)))%R. have mX1 : measurable_fun setT X1. apply: measurable_sum => /= i; apply: measurableT_comp => //. exact: measurable_tnth. pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. -pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). +pose Y1 : {mfun n.+1.-tuple T >-> R} := HB.pack X1 build_mX1. +pose X2 (x : n.+1.-tuple T) := (thead X) (thead x). have mX2 : measurable_fun setT X2. rewrite /X2 /=. by apply: measurableT_comp => //; exact: measurable_tnth. pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. +pose Y2 : {mfun n.+1.-tuple T >-> R} := HB.pack X2 build_mX2. rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1); last first. - rewrite /Y2 /Y1/=. - rewrite /X2 /X1/=. - apply/funext => t. - rewrite !fctE. - by rewrite fct_sumE. + rewrite /Y2 /Y1/= /X2 /X1/=. + by apply/funext => t; rewrite !fctE fct_sumE. rewrite expectationD; last 2 first. apply: (bounded_RV_integrable M) => // t. exact: XM. @@ -919,15 +800,15 @@ rewrite expectationD; last 2 first. (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. by apply/funext => t/=; rewrite sumEFin. apply: integrable_sum_ord => // i. - have : measurable_fun setT (fun x : mtuple n.+1 T => - (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). + have : measurable_fun setT (fun x : n.+1.-tuple T => + tnth X (lift ord0 i) (tnth x (lift ord0 i))). apply/measurableT_comp => //=. exact: measurable_tnth. by move/(bounded_RV_integrable M); exact. congr (_ + _). - rewrite /Y2 /X2/= unlock /expectation. (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) - pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). + pose phi : n.+1.-tuple T -> T := fun w => @tnth n.+1 T w ord0. have mphi : measurable_fun setT phi. exact: measurable_tnth. rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ setT @@ -940,13 +821,13 @@ congr (_ + _). by []. apply: eq_measure_integral => //= A mA _. rewrite /pushforward. - rewrite /pro/= /phi. + rewrite /phi. rewrite [X in (_ \x^ _) X = _](_ : [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] = A `*` setT); last first. apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. move=> [x1 x2]/= [Ax1 _]. - exists [the mtuple _ _ of x1 :: x2] => //=. + exists [the _.-tuple _ of x1 :: x2] => //=. by rewrite theadE; congr pair => //; exact/val_inj. by rewrite product_measure2E//= probability_setT mule1. - rewrite /Y1 /X1/=. @@ -961,47 +842,41 @@ congr (_ + _). move=> i t. rewrite tnth_behead. exact: XM. - transitivity ('E_\X_n P[(fun x : mtuple n T => - (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). + transitivity ('E_\X_n P[(fun x : n.-tuple T => + \sum_(i < n) tnth (behead X) i (tnth x i))%R]). rewrite unlock /expectation. - transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). - rewrite integral_mpro//. - apply: eq_integral => /= -[w1 w2] _. - rewrite -!sumEFin. - apply: eq_bigr => i _ /=. - by rewrite tnthS//. + transitivity (\int[(pro2 P (\X_n P))]_w + (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). + rewrite integral_ipro//. + apply: eq_integral => /= -[w1 w2] _; rewrite -!sumEFin. + by apply: eq_bigr => i _ /=; rewrite tnthS. rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. + (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. by apply/funext => t/=; rewrite sumEFin. apply: integrable_sum_ord => // i. - have : measurable_fun setT (fun x : mtuple n.+1 T => + have : measurable_fun setT (fun x : n.+1.-tuple T => (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). - apply/measurableT_comp => //=. - exact: measurable_tnth. + by apply/measurableT_comp => //=; exact: measurable_tnth. by move/(bounded_RV_integrable M); exact. - rewrite /pro2. - rewrite -fubini2'/=; last first. + rewrite /pro2 -fubini2'/=; last first. rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. by apply/funext => t/=; rewrite sumEFin. apply: integrable_sum_ord => //= i. - have : measurable_fun setT (fun x : T * mtuple n T => (tnth X (lift ord0 i) (tnth x.2 i))). + have : measurable_fun setT (fun x : T * n.-tuple T => (tnth X (lift ord0 i) (tnth x.2 i))). apply/measurableT_comp => //=. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n _ => tnth x i) _ snd) => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x i) _ snd) => //=. exact: measurable_tnth. - move/(@bounded_RV_integrable _ _ R (pro1 P (mpro P (n:=n)))%E _ M) => /=. - apply => t. - by apply: XM. + move/(@bounded_RV_integrable _ _ R (pro1 P (\X_n P))%E _ M) => /=. + by apply => t; exact: XM. apply: eq_integral => t _. rewrite /fubini_G. transitivity (\sum_(i < n) - (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). + (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). rewrite -[RHS]integral_sum//. by apply: eq_integral => x _; rewrite sumEFin. - move=> /= i. - exact: finite_measure_integrable_cst. - rewrite -sumEFin. - apply: eq_bigr => /= i _. + by move=> /= i; exact: finite_measure_integrable_cst. + rewrite -sumEFin; apply: eq_bigr => /= i _. rewrite integral_cst//. rewrite [X in _ * X]probability_setT mule1. rewrite tnth_behead//=. @@ -1009,11 +884,10 @@ congr (_ + _). apply/val_inj => /=. by rewrite inordK// ltnS. congr expectation. - apply/funext => t. - by rewrite fct_sumE. + by apply/funext => t; rewrite fct_sumE. Qed. -Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) +Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (P1 : probability T1 R) (P2 : probability T2 R) (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : P1.-integrable setT (EFin \o X) -> @@ -1023,7 +897,7 @@ Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) Proof. move=> intX intY/=. rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. - apply/fubini1b. + apply/integrable21ltyP. - apply/measurable_EFinP => //=. by apply: measurable_funM => //=; apply: measurableT_comp. - under eq_integral. @@ -1087,7 +961,7 @@ Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : Proof. elim: n X => [X|n IH X] /= boundedX intX. by rewrite !big_ord0 expectation_cst. -rewrite unlock /expectation integral_mpro /pro2; last first. +rewrite unlock /expectation integral_ipro /pro2; last first. apply: (bounded_RV_integrable (M^+n.+1)%R) => //. exact: measurable_tuple_prod. move=> t; apply/andP; split. @@ -1120,7 +994,7 @@ rewrite -fubini1' /fubini_F/=; last first. exact: measurableT_comp. apply: measurable_prod => //=i ?. apply: measurableT_comp => //=. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n T => @tnth n T x i) _ snd) => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x i) _ snd) => //=. exact: measurable_tnth. apply: boundedM. apply/ex_bound. exact: (@globally_properfilter _ _ point). (* TODO: need to automate globally_properfilter *) @@ -1133,13 +1007,12 @@ rewrite -fubini1' /fubini_F/=; last first. rewrite big_mkord ler_prod => //=i _. have /andP[? ?] := boundedX (lift ord0 i) (tnth x.2 i). by rewrite normr_ge0/= ger0_norm. -have ? : (mpro P (n:=n)).-integrable [set: mtuple n T] - (fun x : mtuple n T => (\prod_(i < n) tnth X (lift ord0 i) (tnth x i))%:E). +have ? : (\X_n P).-integrable [set: n.-tuple T] + (fun x => (\prod_(i < n) (tnth X (lift ord0 i)) (tnth x i))%:E). apply: (bounded_RV_integrable (M^+n)%R) => //=. - apply: measurable_prod => /=i _. - apply: measurableT_comp => //. + apply: measurable_prod => /= i _; apply: measurableT_comp => //. exact: measurable_tnth. - move=> t. apply/andP. split. + move=> t; apply/andP; split. by rewrite prodr_ge0//= => i _; have /andP[] := boundedX (lift ord0 i) (tnth t i). by rewrite -[in leRHS](subn0 n) -prodr_const_nat big_mkord ler_prod. under eq_fun => x. @@ -1170,34 +1043,6 @@ congr EFin. by rewrite [in RHS](tuple_eta X) tnthS. Qed. -Section fset. -Local Open Scope fset_scope. -Lemma fset_bool : forall B : {fset bool}, - [\/ B == [fset true], B == [fset false], B == fset0 | B == [fset true; false]]. -Proof. -move=> B. -have:= set_bool [set` B]. -rewrite -!set_fset1 -set_fset0. -rewrite (_ : [set: bool] = [set` [fset true; false]]); last first. - by apply/seteqP; split=> -[]; rewrite /= !inE eqxx. -by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; - [apply: Or41|apply: Or42|apply: Or43|apply: Or44]. -Qed. -End fset. - -Lemma finite_prod n (F : 'I_n -> \bar R) : - (forall i, 0 <= F i < +oo) -> \prod_(i < n) F i < +oo. -Proof. -move: F; elim: n => n; first by rewrite big_ord0 ltry. -move=> ih F Foo. -rewrite big_ord_recl lte_mul_pinfty//. -- by have /andP[] := Foo ord0. -- rewrite fin_numElt. - have /andP[F0 ->] := Foo ord0. - by rewrite (@lt_le_trans _ _ 0). -by rewrite ih. -Qed. - End properties_of_independence. HB.mixin Record RV_isBernoulli d (T : measurableType d) (R : realType) @@ -1210,47 +1055,39 @@ HB.structure Definition BernoulliRV d (T : measurableType d) (R : realType) {X of @RV_isBernoulli _ _ _ P p X}. Arguments bernoulliRV {d T R}. -Section bernoulli. - +Section properties_of_BernoulliRV. Local Open Scope ereal_scope. -Let R := Rdefinitions.R. -Context d (T : measurableType d) (P : probability T R). +Context d (T : measurableType d) {R : realType} (P : probability T R). Variable p : R. Hypothesis p01 : (0 <= p <= 1)%R. -Lemma bernoulli_RV1 (X : bernoulliRV P p) : - P [set i | X i == 1%R] = p%:E. +Lemma preimage_set1 (X : T -> bool) r : X @^-1` [set r] = [set i | X i == r]. +Proof. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. + +Lemma bernoulli_RV1 (X : bernoulliRV P p) : P [set i | X i == 1%R] = p%:E. Proof. have/(congr1 (fun f => f [set 1%:R])):= @bernoulliP _ _ _ _ _ X. rewrite bernoulliE//. -rewrite /mscale/=. rewrite diracE/= mem_set// mule1// diracE/= memNset//. -rewrite mule0 adde0. -rewrite /distribution /= => <-. -congr (P _). -rewrite /preimage/=. -by apply/seteqP; split => [x /eqP H//|x /eqP]. +rewrite mule0 adde0 -preimage_set1. +by rewrite /distribution /= => <-. Qed. -Lemma bernoulli_RV2 (X : bernoulliRV P p) : - P [set i | X i == 0%R] = (`1-p)%:E. +Lemma bernoulli_RV2 (X : bernoulliRV P p) : P [set i | X i == 0%R] = (`1-p)%:E. Proof. have/(congr1 (fun f => f [set 0%:R])):= @bernoulliP _ _ _ _ _ X. rewrite bernoulliE//. -rewrite /mscale/=. rewrite diracE/= memNset//. rewrite mule0// diracE/= mem_set// add0e mule1. rewrite /distribution /= => <-. -congr (P _). -rewrite /preimage/=. -by apply/seteqP; split => [x /eqP H//|x /eqP]. +by rewrite -preimage_set1. Qed. Lemma bernoulli_expectation (X : bernoulliRV P p) : 'E_P[bool_to_real R X] = p%:E. Proof. rewrite unlock. -rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. +rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o GRing.natmul 1))//; last first. by move=> y //=. rewrite /bernoulli/=. rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. @@ -1296,12 +1133,6 @@ Definition trial_value n (X : n.-tuple {RV P >-> _}) : {RV (\X_n P) >-> R : real Definition bool_trial_value n := @trial_value n \o @real_of_bool n. -(* -was wrong -Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := - (\sum_(i-> bool}) t : (0 <= bool_to_real R X t)%R. Proof. by []. Qed. @@ -1311,16 +1142,7 @@ Proof. by rewrite /bool_to_real/=; case: (X t). Qed. Lemma expectation_bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : 'E_(\X_n P)[bool_trial_value X] = (n%:R * p)%:E. Proof. -(*======= -move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(\X_n P)[\sum_(i < n) Tnth (map (bool_to_real R) X) i]). - congr expectation; apply/funext => t. - rewrite /Tnth/=. - rewrite !fct_sumE/=. - apply: eq_bigr => /= i _. - by rewrite /Tnth !tnth_map. ->>>>>>> 8b8db025 (rm tuple_sum)*) -rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. +rewrite (@expectation_sum_ipro _ _ _ _ _ _ 1%R); last first. by move=> i t; rewrite tnth_map// btr_ge0 btr_le1. transitivity (\sum_(i < n) p%:E). by apply: eq_bigr => k _; rewrite !tnth_map bernoulli_expectation. @@ -1437,6 +1259,16 @@ rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. exact: expR_ge1Dx. Qed. +End properties_of_BernoulliRV. + +(* the lemmas used in the sampling theorem that are generic w.r.t. R : realType *) +Section sampling_theorem_part1. +Local Open Scope ereal_scope. +Context {d} {T : measurableType d} {R : realType} (P : probability T R). +Variable p : R. +Hypothesis p01 : (0 <= p <= 1)%R. + +(* [end of Theorem 2.4, Rajani]*) Lemma end_thm24 n (X_ : n.-tuple (bernoulliRV P p)) (t delta : R) : (0 < delta)%R -> let X := bool_trial_value X_ in @@ -1455,7 +1287,7 @@ rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. by rewrite -powRN mulNr -mulrN expRM lnK// posrE addr_gt0. Qed. -(* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) +(* [theorem 2.4, Rajani] / [thm 4.4.(2), MU] *) Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta)%R -> let X := bool_trial_value X_ in @@ -1472,39 +1304,12 @@ apply: (le_trans (chernoff _ _ t0)). apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * (expR (- (t * ((1 + delta) * fine mu))))%:E)). rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - by apply: mmt_gen_fun_expectation; rewrite ltW. + by apply: mmt_gen_fun_expectation => //; exact: ltW. rewrite mulrC expRM -mulNr mulrA expRM. exact: end_thm24. Qed. -(* theorem 2.5 *) -Theorem bernoulli_trial_inequality2 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : - let X' := bool_trial_value X in - let mu := 'E_(\X_n P)[X'] in - (0 < n)%nat -> - (0 < delta < 1)%R -> - (\X_n P) [set i | X' i >= (1 + delta) * fine mu]%R <= - (expR (- (fine mu * delta ^+ 2) / 3))%:E. -Proof. -move=> X' mu n0 /[dup] delta01 /andP[delta0 _]. -apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). - rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. - exact: bernoulli_trial_inequality1. -apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). - rewrite lee_fin ler_expR ler_wpM2r//. - by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: bernoulli_trial_ge0. - rewrite lerB//. - apply: taylor_ln_le. - by rewrite in_itv /=. -rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. -by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. -Qed. - -(* TODO: move (to exp.v?) *) -Lemma norm_expR : normr \o expR = (expR : R -> R). -Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. - -(* Rajani thm 2.6 / mu-book thm 4.5.(2) *) +(* [Theorem 2.6, Rajani] / [thm 4.5.(2), MU] *) Theorem bernoulli_trial_inequality3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> let X' := bool_trial_value X : {RV \X_n P >-> R : realType} in @@ -1538,8 +1343,8 @@ apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. - rewrite binomial_mmt_gen_fun. - rewrite /mu /X' expectation_bernoulli_trial. + rewrite binomial_mmt_gen_fun//. + rewrite /mu /X' expectation_bernoulli_trial//. rewrite !lnK ?posrE ?subr_gt0//. rewrite expRM powRrM powRAC. rewrite ge0_ler_powR ?ler0n// ?nnegrE ?powR_ge0//. @@ -1600,9 +1405,126 @@ rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. - by rewrite in_itv /= ltr01 lexx. - by move: x01; rewrite in_itv=> /= /andP [] _ /ltW. Qed. + +End sampling_theorem_part1. + +(* this is a preliminary for the second part of the proof of the sampling lemma *) +Module with_interval. +Declare Scope bigQ_scope. +Import Reals. +Import Rstruct Rstruct_topology. +Import Interval.Tactic. + +Section expR2_le8. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. + +Lemma expR2_le8 : expR 2 <= 8 :> R. +Proof. +rewrite (_ : 2 = 1 + 1)//. +rewrite exp.expRD -RmultE. +rewrite (_ : 8 = 8%R); last first. + by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. +rewrite (_ : 1 = INR 1%N)//=. +rewrite -RexpE. +apply/RleP. +by interval. +Qed. + +End expR2_le8. +End with_interval. + +Section taylor_ln_le. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. + +Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. +Proof. +move=> x01; rewrite -subr_ge0. +pose f (x : R^o) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). +have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. +rewrite [leRHS](_ : _ = f x) // -f0. +evar (df0 : R -> R); evar (df : R -> R). +have idf (y : R^o) : 0 < 1 + y -> is_derive y (1:R) f (df y). + move=> y1. + rewrite (_ : df y = df0 y). + apply: is_deriveB; last exact: is_deriveD. + apply: is_deriveM=> //. + apply: is_derive1_comp=> //. + exact: is_derive1_ln. + rewrite /df0. + rewrite deriveD// derive_cst derive_id. + rewrite /GRing.scale /= !(mulr0,add0r,mulr1). + rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. + instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). + reflexivity. +clear df0. +have y1cc y : y \in `[0, 1] -> 0 < 1 + y. + rewrite in_itv /= => /andP [] y0 ?. + by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. +have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. +have dfge0 y : y \in `]0, 1[ -> 0 <= df y. + move=> y01. + have:= y01. + rewrite /df in_itv /= => /andP [] y0 y1. + rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. + rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. + pose iy:= Itv01 (ltW y0) (ltW y1). + have y1E: 1 + y = @convex.conv _ R^o iy 1 2. + rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. + by rewrite addrACA (addrC (- y)) subrr addr0. + rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. + rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. + rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. + rewrite ler_pdivrMr//. + rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. + rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. + rewrite !exprS expr0 mulr1 -!natrM mulnE /=. + by rewrite with_interval.expR2_le8. +apply: (@ger0_derive1_homo R f 0 1 true false). +- by move=> y /y1oo /idf /@ex_derive. +- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. +- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. +- by rewrite bound_itvE. +- exact: subset_itv_oo_cc. +- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. +Qed. + +End taylor_ln_le. + +(* the rest of the sampling theorem including lemmas relying on the Rocq standard library *) +Section sampling_theorem_part2. +Local Open Scope ereal_scope. +Let R := Rdefinitions.R. +Context d (T : measurableType d) (P : probability T R). +Variable p : R. +Hypothesis p01 : (0 <= p <= 1)%R. Local Open Scope ereal_scope. -(* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) +(* [Theorem 2.5, Rajani] *) +Theorem bernoulli_trial_inequality2 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : + let X' := bool_trial_value X in + let mu := 'E_(\X_n P)[X'] in + (0 < n)%nat -> + (0 < delta < 1)%R -> + (\X_n P) [set i | X' i >= (1 + delta) * fine mu]%R <= + (expR (- (fine mu * delta ^+ 2) / 3))%:E. +Proof. +move=> X' mu n0 /[dup] delta01 /andP[delta0 _]. +apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). + rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. + exact: bernoulli_trial_inequality1. +apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). + rewrite lee_fin ler_expR ler_wpM2r//. + by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: bernoulli_trial_ge0. + rewrite lerB//. + apply: taylor_ln_le. + by rewrite in_itv /=. +rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. +by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. +Qed. + +(* [Ccorollary 2.7, Rajani] / [Corollary 4.7, MU] *) Corollary bernoulli_trial_inequality4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> (0 < n)%nat -> @@ -1643,7 +1565,7 @@ rewrite measureU; last 3 first. rewrite mulr2n EFinD leeD//=. - by apply: bernoulli_trial_inequality2; rewrite //d0 d1. - have d01 : (0 < delta < 1)%R by rewrite d0. - apply: (le_trans (@bernoulli_trial_inequality3 _ X delta d01)). + apply: (le_trans (@bernoulli_trial_inequality3 _ _ _ _ p p01 _ X delta d01)). rewrite lee_fin ler_expR !mulNr lerN2. rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. @@ -1651,7 +1573,7 @@ rewrite mulr2n EFinD leeD//=. by rewrite /X' lee_fin; exact: bernoulli_trial_ge0. Qed. -(* Rajani thm 3.1 / mu-book thm 4.7 *) +(* [Theorem 3.1, Rajani] / [thm 4.7, MU] *) Theorem sampling n (X : n.-tuple (bernoulliRV P p)) (theta delta : R) : let X' x := (bool_trial_value X x) / n%:R in (0 < p)%R -> @@ -1681,7 +1603,7 @@ have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= by rewrite -mulrA divff ?mulr1// gt_eqF// ltr0n. rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. - rewrite -(mulrC _ p) -(expectation_bernoulli_trial X). + rewrite -(mulrC _ p) -(expectation_bernoulli_trial p01 X). exact: (@bernoulli_trial_inequality4 _ X epsilon). have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. @@ -1723,4 +1645,4 @@ rewrite -ler_pdivrMr; last by rewrite exprn_gt0. by rewrite mulrAC. Qed. -End bernoulli. +End sampling_theorem_part2. From 11d4bab4e8f71f7cbf7ef4932b083ec9fdeba56e Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Mon, 17 Mar 2025 17:42:25 +0900 Subject: [PATCH 63/73] exp2_le8 simplified --- theories/sampling.v | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 35d50455c1..a2675770fb 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1415,23 +1415,21 @@ Import Reals. Import Rstruct Rstruct_topology. Import Interval.Tactic. -Section expR2_le8. +Section exp2_le8. Let R := Rdefinitions.R. Local Open Scope ring_scope. -Lemma expR2_le8 : expR 2 <= 8 :> R. +Lemma exp2_le8 : (exp 2 <= 8)%R. +Proof. interval. Qed. + +Lemma exp2_le8_conversion : reflect (exp 2 <= 8)%R (expR 2 <= 8 :> R). Proof. -rewrite (_ : 2 = 1 + 1)//. -rewrite exp.expRD -RmultE. -rewrite (_ : 8 = 8%R); last first. +rewrite RexpE (_ : 8%R = 8); last by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. -rewrite (_ : 1 = INR 1%N)//=. -rewrite -RexpE. -apply/RleP. -by interval. +by apply: (iffP idP) => /RleP. Qed. -End expR2_le8. +End exp2_le8. End with_interval. Section taylor_ln_le. @@ -1480,7 +1478,7 @@ have dfge0 y : y \in `]0, 1[ -> 0 <= df y. rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. rewrite !exprS expr0 mulr1 -!natrM mulnE /=. - by rewrite with_interval.expR2_le8. + exact/with_interval.exp2_le8_conversion/with_interval.exp2_le8. apply: (@ger0_derive1_homo R f 0 1 true false). - by move=> y /y1oo /idf /@ex_derive. - by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. From cbcf1ead7d876fb38dbe7914045da963f6596680 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 17 Mar 2025 17:43:28 +0900 Subject: [PATCH 64/73] remove unused lemmas from probability.v --- theories/probability.v | 190 ++-------------------------------------- theories/sampling.v | 71 ++++++++++++++- theories/sampling_wip.v | 69 +++++++++++++++ 3 files changed, 144 insertions(+), 186 deletions(-) diff --git a/theories/probability.v b/theories/probability.v index c5299067af..a66dc3bad8 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -93,41 +93,10 @@ Definition random_variable d d' (T : measurableType d) (T' : measurableType d') Notation "{ 'RV' P >-> T' }" := (@random_variable _ _ _ T' _ P) : form_scope. -Section move_to_somewhere. - -Lemma mulr_funEcomp (R : semiRingType) (T : Type) (x : R) (f : T -> R) : - x \o* f = *%R^~ x \o f. -Proof. by []. Qed. - -Lemma bounded_image (T : Type) (K : numFieldType) - (V : pseudoMetricNormedZmodType K) (E : T -> V) (A : set T) : - [bounded y | y in E @` A] = [bounded E x | x in A]. -Proof. -rewrite /bounded_near !nearE. -congr (+oo _); apply: funext=> M. -apply: propext; split => /=. - by move=> + x Ax => /(_ (E x)); apply; exists x. -by move=> H x [] y Ay <-; exact: H. -Qed. - -Lemma finite_bounded (K : realFieldType) (V : pseudoMetricNormedZmodType K) - (A : set V) : finite_set A -> bounded_set A. -Proof. -move=> fA. -exists (\big[Order.max/0]_(y <- fset_set A) normr y). -split=> //. - apply: (big_ind (fun x => x \is Num.real))=> //. - by move=> *; exact: max_real. -move=> x ltx v Av /=. -apply/ltW/(le_lt_trans _ ltx)/le_bigmax_seq=> //. -by rewrite in_fset_set// inE. -Qed. +(* TODO: move elsewhere *) +Section todo_move. Arguments sub_countable [T U]. -Arguments card_le_finite [T U]. -(* naming inconsistency: there is also `sub_finite_set`: - sub_finite_set : - forall [T : Type] [A B : set T], A `<=` B -> finite_set B -> finite_set A *) Lemma countable_range_comp (T0 T1 T2 : Type) (f : T0 -> T1) (g : T1 -> T2) : countable (range f) \/ countable (range g) -> countable (range (g \o f)). @@ -140,163 +109,14 @@ move=> cg; apply: (sub_countable _ (range g))=> //. exact/subset_card_le/image_subset. Qed. -Lemma finite_range_comp (T0 T1 T2 : Type) (f : T0 -> T1) (g : T1 -> T2) : - finite_set (range f) \/ finite_set (range g) -> finite_set (range (g \o f)). -Proof. -rewrite -(image_comp f g). -case. - move=> cf; apply: (card_le_finite _ (range f))=> //. - exact: card_image_le. -move=> cg; apply: (card_le_finite _ (range g))=> //. -exact/subset_card_le/image_subset. -Qed. - -(* generalizations with an additional predicate (m <= i)%N as in big_geq_mkord *) -Lemma lee_sum_fset_nat_geq (R : realDomainType) (f : sequence \bar R) - (F : {fset nat}) (m n : nat) (P : pred nat) : - (forall i : nat, P i -> (0%R <= f i)%E) -> - [set` F] `<=` `I_n -> - ((\sum_(i <- F | P i && (m <= i)%N) f i)%R - <= (\sum_(m <= i < n | P i) f i)%R)%E. -Proof. -move=> f0 Fn. -rewrite big_geq_mkord/= -(big_mkord (fun i => P i && (m <= i)%N)). -apply: lee_sum_fset_nat=> //. -by move=> ? /andP [] *; exact: f0. -Qed. -Arguments lee_sum_fset_nat_geq {R f} F m n P. - -Lemma lee_sum_fset_lim_geq (R : realType) (f : sequence \bar R) - (F : {fset nat}) m (P : pred nat) : - (forall i : nat, P i -> (0%R <= f i)%E) -> - ((\sum_(i <- F | P i && (m <= i)%N) f i)%R - <= \big[+%R/0%R]_(m <= i f0; pose n := (\max_(k <- F) k).+1. -rewrite (le_trans (lee_sum_fset_nat_geq F m n _ _ _))//; last first. - by apply: nneseries_lim_ge => // k _; exact: f0. -move=> k /= kF; rewrite /n big_seq_fsetE/=. -by rewrite -[k]/(val [`kF]%fset) ltnS leq_bigmax. -Qed. -Arguments lee_sum_fset_lim_geq {R f} F m P. - -Lemma nneseries_esum_geq (R : realType) (a : nat -> \bar R) m (P : pred nat) : - (forall n : nat, P n -> (0%R <= a n)%E) -> - \big[+%R/0]_(m <= i a0; apply/eqP; rewrite eq_le; apply/andP; split. - apply: lime_le. - by apply: is_cvg_nneseries_cond => n _; exact: a0. - apply: nearW=> n. - apply: ereal_sup_ubound; exists [set` [fset val i | i in 'I_n & P i && (m <= i)%N]%fset]. - split; first exact: finite_fset. - by move=> /= k /imfsetP[/= i]; rewrite inE => + ->. - rewrite fsbig_finite//= set_fsetK big_imfset/=; last first. - by move=> ? ? ? ? /val_inj. - by rewrite big_filter big_enum_cond/= big_geq_mkord. -apply: ub_ereal_sup => _ [/= F [finF PF] <-]. -rewrite fsbig_finite//= -(big_rmcond_in (fun i=> P i && (m <= i)%N))/=. - exact: lee_sum_fset_lim_geq. -by move=> k; rewrite in_fset_set// inE => /PF ->. -Qed. - -Lemma nneseriesID (R : realType) m (a P : pred nat) (f : nat -> \bar R): - (forall k : nat, P k -> (0%R <= f k)%E) -> - \big[+%R/0]_(m <= k nn. -rewrite nneseries_esum_geq//. -rewrite (esumID a)/=; last by move=> ? /andP [] *; exact: nn. -have->: [set x | P x && (m <= x)%N] `&` (fun x : nat => a x) = - [set x | (P x && a x) && (m <= x)%N]. - by apply: funext=> x /=; rewrite (propext (rwP andP)) andbAC. -have->: [set x | P x && (m <= x)%N] `&` ~` (fun x : nat => a x) = - [set x | (P x && ~~ a x) && (m <= x)%N]. - apply: funext=> x /=. - by rewrite (propext (rwP negP)) (propext (rwP andP)) andbAC. -by rewrite -!nneseries_esum_geq//; move=> ? /andP [] *; exact: nn. -Qed. - -(* TODO: this generalize subset_itv! *) -Lemma subset_itvW_bound (d : Order.disp_t) (T : porderType d) - (x y z u : itv_bound T) : - (x <= y)%O -> (z <= u)%O -> [set` Interval y z] `<=` [set` Interval x u]. -Proof. -move=> xy zu. -by apply: (@subset_trans _ [set` Interval x z]); - [exact: subset_itvr | exact: subset_itvl]. -Qed. - -Lemma gtr0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : - (forall x : R, x \in `]a, b[ -> derivable f x 1) -> - (forall x : R, x \in `]a, b[ -> 0 < 'D_1 f x) -> - {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> - {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x < y >-> x < y}}. -Proof. -move=> df dfgt0 cf x y + + xy. -rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. -have HMVT1: {within `[x, y], continuous f}%classic. - exact/(continuous_subspaceW _ cf)/subset_itvW_bound. -have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itvW_bound. - by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. - by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. -have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). - by move=> zxy; exact/derivableP/df/zab. -rewrite -subr_gt0. -have[z zxy ->]:= MVT xy HMVT0 HMVT1. -rewrite mulr_gt0// ?subr_gt0// dfgt0//. -exact: zab. -Qed. - -Lemma ger0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : - (forall x : R, x \in `]a, b[ -> derivable f x 1) -> - (forall x : R, x \in `]a, b[ -> 0 <= 'D_1 f x) -> - {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> - {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x <= y >-> x <= y}}. -Proof. -move=> df dfge0 cf x y + + xy. -rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. -have HMVT1: {within `[x, y], continuous f}%classic. - exact/(continuous_subspaceW _ cf)/subset_itvW_bound. -have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itvW_bound. - by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. - by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. -have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). - by move=> zxy; exact/derivableP/df/zab. -rewrite -subr_ge0. -move: (xy); rewrite le_eqVlt=> /orP [/eqP-> | xy']; first by rewrite subrr. -have[z zxy ->]:= MVT xy' HMVT0 HMVT1. -rewrite mulr_ge0// ?subr_ge0// dfge0//. -exact: zab. -Qed. - -Lemma memB_itv (R : numDomainType) (b0 b1 : bool) (x y z : R) : - (y - z \in Interval (BSide b0 x) (BSide b1 y)) = - (x + z \in Interval (BSide (~~ b1) x) (BSide (~~ b0) y)). -Proof. -rewrite !in_itv /= /Order.lteif !if_neg. -by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. -Qed. - -(* generalizes mem_1B_itvcc *) -Lemma memB_itv0 (R : numDomainType) (b0 b1 : bool) (x y : R) : - (y - x \in Interval (BSide b0 0) (BSide b1 y)) = - (x \in Interval (BSide (~~ b1) 0) (BSide (~~ b0) y)). -Proof. by rewrite memB_itv add0r. Qed. - -End move_to_somewhere. -Arguments countable_range_comp [T0 T1 T2]. -Arguments finite_range_comp [T0 T1 T2]. - Lemma notin_range_measure d d' (T : measurableType d) (T' : measurableType d') (R : realType) (P : {measure set T -> \bar R}) (X : T -> R) r : r \notin range X -> P (X @^-1` [set r]) = 0%E. Proof. by rewrite notin_setE => hr; rewrite preimage10. Qed. +End todo_move. +Arguments countable_range_comp [T0 T1 T2]. + Lemma probability_range d d' (T : measurableType d) (T' : measurableType d') (R : realType) (P : probability T R) (X : {RV P >-> R}) : P (X @^-1` range X) = 1%E. diff --git a/theories/sampling.v b/theories/sampling.v index a2675770fb..9c3854bf40 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -48,6 +48,20 @@ Import numFieldTopology.Exports numFieldNormedType.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +Lemma memB_itv (R : numDomainType) (b0 b1 : bool) (x y z : R) : + (y - z \in Interval (BSide b0 x) (BSide b1 y)) = + (x + z \in Interval (BSide (~~ b1) x) (BSide (~~ b0) y)). +Proof. +rewrite !in_itv /= /Order.lteif !if_neg. +by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. +Qed. + +(* generalizes mem_1B_itvcc *) +Lemma memB_itv0 (R : numDomainType) (b0 b1 : bool) (x y : R) : + (y - x \in Interval (BSide b0 0) (BSide b1 y)) = + (x \in Interval (BSide (~~ b1) 0) (BSide (~~ b0) y)). +Proof. by rewrite memB_itv add0r. Qed. + Section bool_to_real. Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). @@ -172,6 +186,61 @@ rewrite big_ord_recl lte_mul_pinfty//. by rewrite ih. Qed. +(* TODO: this generalize subset_itv! *) +Lemma subset_itvW_bound (d : Order.disp_t) (T : porderType d) + (x y z u : itv_bound T) : + (x <= y)%O -> (z <= u)%O -> [set` Interval y z] `<=` [set` Interval x u]. +Proof. +move=> xy zu. +by apply: (@subset_trans _ [set` Interval x z]); + [exact: subset_itvr | exact: subset_itvl]. +Qed. + +Lemma gtr0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : + (forall x : R, x \in `]a, b[ -> derivable f x 1) -> + (forall x : R, x \in `]a, b[ -> 0 < 'D_1 f x) -> + {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> + {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x < y >-> x < y}}. +Proof. +move=> df dfgt0 cf x y + + xy. +rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. +have HMVT1: {within `[x, y], continuous f}%classic. + exact/(continuous_subspaceW _ cf)/subset_itvW_bound. +have zab z : z \in `]x, y[ -> z \in `]a, b[. + apply: subset_itvW_bound. + by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. + by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. +have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). + by move=> zxy; exact/derivableP/df/zab. +rewrite -subr_gt0. +have[z zxy ->]:= MVT xy HMVT0 HMVT1. +rewrite mulr_gt0// ?subr_gt0// dfgt0//. +exact: zab. +Qed. + +Lemma ger0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : + (forall x : R, x \in `]a, b[ -> derivable f x 1) -> + (forall x : R, x \in `]a, b[ -> 0 <= 'D_1 f x) -> + {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> + {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x <= y >-> x <= y}}. +Proof. +move=> df dfge0 cf x y + + xy. +rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. +have HMVT1: {within `[x, y], continuous f}%classic. + exact/(continuous_subspaceW _ cf)/subset_itvW_bound. +have zab z : z \in `]x, y[ -> z \in `]a, b[. + apply: subset_itvW_bound. + by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. + by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. +have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). + by move=> zxy; exact/derivableP/df/zab. +rewrite -subr_ge0. +move: (xy); rewrite le_eqVlt=> /orP [/eqP-> | xy']; first by rewrite subrr. +have[z zxy ->]:= MVT xy' HMVT0 HMVT1. +rewrite mulr_ge0// ?subr_ge0// dfge0//. +exact: zab. +Qed. + Section integrable_theory. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). @@ -1370,7 +1439,7 @@ rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. rewrite -(@ler_pM2r _ 2)// -mulrA mulVf// mulr1 mulrDl. rewrite -subr_le0 mulNr opprK. rewrite addrC !addrA. - have->: delta ^+ 2 - delta * 2 = (1 - delta)^+2 - 1. + have -> : delta ^+ 2 - delta * 2 = (1 - delta)^+2 - 1. rewrite sqrrB expr1n mul1r [RHS]addrC !addrA addNr add0r addrC -mulNrn. by rewrite -(mulr_natr (- delta) 2) mulNr. rewrite addrAC subr_le0. diff --git a/theories/sampling_wip.v b/theories/sampling_wip.v index d04b48c23d..cd9c5833b4 100644 --- a/theories/sampling_wip.v +++ b/theories/sampling_wip.v @@ -433,6 +433,75 @@ Qed. End independent_RVs. +(* TODO: this generalize subset_itv! *) +Lemma subset_itvW_bound (d : Order.disp_t) (T : porderType d) + (x y z u : itv_bound T) : + (x <= y)%O -> (z <= u)%O -> [set` Interval y z] `<=` [set` Interval x u]. +Proof. +move=> xy zu. +by apply: (@subset_trans _ [set` Interval x z]); + [exact: subset_itvr | exact: subset_itvl]. +Qed. + +Lemma memB_itv (R : numDomainType) (b0 b1 : bool) (x y z : R) : + (y - z \in Interval (BSide b0 x) (BSide b1 y)) = + (x + z \in Interval (BSide (~~ b1) x) (BSide (~~ b0) y)). +Proof. +rewrite !in_itv /= /Order.lteif !if_neg. +by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. +Qed. + +(* generalizes mem_1B_itvcc *) +Lemma memB_itv0 (R : numDomainType) (b0 b1 : bool) (x y : R) : + (y - x \in Interval (BSide b0 0) (BSide b1 y)) = + (x \in Interval (BSide (~~ b1) 0) (BSide (~~ b0) y)). +Proof. by rewrite memB_itv add0r. Qed. + +Lemma gtr0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : + (forall x : R, x \in `]a, b[ -> derivable f x 1) -> + (forall x : R, x \in `]a, b[ -> 0 < 'D_1 f x) -> + {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> + {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x < y >-> x < y}}. +Proof. +move=> df dfgt0 cf x y + + xy. +rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. +have HMVT1: {within `[x, y], continuous f}%classic. + exact/(continuous_subspaceW _ cf)/subset_itvW_bound. +have zab z : z \in `]x, y[ -> z \in `]a, b[. + apply: subset_itvW_bound. + by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. + by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. +have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). + by move=> zxy; exact/derivableP/df/zab. +rewrite -subr_gt0. +have[z zxy ->]:= MVT xy HMVT0 HMVT1. +rewrite mulr_gt0// ?subr_gt0// dfgt0//. +exact: zab. +Qed. + +Lemma ger0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : + (forall x : R, x \in `]a, b[ -> derivable f x 1) -> + (forall x : R, x \in `]a, b[ -> 0 <= 'D_1 f x) -> + {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> + {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x <= y >-> x <= y}}. +Proof. +move=> df dfge0 cf x y + + xy. +rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. +have HMVT1: {within `[x, y], continuous f}%classic. + exact/(continuous_subspaceW _ cf)/subset_itvW_bound. +have zab z : z \in `]x, y[ -> z \in `]a, b[. + apply: subset_itvW_bound. + by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. + by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. +have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). + by move=> zxy; exact/derivableP/df/zab. +rewrite -subr_ge0. +move: (xy); rewrite le_eqVlt=> /orP [/eqP-> | xy']; first by rewrite subrr. +have[z zxy ->]:= MVT xy' HMVT0 HMVT1. +rewrite mulr_ge0// ?subr_ge0// dfge0//. +exact: zab. +Qed. + Section bool_to_real. Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). From 5d1b43a6eebf555adbc8fccb0d86584f3dbbe034 Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Tue, 18 Mar 2025 17:40:08 +0900 Subject: [PATCH 65/73] analytical argument - rename analytical arguments to xlnx_lbound_i01 and xlnx_lbound_i12 --- theories/sampling.v | 159 ++++++++++++++++++++++++++++++++------------ 1 file changed, 115 insertions(+), 44 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 9c3854bf40..c8dda56e9b 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1378,6 +1378,111 @@ rewrite mulrC expRM -mulNr mulrA expRM. exact: end_thm24. Qed. +Section xlnx_bounding. +Local Open Scope ring_scope. +Local Arguments derive_val {R V W a v f df}. + +Let f (x : R) := x ^+ 2 - 2 * x * ln x. +Let idf (x : R) : 0 < x -> {df : R | is_derive x 1 f df}. +Proof. +move=> x0. +evar (df : (R : Type)); exists df. +apply: is_deriveD; first by []. +apply: is_deriveN. +apply: is_deriveM; first by []. +exact: is_derive1_ln. +Defined. +Let f1E : f 1 = 1. Proof. by rewrite /f expr1n ln1 !mulr0 subr0. Qed. +Let Df_gt0 (x : R) : 0 < x -> x != 1 -> 0 < 'D_1 f x. +Proof. +move=> x0 x1. +rewrite (derive_val (svalP (idf x0))) /=. +clear idf. +rewrite exp_derive deriveM// derive_cst derive_id . +rewrite scaler0 addr0 /GRing.scale /= !mulr1 expr1. +rewrite -mulrA divff ?lt0r_neq0//. +rewrite (mulrC _ 2) -mulrDr -mulrBr mulr_gt0//. +rewrite opprD addrA subr_gt0 -ltr_expR. +have:= x0; rewrite -lnK_eq => /eqP ->. +rewrite -[ltLHS]addr0 -(subrr 1) addrCA expR_gt1Dx//. +by rewrite subr_eq0. +Qed. + +Let sqrxB2xlnx_lt1 (c x : R) : + x \in `]0, 1[ -> x ^+ 2 - 2 * x * ln x < 1. +Proof. +rewrite in_itv=> /andP [] x0 x1. +fold (f x). +simpl in idf. +rewrite -f1E. +apply: (@gtr0_derive1_homo _ f 0 1 false false). +- move=> t /[!in_itv] /= /andP [] + _. + by case/idf=> ? /@ex_derive. +- move=> t /[!in_itv] /= /andP [] t0 t1. + apply: Df_gt0=> //. + by rewrite (lt_eqF t1). +- apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _. + by case/idf=> ? /@ex_derive. +- by rewrite in_itv/=; apply/andP; split=> //; apply/ltW. +- by rewrite in_itv /= ltr01 lexx. +- assumption. +Qed. + +Let sqrxB2xlnx_gt1 (c x : R) : + 1 < x -> 1 < x ^+ 2 - 2 * x * ln x. +Proof. +move=> x1. +have x0 : 0 < x by rewrite (lt_trans _ x1). +fold (f x). +simpl in idf. +rewrite -f1E. +apply: (@gtr0_derive1_homo _ f 1 x true false). +- move=> t /[!in_itv] /= /andP [] + _ => t1. + have: 0 < t by rewrite (lt_trans _ t1). + by case/idf=> ? /@ex_derive. +- move=> t /[!in_itv] /= /andP [] t1 tx. + have t0: 0 < t by rewrite (lt_trans _ t1). + apply: Df_gt0=> //. + by rewrite (gt_eqF t1). +- apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _ => t1. + have: 0 < t by rewrite (lt_le_trans _ t1). + by case/idf=> ? /@ex_derive. +- by rewrite in_itv/=; apply/andP; split=> //; apply/ltW. +- by rewrite in_itv /= lexx andbT ltW. +- assumption. +Qed. + +Lemma xlnx_lbound_i01 (c x : R) : + c <= 2 -> x \in `]0, 1[ -> x ^+ 2 - 1 < c * x * ln x. +Proof. +pose c' := c - 2. +have-> : c = c' + 2 by rewrite /c' addrAC -addrA subrr addr0. +rewrite -lerBrDr subrr. +move: c'; clear c => c. +rewrite ltrBlDr -ltrBlDl. +rewrite le_eqVlt=> /orP [/eqP-> |]; first by rewrite add0r; exact: sqrxB2xlnx_lt1. +move=> c0 /[dup] x01 /[!in_itv] /andP [] x0 x1. +rewrite -mulrA (addrC c) mulrDl !mulrA opprD addrA. +rewrite -[ltRHS]addr0 ltrD// ?sqrxB2xlnx_lt1// oppr_lt0. +by rewrite -mulrA nmulr_lgt0// nmulr_llt0// ln_lt0. +Qed. + +Lemma xlnx_ubound_i1y (c x : R) : + c <= 2 -> 1 < x -> c * x * ln x < x ^+ 2 - 1. +Proof. +pose c' := c - 2. +have-> : c = c' + 2 by rewrite /c' addrAC -addrA subrr addr0. +rewrite -lerBrDr subrr. +move: c'; clear c => c. +rewrite ltrBrDr -ltrBrDl. +rewrite le_eqVlt=> /orP [/eqP-> |]; first by rewrite add0r; exact: sqrxB2xlnx_gt1. +move=> c0 x1. +rewrite -mulrA (addrC c) mulrDl !mulrA opprD addrA. +rewrite -[ltLHS]addr0 ltrD// ?sqrxB2xlnx_gt1// oppr_gt0. +by rewrite nmulr_rlt0 ?ln_gt0// nmulr_rlt0 ?(lt_trans _ x1). +Qed. +End xlnx_bounding. + (* [Theorem 2.6, Rajani] / [thm 4.5.(2), MU] *) Theorem bernoulli_trial_inequality3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> @@ -1434,47 +1539,13 @@ rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. rewrite expRK// ln_div ?posrE ?expR_gt0 ?powR_gt0 ?subr_gt0//. rewrite expRK//. rewrite /powR (*TODO: lemma ln of powR*) gt_eqF ?subr_gt0// expRK. - (* requires analytical argument: see p.66 of mu's book *) - Local Open Scope ring_scope. - rewrite -(@ler_pM2r _ 2)// -mulrA mulVf// mulr1 mulrDl. - rewrite -subr_le0 mulNr opprK. - rewrite addrC !addrA. - have -> : delta ^+ 2 - delta * 2 = (1 - delta)^+2 - 1. - rewrite sqrrB expr1n mul1r [RHS]addrC !addrA addNr add0r addrC -mulNrn. - by rewrite -(mulr_natr (- delta) 2) mulNr. - rewrite addrAC subr_le0. - set f := fun (x : R) => x ^+ 2 + - (x * ln x) * 2. - have @idf (x : R^o) : 0 < x -> {df | is_derive x 1 (f : R^o -> R^o) df}. - move=> x0; evar (df : (R : Type)); exists df. - apply: is_deriveD; first by []. - apply: is_deriveM; last by []. - apply: is_deriveN. - apply: is_deriveM; first by []. - exact: is_derive1_ln. - suff: forall x : R, x \in `]0, 1[ -> f x <= 1. - by apply; rewrite memB_itv0 in_itv /= delta0 delta1. - move=> x x01. - have->: 1 = f 1 by rewrite /f expr1n ln1 mulr0 oppr0 mul0r addr0. - apply: (@ger0_derive1_homo _ f 0 1 false false)=> //. - - move=> t /[!in_itv] /= /andP [] + _. - by case/idf=> ? /@ex_derive. - - move=> t /[!in_itv] /= /andP [] t0 t1. - Local Arguments derive_val {R V W a v f df}. - rewrite (derive_val (svalP (idf _ t0))) /=. - clear idf. - rewrite exp_derive derive_cst derive_id . - rewrite scaler0 add0r /GRing.scale /= !mulr1 expr1. - rewrite -mulrDr mulr_ge0// divff ?lt0r_neq0//. - rewrite opprD addrA subr_ge0 -ler_expR. - have:= t0; rewrite -lnK_eq => /eqP ->. - by rewrite -[leLHS]addr0 -(subrr 1) addrCA expR_ge1Dx. - - apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _. - by case/idf=> ? /@ex_derive. - - by apply: (subset_itvW_bound _ _ x01); rewrite bnd_simp. - - by rewrite in_itv /= ltr01 lexx. - - by move: x01; rewrite in_itv=> /= /andP [] _ /ltW. + (* analytical argument reduced to xlnx_lbound_i01; p.66 of mu's book *) + rewrite ler_pdivlMr// mulrDl. + rewrite -lerBrDr -lerBlDl !mulNr !opprK [in leRHS](mulrC _ 2) mulrA. + rewrite ltW// (le_lt_trans _ (xlnx_lbound_i01 _ _))//; last first. + by rewrite memB_itv add0r in_itv/=; apply/andP; split. + by rewrite addrC lerBrDr mulr_natr -[in leRHS]sqrrN opprB sqrrB1. Qed. - End sampling_theorem_part1. (* this is a preliminary for the second part of the proof of the sampling lemma *) @@ -1501,11 +1572,11 @@ Qed. End exp2_le8. End with_interval. -Section taylor_ln_le. +Section xlnx_bounding_with_interval. Let R := Rdefinitions.R. Local Open Scope ring_scope. -Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. +Lemma xlnx_lbound_i12 (x : R) : x \in `]0, 1[ -> x + x^+2 / 3 <= (1 + x) * ln (1 + x). Proof. move=> x01; rewrite -subr_ge0. pose f (x : R^o) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). @@ -1557,7 +1628,7 @@ apply: (@ger0_derive1_homo R f 0 1 true false). - by have:= x01; rewrite in_itv=> /andP /= [] /ltW. Qed. -End taylor_ln_le. +End xlnx_bounding_with_interval. (* the rest of the sampling theorem including lemmas relying on the Rocq standard library *) Section sampling_theorem_part2. @@ -1585,7 +1656,7 @@ apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). rewrite lee_fin ler_expR ler_wpM2r//. by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: bernoulli_trial_ge0. rewrite lerB//. - apply: taylor_ln_le. + apply: xlnx_lbound_i12. by rewrite in_itv /=. rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. From 3664ed8b3b3e2531145261d1f6d480852c15b114 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Sat, 22 Mar 2025 00:53:18 +0900 Subject: [PATCH 66/73] progress - wip sampling - start of product expectation - qed expectation_prod_nondep - product using lfun --- _CoqProject | 1 - classical/functions.v | 9 + theories/exp.v | 3 + theories/hoelder.v | 59 +- theories/probability.v | 76 +- theories/sampling.v | 570 +++++---- theories/sampling_wip.v | 2705 --------------------------------------- 7 files changed, 358 insertions(+), 3065 deletions(-) delete mode 100644 theories/sampling_wip.v diff --git a/_CoqProject b/_CoqProject index 967ac9423f..a2b2d6530a 100644 --- a/_CoqProject +++ b/_CoqProject @@ -114,7 +114,6 @@ theories/ftc.v theories/hoelder.v theories/probability.v theories/sampling.v -theories/sampling_wip.v theories/convex.v theories/charge.v theories/kernel.v diff --git a/classical/functions.v b/classical/functions.v index 1af52e51fe..f450a139de 100644 --- a/classical/functions.v +++ b/classical/functions.v @@ -2654,6 +2654,11 @@ Lemma fct_sumE (I T : Type) (M : nmodType) r (P : {pred I}) (f : I -> T -> M) (\sum_(i <- r | P i) f i) x = \sum_(i <- r | P i) f i x. Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. +Lemma fct_prodE (I : Type) (T : pointedType) (M : comRingType) r (P : {pred I}) + (f : I -> T -> M) (x : T) : + (\prod_(i <- r | P i) f i) x = \prod_(i <- r | P i) f i x. +Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. + Lemma mul_funC (T : Type) {R : comSemiRingType} (f : T -> R) (r : R) : r \*o f = r \o* f. Proof. by apply/funext => x/=; rewrite mulrC. Qed. @@ -2676,6 +2681,10 @@ Lemma natmulfctE (U : Type) (K : nmodType) (f : U -> K) n : f *+ n = (fun x => f x *+ n). Proof. by elim: n => [//|n h]; rewrite funeqE=> ?; rewrite !mulrSr h. Qed. +Lemma prodrfctE (T : pointedType) (K : comRingType) (s : seq (T -> K)) : + \prod_(f <- s) f = (fun x => \prod_(f <- s) f x). +Proof. by apply/funext => x;elim/big_ind2 : _ => // _ a _ b <- <-. Qed. + Lemma opprfctE (T : Type) (K : zmodType) (f : T -> K) : - f = (fun x => - f x). Proof. by []. Qed. diff --git a/theories/exp.v b/theories/exp.v index 1fbb0b65dc..42e20f35e2 100644 --- a/theories/exp.v +++ b/theories/exp.v @@ -536,6 +536,9 @@ have /expR_total_gt1[y [H1y H2y H3y]] : 1 <= x^-1 by rewrite ltW // !invf_cp1. by exists (-y); rewrite expRN H3y invrK. Qed. +Lemma norm_expR : normr \o expR = (expR : R -> R). +Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. + Local Open Scope convex_scope. Lemma convex_expR (t : {i01 R}) (a b : R^o) : expR (a <| t |> b) <= (expR a : R^o) <| t |> (expR b : R^o). diff --git a/theories/hoelder.v b/theories/hoelder.v index b33f8162e8..5dccdf06bb 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -949,20 +949,25 @@ by under eq_integral => x _ do rewrite gee0_abs ?lee_fin ?powR_ge0//. Qed. Lemma lfun1_integrable (f : T -> R) : - f \in lfun mu 1 -> mu.-integrable setT (EFin \o f). + f \in lfun mu 1 <-> mu.-integrable setT (EFin \o f). Proof. -move=> /[dup] lf /lfun_integrable => /(_ (lexx _)). -under eq_fun => x do rewrite powRr1//. -move/integrableP => [mf fley]. -apply/integrableP; split. - move: lf; rewrite inE => /andP[/[!inE]/= {}mf _]. - exact: measurableT_comp. -rewrite (le_lt_trans _ fley)//=. -by under [leRHS]eq_integral => x _ do rewrite normr_id. +split. + move=> /[dup] lf /lfun_integrable => /(_ (lexx _)). + under eq_fun => x do rewrite powRr1//. + move/integrableP => [mf fley]. + apply/integrableP; split. + move: lf; rewrite inE => /andP[/[!inE]/= {}mf _]. + exact: measurableT_comp. + rewrite (le_lt_trans _ fley)//=. + by under [leRHS]eq_integral => x _ do rewrite normr_id. +move/integrableP => [mF iF]. +rewrite inE; apply/andP; split; rewrite inE/=. + exact/measurable_EFinP. +by rewrite /finite_norm Lnorm1. Qed. -Lemma lfun2_integrable_sqr (f : T -> R) : f \in lfun mu 2%:E -> - mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). +Lemma lfun2_integrable_sqr (f : T -> R) : + f \in lfun mu 2%:E -> mu.-integrable [set: T] (EFin \o (fun x => f x ^+ 2)). Proof. rewrite inE => /andP[mf]; rewrite inE/= => l2f. move: mf; rewrite inE/= => mf. @@ -1036,15 +1041,14 @@ End Lspace_finite_measure. Section lfun_inclusion. Context d (T : measurableType d) (R : realType). -Variable mu : {measure set T -> \bar R}. +Variable mu : {finite_measure set T -> \bar R}. Local Open Scope ereal_scope. Lemma lfun_inclusion (p q : \bar R) : forall (p1 : 1 <= p) (q1 : 1 <= q), - mu [set: T] \is a fin_num -> p <= q -> {subset lfun mu q <= lfun mu p}. Proof. have := measure_ge0 mu [set: T]. -rewrite le_eqVlt => /predU1P[mu0 p1 q1 muTfin pq f +|mu_pos]. +rewrite le_eqVlt => /predU1P[mu0 p1 q1 pq f +|mu_pos]. rewrite inE => /andP[/[1!inE]/= mf _]. rewrite inE; apply/andP; split; rewrite inE//=. rewrite /finite_norm unlock /Lnorm. @@ -1055,8 +1059,7 @@ rewrite le_eqVlt => /predU1P[mu0 p1 q1 muTfin pq f +|mu_pos]. apply/measurable_EFinP/(@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. exact: measurableT_comp. move: p q => [p| |//] [q| |]// p1 q1. -- move=> mu_fin. - rewrite le_eqVlt => /predU1P[[->]//|]; rewrite lte_fin => pq f. +- rewrite le_eqVlt => /predU1P[[->]//|]; rewrite lte_fin => pq f. rewrite inE/= => /andP[/[!inE]/= mf] ffin. apply/andP; split; rewrite inE//=. move: (ffin); rewrite /finite_norm. @@ -1087,18 +1090,17 @@ move: p q => [p| |//] [q| |]// p1 q1. by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. move=> h1 /lty_poweRy h2. apply/poweR_lty/(le_lt_trans h1). - rewrite muleC lte_mul_pinfty ?fin_numElt?poweR_ge0//. - by rewrite (lt_le_trans _ (poweR_ge0 _ _))//= ltey_eq fin_num_poweR. + rewrite muleC lte_mul_pinfty ?poweR_ge0 ?fin_num_poweR ?fin_num_measure//. rewrite poweR_lty// (lty_poweRy qinv0)//. by have:= ffin; rewrite /finite_norm unlock /Lnorm. - have p0 : (0 < p)%R by rewrite ?(lt_le_trans ltr01). - move=> muoo _ f. + move=> _ f. rewrite !inE => /andP[/[1!inE]/= mf]. rewrite !inE/= /finite_norm unlock /Lnorm mu_pos => supf_lty. apply/andP; split; rewrite inE//= /finite_norm unlock /Lnorm. rewrite poweR_lty//; move: supf_lty => /ess_supr_bounded[M fM]. rewrite (@le_lt_trans _ _ (\int[mu]_x (M `^ p)%:E)); [by []| |]; last first. - by rewrite integral_cst// ltey_eq fin_numM. + by rewrite integral_cst// ltey_eq fin_numM ?fin_num_measure. apply: ae_ge0_le_integral => //. + by move=> x _; rewrite lee_fin powR_ge0. + apply/measurable_EFinP. @@ -1108,11 +1110,24 @@ move: p q => [p| |//] [q| |]// p1 q1. + apply: filterS fM => t/= ftM _. rewrite lee_fin ge0_ler_powR//; first exact: ltW. by rewrite nnegrE (le_trans _ ftM). -- by move=> muTfin _. +by move=> _. Qed. -Lemma lfun_inclusion12 : mu [set: T] \is a fin_num -> +Lemma lfun_inclusion12 : {subset lfun mu 2%:E <= lfun mu 1}. Proof. by move=> ?; apply: lfun_inclusion => //; rewrite lee1n. Qed. +Lemma lfun_bounded (f : T -> R) M p : + 1 <= p -> measurable_fun [set: T] f -> (forall t, `|f t| <= M)%R -> f \in lfun mu p. +Proof. +move=> p1 mX bX. +apply: (@lfun_inclusion p +oo p1 (ltry _) (leey _)). +rewrite inE/=; apply/andP; split; rewrite inE//=. +rewrite /finite_norm unlock. +case: ifPn => P0//. +apply: (@le_lt_trans _ _ M%:E). + by rewrite ess_sup_ler. +by rewrite ltry. +Qed. + End lfun_inclusion. diff --git a/theories/probability.v b/theories/probability.v index a66dc3bad8..5634b420a5 100644 --- a/theories/probability.v +++ b/theories/probability.v @@ -287,7 +287,7 @@ Proof. by rewrite unlock. Qed. Lemma expectation_fin_num (X : T -> R) : X \in lfun P 1 -> 'E_P[X] \is a fin_num. -Proof. by move=> ?; rewrite unlock integral_fune_fin_num ?lfun1_integrable. Qed. +Proof. by move=> ?; rewrite unlock integral_fune_fin_num; last exact/lfun1_integrable. Qed. Lemma expectation_cst r : 'E_P[cst r] = r%:E. Proof. by rewrite unlock/= integral_cst//= probability_setT mule1. Qed. @@ -304,7 +304,7 @@ Qed. Lemma expectationZl (X : T -> R) (k : R) : X \in lfun P 1 -> 'E_P[k \o* X] = k%:E * 'E_P [X]. -Proof. by move=> ?; rewrite unlock muleC -integralZr ?lfun1_integrable. Qed. +Proof. by move=> ?; rewrite unlock muleC -integralZr; last exact/lfun1_integrable. Qed. Lemma expectation_ge0 (X : T -> R) : (forall x, 0 <= X x)%R -> 0 <= 'E_P[X]. @@ -328,11 +328,11 @@ Qed. Lemma expectationD (X Y : T -> R) : X \in lfun P 1 -> Y \in lfun P 1 -> 'E_P[X \+ Y] = 'E_P[X] + 'E_P[Y]. -Proof. by move=> ? ?; rewrite unlock integralD_EFin ?lfun1_integrable. Qed. +Proof. by move=> ? ?; rewrite unlock integralD_EFin; [ | |exact/lfun1_integrable..]. Qed. Lemma expectationB (X Y : T -> R) : X \in lfun P 1 -> Y \in lfun P 1 -> 'E_P[X \- Y] = 'E_P[X] - 'E_P[Y]. -Proof. by move=> ? ?; rewrite unlock integralB_EFin ?lfun1_integrable. Qed. +Proof. by move=> ? ?; rewrite unlock integralB_EFin; [ | |exact/lfun1_integrable..]. Qed. Lemma expectation_sum (X : seq (T -> R)) : (forall Xi, Xi \in X -> Xi \in lfun P 1) -> @@ -528,10 +528,9 @@ Lemma covarianceDl (X Y Z : T -> R) : covariance P (X \+ Y)%R Z = covariance P X Z + covariance P Y Z. Proof. move=> X2 Y2 Z2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have X1 := lfun_inclusion12 Pfin X2. -have Y1 := lfun_inclusion12 Pfin Y2. -have Z1 := lfun_inclusion12 Pfin Z2. +have X1 := lfun_inclusion12 X2. +have Y1 := lfun_inclusion12 Y2. +have Z1 := lfun_inclusion12 Z2. have XY1 := lfun2M2_1 X2 Y2. have YZ1 := lfun2M2_1 Y2 Z2. have XZ1 := lfun2M2_1 X2 Z2. @@ -553,9 +552,8 @@ Lemma covarianceBl (X Y Z : T -> R) : covariance P (X \- Y)%R Z = covariance P X Z - covariance P Y Z. Proof. move=> X2 Y2 Z2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have Y1 := lfun_inclusion12 Pfin Y2. -have Z1 := lfun_inclusion12 Pfin Z2. +have Y1 := lfun_inclusion12 Y2. +have Z1 := lfun_inclusion12 Z2. have YZ1 := lfun2M2_1 Y2 Z2. by rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl ?rpredN. Qed. @@ -565,9 +563,8 @@ Lemma covarianceBr (X Y Z : T -> R) : covariance P X (Y \- Z)%R = covariance P X Y - covariance P X Z. Proof. move=> X2 Y2 Z2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have Y1 := lfun_inclusion12 Pfin Y2. -have Z1 := lfun_inclusion12 Pfin Z2. +have Y1 := lfun_inclusion12 Y2. +have Z1 := lfun_inclusion12 Z2. have YZ1 := lfun2M2_1 Y2 Z2. by rewrite !(covarianceC X) covarianceBl 1?(mulrC _ X). Qed. @@ -611,8 +608,7 @@ Lemma varianceZ a (X : T -> R) : X \in lfun P 2%:E -> 'V_P[(a \o* X)%R] = (a ^+ 2)%:E * 'V_P[X]. Proof. move=> X2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have X1 := lfun_inclusion12 Pfin X2. +have X1 := lfun_inclusion12 X2. rewrite /variance covarianceZl//=. - by rewrite covarianceZr// ?muleA ?EFinM// lfun2M2_1. - by rewrite lfunp_scale. @@ -629,9 +625,8 @@ Lemma varianceD (X Y : T -> R) : X \in lfun P 2%:E -> Y \in lfun P 2%:E -> 'V_P[X \+ Y]%R = 'V_P[X] + 'V_P[Y] + 2%:E * covariance P X Y. Proof. move=> X2 Y2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have X1 := lfun_inclusion12 Pfin X2. -have Y1 := lfun_inclusion12 Pfin Y2. +have X1 := lfun_inclusion12 X2. +have Y1 := lfun_inclusion12 Y2. have XY1 := lfun2M2_1 X2 Y2. rewrite -['V_P[_]]/(covariance P (X \+ Y)%R (X \+ Y)%R). rewrite covarianceDl ?rpredD ?lee1n//= covarianceDr// covarianceDr//. @@ -643,9 +638,8 @@ Lemma varianceB (X Y : T -> R) : X \in lfun P 2%:E -> Y \in lfun P 2%:E -> 'V_P[(X \- Y)%R] = 'V_P[X] + 'V_P[Y] - 2%:E * covariance P X Y. Proof. move=> X2 Y2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have X1 := lfun_inclusion12 Pfin X2. -have Y1 := lfun_inclusion12 Pfin Y2. +have X1 := lfun_inclusion12 X2. +have Y1 := lfun_inclusion12 Y2. have XY1 := lfun2M2_1 X2 Y2. rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R. by rewrite varianceD/= ?varianceN ?covarianceNr ?muleN ?rpredN. @@ -683,9 +677,8 @@ Lemma covariance_le (X Y : T -> R) : X \in lfun P 2%:E -> Y \in lfun P 2%:E -> covariance P X Y <= sqrte 'V_P[X] * sqrte 'V_P[Y]. Proof. move=> X2 Y2. -have Pfin : P setT \is a fin_num := fin_num_measure P _ measurableT. -have X1 := lfun_inclusion12 Pfin X2. -have Y1 := lfun_inclusion12 Pfin Y2. +have X1 := lfun_inclusion12 X2. +have Y1 := lfun_inclusion12 Y2. have XY1 := lfun2M2_1 X2 Y2. rewrite -sqrteM ?variance_ge0//. rewrite lee_sqrE ?sqrte_ge0// sqr_sqrte ?mule_ge0 ?variance_ge0//. @@ -805,8 +798,7 @@ Lemma cantelli (X : {RV P >-> R}) (lambda : R) : P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] <= (fine 'V_P[X] / (fine 'V_P[X] + lambda^2))%:E. Proof. -move=> /[dup] X2. -move=> /(lfun_inclusion12 (fin_num_measure P _ measurableT)) X1 lambda_gt0. +move=> /[dup] X2 /lfun_inclusion12 X1 lambda_gt0. have finEK : (fine 'E_P[X])%:E = 'E_P[X] by rewrite fineK ?expectation_fin_num. have finVK : (fine 'V_P[X])%:E = 'V_P[X] by rewrite fineK ?variance_fin_num. pose Y := (X \- cst (fine 'E_P[X]))%R. @@ -838,7 +830,7 @@ have le (u : R) : (0 <= u)%R -> - by rewrite lerD2r -lee_fin EFinB finEK. apply: (le_trans (le_measure _ _ _ le)). - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. - by apply: emeasurable_funB=> //; apply/measurable_int/(lfun1_integrable X1). + by apply: emeasurable_funB=> //; apply/measurable_int/lfun1_integrable/X1. - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. rewrite measurable_EFinP [X in measurable_fun _ X](_ : _ = (fun x => x ^+ 2) \o (fun x => Y x + u))%R//. @@ -1052,34 +1044,6 @@ Qed. End discrete_distribution. -Section discrete_distribution. -Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType) (P : probability T R). - -Lemma dRV_expectation (X : {dRV P >-> R}) : - P.-integrable [set: T] (EFin \o X) -> - 'E_P[X] = \sum_(n iX. -have := @dRV_expectation_comp _ _ T R R P (@measurable_set1 R) X. -Admitted. - -(* check that expecation_bernoulli is recoverable by bernoulli_pmf *) - -Definition pmf (X : {RV P >-> R}) (r : R) : R := fine (P (X @^-1` [set r])). - -Lemma expectation_pmf (X : {dRV P >-> R}) : - P.-integrable [set: T] (EFin \o X) -> 'E_P[X] = - \sum_(n iX; rewrite dRV_expectation// [in RHS]eseries_mkcond. -apply: eq_eseriesr => k _. -rewrite /enum_prob patchE; case: ifPn => kX; last by rewrite mul0e. -by rewrite /pmf fineK// fin_num_measure. -Abort. - -End discrete_distribution. - Section bernoulli_pmf. Context {R : realType} (p : R). Local Open Scope ring_scope. diff --git a/theories/sampling.v b/theories/sampling.v index c8dda56e9b..f2f0af77b7 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -11,7 +11,7 @@ From mathcomp Require Import reals ereal interval_inference topology normedtype. From mathcomp Require Import sequences realfun convex real_interval. From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral kernel probability. -From mathcomp Require Import independence. +From mathcomp Require Import hoelder independence. Set Implicit Arguments. Unset Strict Implicit. @@ -44,6 +44,7 @@ Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldTopology.Exports numFieldNormedType.Exports. +Import hoelder ess_sup_inf. Local Open Scope classical_set_scope. Local Open Scope ring_scope. @@ -85,60 +86,10 @@ Context {d} (T : measurableType d) {R : realType}. HB.instance Definition _ (f g : {mfun T >-> R}) := @isMeasurableFun.Build d _ _ _ (f \* g)%R - (measurable_funM (@measurable_funPT _ _ _ _ f) - ((@measurable_funPT _ _ _ _ g))). + (measurable_funM (measurable_funPT f) (measurable_funPT g)). End mfunM. -(* TODO: move (to exp.v?) *) -Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). -Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. - -Section move. - -Lemma sumr_map {R : realType} U d (T : measurableType d) (l : seq U) Q - (f : U -> {mfun T >-> R}) (x : T) : - (\sum_(i <- l | Q i) f i) x = \sum_(i <- l | Q i) f i x. -Proof. by elim/big_ind2 : _ => //= _ g _ h <- <-. Qed. - -Lemma prodr_map {R : realType} U d (T : measurableType d) (l : seq U) Q - (f : U -> {mfun T >-> R}) (x : T) : - (\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x. -Proof. by elim/big_ind2 : _ => //= _ h _ g <- <-. Qed. - -Definition sumrfct_tuple {R : realType} d {T : measurableType d} - n (s : n.-tuple {mfun T >-> R}) : T -> R := - \sum_(f <- s) f. - -Lemma measurable_sumrfct_tuple {R : realType} d {T : measurableType d} - n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (sumrfct_tuple s). -Proof. by apply/measurable_EFinP => /=; exact/measurableT_comp. Qed. - -HB.instance Definition _ {R : realType} d {T : measurableType d} - n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (sumrfct_tuple s) (measurable_sumrfct_tuple s). - -Definition sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : T -> R := - \sum_(f <- s) f. - -Lemma measurable_sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : - measurable_fun setT (sumrfct s). -Proof. -by apply/measurable_EFinP => /=; apply/measurableT_comp => //. -Qed. - -HB.instance Definition _ {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). - -End move. - -(* TODO: move to functions. *) -Lemma fct_prodE (I : Type) (T : pointedType) (M : comRingType) r (P : {pred I}) (f : I -> T -> M) - (x : T) : - (\prod_(i <- r | P i) f i) x = \prod_(i <- r | P i) f i x. -Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. - HB.instance Definition _ (n : nat) := isPointed.Build 'I_n.+1 ord0. HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_display @@ -575,13 +526,6 @@ Proof. by apply: measurableT_comp => //; exact: measurable_tnth. Qed. HB.instance Definition _ n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) := isMeasurableFun.Build _ _ _ _ (Tnth X i) (measurable_Tnth X i). -Lemma Tnth_tnth n (X : n.+1.-tuple {mfun T >-> R}) x : - (Tnth X ord0) (x :: nseq n point) = (tnth X ord0) x. -Proof. -rewrite /Tnth/=. -rewrite tnth0. -Abort. - Lemma measurable_tuple_sum n (X : n.-tuple {mfun T >-> R}) : measurable_fun setT (\sum_(i < n) (Tnth X i))%R. Proof. @@ -734,36 +678,35 @@ Notation "\X_ n P" := (ipro P n) (at level 10, n, P at next level, Section integral_ipro. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Variable n : nat. -Definition phi := fun w : T * n.-tuple T => [the _.-tuple _ of w.1 :: w.2]. +Definition phi n := fun w : T * n.-tuple T => [the _.-tuple _ of w.1 :: w.2]. -Lemma mphi : measurable_fun [set: T * _.-tuple _] phi. +Lemma mphi n : measurable_fun [set: T * n.-tuple T] (@phi n). Proof. exact: measurable_cons. Qed. -Definition psi := fun w : n.+1.-tuple T => (thead w, [the _.-tuple _ of behead w]). +Definition psi n := fun w : n.+1.-tuple T => (thead w, [the _.-tuple _ of behead w]). -Lemma mpsi : measurable_fun [set: _.-tuple _] psi. +Lemma mpsi n : measurable_fun [set: _.-tuple _] (@psi n). Proof. by apply/measurable_fun_prod => /=; [exact: measurable_tnth|exact: measurable_behead]. Qed. -Lemma phiK : cancel phi psi. +Lemma phiK n : cancel (@phi n) (@psi n). Proof. by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. Qed. -Let psiK : cancel psi phi. +Let psiK n : cancel (@psi n) (@phi n). Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. -Lemma integral_ipro (f : n.+1.-tuple T -> R) : +Lemma integral_ipro n (f : n.+1.-tuple T -> R) : (\X_n.+1 P).-integrable [set: n.+1.-tuple T] (EFin \o f) -> \int[\X_n.+1 P]_w (f w)%:E = \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. move=> /integrableP[mf intf]. -rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ setT +rewrite -(@integral_pushforward _ _ _ _ R _ (@mphi n) _ setT (fun x : n.+1.-tuple T => (f x)%:E)); [|by []| |by []]. apply: eq_measure_integral => A mA _. rewrite /=. @@ -787,11 +730,11 @@ apply/integrableP; split => /=. exact: mphi. apply: le_lt_trans (intf). rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x - ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. + ((((abse \o (@EFin R \o (f \o (@phi n))))) \o (@psi n)) x)); last first. by apply: eq_integral => x _ /=; rewrite psiK. rewrite le_eqVlt; apply/orP; left; apply/eqP. -rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT - (fun x : T * n.-tuple T => ((abse \o (EFin \o (f \o phi))) x)))//. +rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (@mpsi n) _ setT + (fun x : T * n.-tuple T => ((abse \o (EFin \o (f \o (@phi n)))) x)))//. - apply: eq_measure_integral => // A mA _. apply: product_measure_unique => // B C mB mC. rewrite /= /pushforward/=. @@ -823,144 +766,189 @@ rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT by rewrite normr_id// psiK. Qed. +Lemma integral_ipro_ge0 n (f : {mfun n.+1.-tuple T >-> R}) : + (forall x, 0 <= f x)%R -> + \int[\X_n.+1 P]_w (f w)%:E = \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. +Proof. +move=> f0. +rewrite -(@ge0_integral_pushforward _ _ _ _ R _ (@mphi n) _ setT + (fun x : n.+1.-tuple T => (f x)%:E)); [ | by [] | exact: measurableT_comp | ]. + apply: eq_measure_integral => A mA _. + rewrite /=. + rewrite /pushforward. + rewrite /pro2. + rewrite /phi/=. + rewrite /preimage/=. + congr (_ _). + apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. + move: At. + by rewrite {1}(tuple_eta t)//. + exists (x.1 :: x.2) => //=. + destruct x as [x1 x2] => //=. + congr pair. + exact/val_inj. +move=> x/= _. +by rewrite lee_fin. +Qed. + +Lemma ipro_tnth n A i: + d.-measurable A -> + (\X_n P) ((tnth (T:=T))^~ i @^-1` A) = P A. +Proof. +elim: n A i => [|n ih A]. + by move=> A; case; case => //. +case; case => [i0|m mn mA]. +- transitivity ((P \x^ \X_n P) (A `*` [set: n.-tuple T])). + rewrite /ipro. + congr (_ _). + apply: funext => x/=. + apply/propext; split. + move=> [y] Ay0 <-; split => //=. + by rewrite /thead (_ : ord0 = Ordinal i0)//=; apply: val_inj => /=. + move=> []Ax _. exists (x.1 :: x.2) => //=. + rewrite /thead tnth0 [RHS]surjective_pairing. + congr (_, _). + by apply: val_inj => /=. + rewrite /product_measure2/= setXT. + under [X in integral _ _ X]eq_fun => x do rewrite ysection_preimage_fst. + by rewrite integral_cst//= probability_setT mule1. +have mn' : (m < n)%N by rewrite -ltnS. +transitivity ((P \x^ \X_n P) ([set: T] `*` ((tnth (T:=T)^~ (Ordinal mn') @^-1` A)))). + rewrite /ipro. + congr (_ _). + apply: funext => x/=. + apply/propext; split. + move=> [y]/= Ay <-; split => //=. + rewrite tnth_behead/=. + rewrite (_ : inord m.+1 = Ordinal mn)//. + apply: val_inj => //=. + by rewrite inordK. + move=> [_ Ax]. + exists [tuple of x.1 :: x.2]. + rewrite (_ : Ordinal mn = lift ord0 (Ordinal mn'))//=; last first. + apply: val_inj => /=. + by rewrite /bump//=. + by rewrite tnthS. + move: x Ax. + case => x1 x2/= Ax. + congr (_ ,_ ). + by apply: val_inj. +rewrite product_measure2E//=; first by rewrite probability_setT mul1e ih. +rewrite -[X in measurable X]setTI. +exact: measurable_tnth. +Qed. + +Lemma integral_tnth n (f : {mfun T >-> R}) i : + \int[\X_n P]_x (`|f (tnth x i)|)%:E = \int[P]_x (`|f x|)%:E. +Proof. +rewrite -(preimage_setT ((@tnth n _)^~ i)). +rewrite -(@ge0_integral_pushforward _ _ _ _ _ _ (measurable_tnth i) (\X_n P) _ (EFin \o normr \o f) measurableT). +- apply: eq_measure_integral => A mA _/=. + by rewrite /pushforward ipro_tnth. +- by do 2 apply: measurableT_comp => //. +by move=> y _/=; rewrite lee_fin normr_ge0. +Qed. + +Lemma tnth_integrable n (F : n.-tuple {mfun T >-> R}) i : + P.-integrable [set: T] (EFin \o tnth F i) -> + (\X_n P).-integrable [set: n.-tuple T] (EFin \o Tnth F i). +Proof. +move=> /integrableP/=[mF iF]; rewrite /Tnth. +apply/integrableP; split. + apply: measurableT_comp => //. + apply: measurableT_comp => //. + exact: measurable_tnth. +rewrite /=. +by rewrite (integral_tnth (tnth F i)). +Qed. + +Lemma integral_ipro_tnth n (F : n.-tuple {mfun T >-> R}) : + (forall Fi : {mfun T >-> R}, Fi \in F -> (Fi : T -> R) \in lfun P 1) -> + forall i : 'I_n, \int[\X_n P]_x (Tnth F i x)%:E = \int[P]_x (tnth F i x)%:E. +Proof. +elim: n F => //=[F FiF|]; first by case=> m i0. +move=> m ih F lfunFi/=. +rewrite [X in integral X](_ : _ = \X_m.+1 P)//. +case; case => [i0|i im]. + rewrite [LHS](@integral_ipro m (Tnth F (Ordinal i0))); last first. + by apply/tnth_integrable/lfun1_integrable/lfunFi/mem_tnth. + under eq_fun => x do + rewrite /Tnth (_ : tnth (_ :: _) _ = tnth [tuple of x.1 :: x.2] ord0)// tnth0. + rewrite -fubini1'/fubini_F/=; last first. + apply/integrable12ltyP => /=. + apply: measurableT_comp => //=. + exact: measurableT_comp. + under eq_integral => x _ do rewrite integral_cst//= probability_setT mule1. + have /lfunFi : tnth F (Ordinal i0) \in F by apply/tnthP; exists (Ordinal i0). + by move/lfun1_integrable /integrableP => [_]. + apply: eq_integral => x _. + by rewrite integral_cst//= probability_setT mule1. +rewrite [LHS](@integral_ipro m (Tnth F (Ordinal im))); last first. + by apply/tnth_integrable/lfun1_integrable/lfunFi/mem_tnth. +have jm : (i < m)%nat by rewrite ltnS in im. +have liftjm : Ordinal im = lift ord0 (Ordinal jm). + by apply: val_inj; rewrite /= /bump add1n. +rewrite (tuple_eta F). +under eq_integral => x _ do rewrite /Tnth !liftjm !tnthS. +rewrite -fubini2'/fubini_G/=; last first. + apply/integrable12ltyP => /=. + apply: measurableT_comp => //=. + apply: measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x (Ordinal jm)) _ (fun x => x.2)). + exact: measurable_tnth. + exact: measurable_snd. + rewrite [ltLHS](_ : _ = \int[\X_m P]_y `|tnth (behead_tuple F) (Ordinal jm) (tnth y (Ordinal jm))|%:E); last first. + by rewrite integral_cst//= probability_setT mule1. + have : (tnth F (lift ord0 (Ordinal jm)) : T -> R) \in lfun P 1. + by rewrite lfunFi// mem_tnth. + rewrite {1}(tuple_eta F) tnthS. + by move/lfun1_integrable/tnth_integrable/integrableP => [_]/=. +transitivity (\int[\X_m P]_x (tnth (behead F) (Ordinal jm) (tnth x (Ordinal jm)))%:E). + apply: eq_integral => /=x _. + by rewrite integral_cst//= probability_setT mule1. +rewrite [LHS]ih; last by move=> Fi FiF; apply: lfunFi; rewrite mem_behead. +apply: eq_integral => x _. +by rewrite liftjm tnthS. +Qed. + End integral_ipro. Section properties_of_expectation. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Lemma expectation_sum_ipro n (X : n.-tuple {RV P >-> R}) M : - (forall i t, (0 <= tnth X i t <= M)%R) -> +Lemma expectation_sum_ipro n (X : n.-tuple {RV P >-> R}) : + [set` X] `<=` lfun P 1 -> 'E_(\X_n P)[\sum_(i < n) Tnth X i] = \sum_(i < n) ('E_P[(tnth X i)]). Proof. -elim: n X => [X|n IH X] /= XM. - by rewrite !big_ord0 expectation_cst. -pose X0 := thead X. -have intX0 : P.-integrable [set: T] (EFin \o X0). - apply: (bounded_RV_integrable M) => // t. - exact: XM. -have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). - move=> /tnthP[i XiXi]. - apply: (bounded_RV_integrable M) => // t. - rewrite XiXi. - exact: XM. -rewrite big_ord_recl/=. -rewrite big_ord_recl/=. -pose X1 (x : n.+1.-tuple T) := - (\sum_(i < n) (tnth X (lift ord0 i)) (tnth x (lift ord0 i)))%R. -have mX1 : measurable_fun setT X1. - apply: measurable_sum => /= i; apply: measurableT_comp => //. - exact: measurable_tnth. -pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose Y1 : {mfun n.+1.-tuple T >-> R} := HB.pack X1 build_mX1. -pose X2 (x : n.+1.-tuple T) := (thead X) (thead x). -have mX2 : measurable_fun setT X2. -rewrite /X2 /=. - by apply: measurableT_comp => //; exact: measurable_tnth. -pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y2 : {mfun n.+1.-tuple T >-> R} := HB.pack X2 build_mX2. -rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1); last first. - rewrite /Y2 /Y1/= /X2 /X1/=. - by apply/funext => t; rewrite !fctE fct_sumE. -rewrite expectationD; last 2 first. - apply: (bounded_RV_integrable M) => // t. - exact: XM. - rewrite (_ : _ \o _ = fun x => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. - by apply/funext => t/=; rewrite sumEFin. - apply: integrable_sum_ord => // i. - have : measurable_fun setT (fun x : n.+1.-tuple T => - tnth X (lift ord0 i) (tnth x (lift ord0 i))). - apply/measurableT_comp => //=. - exact: measurable_tnth. - by move/(bounded_RV_integrable M); exact. -congr (_ + _). -- rewrite /Y2 /X2/= unlock /expectation. - (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) - pose phi : n.+1.-tuple T -> T := fun w => @tnth n.+1 T w ord0. - have mphi : measurable_fun setT phi. - exact: measurable_tnth. - rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ setT - (fun w => (tnth X ord0 w)%:E)); last 3 first. - exact/measurable_EFinP. - apply: (bounded_RV_integrable M). - by []. - move=> t. - by apply: XM. - by []. - apply: eq_measure_integral => //= A mA _. - rewrite /pushforward. - rewrite /phi. - rewrite [X in (_ \x^ _) X = _](_ : - [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] - = A `*` setT); last first. - apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. - move=> [x1 x2]/= [Ax1 _]. - exists [the _.-tuple _ of x1 :: x2] => //=. - by rewrite theadE; congr pair => //; exact/val_inj. - by rewrite product_measure2E//= probability_setT mule1. -- rewrite /Y1 /X1/=. - transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. - apply: eq_bigr => /= i _. - congr expectation. - rewrite tnth_behead. - congr (tnth X). - apply/val_inj => /=. - by rewrite /bump/= add1n/= inordK// ltnS. - rewrite -IH; last first. - move=> i t. - rewrite tnth_behead. - exact: XM. - transitivity ('E_\X_n P[(fun x : n.-tuple T => - \sum_(i < n) tnth (behead X) i (tnth x i))%R]). - rewrite unlock /expectation. - transitivity (\int[(pro2 P (\X_n P))]_w - (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). - rewrite integral_ipro//. - apply: eq_integral => /= -[w1 w2] _; rewrite -!sumEFin. - by apply: eq_bigr => i _ /=; rewrite tnthS. - rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. - by apply/funext => t/=; rewrite sumEFin. - apply: integrable_sum_ord => // i. - have : measurable_fun setT (fun x : n.+1.-tuple T => - (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). - by apply/measurableT_comp => //=; exact: measurable_tnth. - by move/(bounded_RV_integrable M); exact. - rewrite /pro2 -fubini2'/=; last first. - rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. - by apply/funext => t/=; rewrite sumEFin. - apply: integrable_sum_ord => //= i. - have : measurable_fun setT (fun x : T * n.-tuple T => (tnth X (lift ord0 i) (tnth x.2 i))). - apply/measurableT_comp => //=. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x i) _ snd) => //=. - exact: measurable_tnth. - move/(@bounded_RV_integrable _ _ R (pro1 P (\X_n P))%E _ M) => /=. - by apply => t; exact: XM. - apply: eq_integral => t _. - rewrite /fubini_G. - transitivity (\sum_(i < n) - (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). - rewrite -[RHS]integral_sum//. - by apply: eq_integral => x _; rewrite sumEFin. - by move=> /= i; exact: finite_measure_integrable_cst. - rewrite -sumEFin; apply: eq_bigr => /= i _. - rewrite integral_cst//. - rewrite [X in _ * X]probability_setT mule1. - rewrite tnth_behead//=. - congr (tnth X _ _)%:E. - apply/val_inj => /=. - by rewrite inordK// ltnS. - congr expectation. - by apply/funext => t; rewrite fct_sumE. +move=>/= bX. +rewrite (_ : \sum_(i < n) Tnth X i = \sum_(Xi <- [seq Tnth X i | i in 'I_n]) Xi)%R; last first. + by rewrite big_map big_enum. +rewrite expectation_sum/=. + rewrite big_map big_enum/=. + apply: eq_bigr => i i_n. + rewrite unlock. + exact: integral_ipro_tnth. +move=> Xi /tnthP[i] ->. +pose j := cast_ord (card_ord _) i. +apply/lfun1_integrable => /=. +rewrite /image_tuple tnth_map. +apply: tnth_integrable. +rewrite (_ : (tnth (enum_tuple 'I_n) i) = j); last first. + apply: val_inj => //=. + rewrite /tnth nth_enum_ord//. + have := ltn_ord i. + move/leq_trans. + apply. + by rewrite card_ord leqnn. +by have /bX/lfun1_integrable : (tnth X j) \in X by apply/tnthP; exists j. Qed. Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (P1 : probability T1 R) (P2 : probability T2 R) (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : - P1.-integrable setT (EFin \o X) -> - P2.-integrable setT (EFin \o Y) -> + (X : _ -> _) \in lfun P1 1 -> + (Y : _ -> _) \in lfun P2 1 -> let XY := fun (x : T1 * T2) => (X x.1 * Y x.2)%R in 'E_(pro2 P1 P2)[XY] = 'E_P1[X] * 'E_P2[Y]. Proof. @@ -976,7 +964,7 @@ rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. rewrite /= normrM EFinM muleC. over. rewrite /= integralZl//; last first. - by move/integrable_abse : intX. + by move/lfun1_integrable/integrable_abse : intX. over. rewrite /=. rewrite ge0_integralZr//; last 2 first. @@ -986,16 +974,16 @@ rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. rewrite lte_mul_pinfty//. by apply: integral_ge0 => //. apply: integral_fune_fin_num => //. - by move/integrable_abse : intY. - by move/integrableP : intX => []. + by move/lfun1_integrable/integrable_abse : intY. + by move/lfun1_integrable/integrableP : intX => []. rewrite /fubini_F/=. under eq_integral => x _. under eq_integral => y _ do rewrite EFinM. - rewrite integralZl//. - rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. + rewrite integralZl//; last exact/lfun1_integrable. + rewrite -[X in _ * X]fineK ?integral_fune_fin_num//; last exact/lfun1_integrable. over. -rewrite /=integralZr//. -by rewrite fineK// integral_fune_fin_num. +rewrite /=integralZr//; last exact/lfun1_integrable. +by rewrite fineK// integral_fune_fin_num; last exact/lfun1_integrable. Qed. End properties_of_expectation. @@ -1023,25 +1011,23 @@ by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. Unshelve. all: by end_near. Qed. -Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : - (forall i t, (0 <= tnth X i t <= M)%R) -> - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> +Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) : + [set` X] `<=` lfun P 1 -> (forall i t, 0 <= tnth X i t)%R -> 'E_(\X_n P)[ \prod_(i < n) Tnth X i] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. -elim: n X => [X|n IH X] /= boundedX intX. +elim: n X => [X|n IH X] intX posX/=. by rewrite !big_ord0 expectation_cst. -rewrite unlock /expectation integral_ipro /pro2; last first. - apply: (bounded_RV_integrable (M^+n.+1)%R) => //. - exact: measurable_tuple_prod. - move=> t; apply/andP; split. - rewrite fct_prodE. - rewrite prodr_ge0//= => i _. - by have /andP[] := boundedX i (tnth t i). - rewrite -[in leRHS](subn0 n.+1) -prodr_const_nat. - rewrite fct_prodE big_mkord. - by rewrite ler_prod// => i _; exact: boundedX. +rewrite unlock /expectation. +rewrite [X in integral X](_ : _ = \X_n.+1 P)//. +pose F : n.+1.-tuple T -> R := (\prod_(i < n.+1) Tnth X i)%R. +have mF : measurable_fun setT F by apply: measurable_tuple_prod. +pose build_mF := isMeasurableFun.Build _ _ _ _ F mF. +pose MF : {mfun _ >-> _} := HB.pack F build_mF. +rewrite [LHS](@integral_ipro_ge0 _ _ _ _ _ MF) /pro2; last first. + by rewrite /MF/F/= => t; rewrite fct_prodE/Tnth/= prodr_ge0//. under eq_fun. - move=> x. + move=> /=x. + rewrite /F/MF. rewrite big_ord_recl/=. rewrite /Tnth/= fctE tnth0. rewrite fct_prodE. @@ -1050,61 +1036,82 @@ under eq_fun. rewrite tnthS. over. over. +have /lfun1_integrable/integrableP/=[mXi iXi] := intX _ (mem_tnth ord0 X). +have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < +oo. + under eq_integral => x _. + rewrite [X in X%:E](_ : _ = \prod_(i < n) tnth (behead_tuple X) i (tnth x i))%R; last first. + by apply: eq_bigr => i _; rewrite (tuple_eta X) tnthS -tuple_eta. + over. + rewrite /= -(_ : 'E_(\X_n P)[\prod_(i < n) Tnth (behead_tuple X) i]%R = \int[\X_n P]_x _); last first. + rewrite unlock. + apply: eq_integral => /=x _. + by rewrite /Tnth fct_prodE. + rewrite IH. + - apply: finite_prod => i; rewrite expectation_ge0//=. + rewrite unlock tnth_behead. + have /lfun1_integrable/integrableP[?] := (intX (tnth X (inord i.+1)) (mem_tnth _ _)). + apply: le_lt_trans. + apply: ge0_le_integral => //. + - by move=> x _; rewrite lee_fin posX. + - by apply: measurableT_comp => //. + by move=> x _; rewrite lee_fin ler_norm. + by move=> x; rewrite tnth_behead posX. + - by move=> Xi XiX; rewrite intX//= mem_behead. + by move=> i t; rewrite tnth_behead posX. +have ? : measurable_fun [set: n.-tuple T] + (fun x : n.-tuple T => \prod_(i < n) tnth X (lift ord0 i) (tnth x i))%R. + apply: measurable_prod => //= i i_n. + apply: measurableT_comp => //. + exact: measurable_tnth. rewrite /=. rewrite -fubini1' /fubini_F/=; last first. - apply: measurable_bounded_integrable => //=. - - rewrite /product_measure1/=. - apply: (@le_lt_trans _ _ 1); last exact: ltry. - rewrite -(mule1 1) -{2}(@probability_setT _ _ _ P) -(integral_cst P _ 1)//. - apply: ge0_le_integral => //=. - exact: measurable_fun_xsection. - by move=> x _; apply: probability_le1; exact: measurable_xsection. - - apply: measurable_funM => //=. + apply/integrable21ltyP => //=. + apply: measurableT_comp => //. + apply: measurable_funM => //=. exact: measurableT_comp. - apply: measurable_prod => //=i ?. - apply: measurableT_comp => //=. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x i) _ snd) => //=. - exact: measurable_tnth. - apply: boundedM. - apply/ex_bound. exact: (@globally_properfilter _ _ point). (* TODO: need to automate globally_properfilter *) - exists M; rewrite /globally/= => x _. - have /andP[? ?] := boundedX ord0 x.1. - by rewrite ger0_norm. - apply/ex_bound; first exact: (@globally_properfilter _ _ point). - exists (M^+n)%R. rewrite /globally/= => x _. - rewrite normr_prod -[in leRHS](subn0 n) -prodr_const_nat. - rewrite big_mkord ler_prod => //=i _. - have /andP[? ?] := boundedX (lift ord0 i) (tnth x.2 i). - by rewrite normr_ge0/= ger0_norm. -have ? : (\X_n P).-integrable [set: n.-tuple T] - (fun x => (\prod_(i < n) (tnth X (lift ord0 i)) (tnth x i))%:E). - apply: (bounded_RV_integrable (M^+n)%R) => //=. - apply: measurable_prod => /= i _; apply: measurableT_comp => //. - exact: measurable_tnth. - move=> t; apply/andP; split. - by rewrite prodr_ge0//= => i _; have /andP[] := boundedX (lift ord0 i) (tnth t i). - by rewrite -[in leRHS](subn0 n) -prodr_const_nat big_mkord ler_prod. -under eq_fun => x. - under eq_fun => y do rewrite/= EFinM. - rewrite integralZl//= -[X in _*X]fineK ?integral_fune_fin_num//=. - over. -rewrite integralZr//; last by rewrite intX// (tuple_eta X) tnth0 mem_head. -rewrite big_ord_recl/=. -congr (_ * _). -rewrite fineK ?integral_fune_fin_num//=. -under eq_fun => x. - under eq_bigr => i _. - rewrite [X in tnth X]tuple_eta tnthS. + apply: measurable_prod => //= i i_n. + apply: measurableT_comp => //. + exact: (measurableT_comp (measurable_tnth i) measurable_snd). + under eq_integral => y _. + under eq_integral => x _ do rewrite normrM EFinM. + rewrite integralZr//; last exact/lfun1_integrable/lfun_norm/intX/mem_tnth. + rewrite -[X in X * _]fineK ?ge0_fin_numE ?integral_ge0//. over. + rewrite integralZl ?fineK ?lte_mul_pinfty ?integral_ge0//=. + - by rewrite ge0_fin_numE ?integral_ge0. + - by under eq_integral => x _ do rewrite ger0_norm ?prodr_ge0//. + - by rewrite ge0_fin_numE ?integral_ge0. + - apply/integrableP; split; first by do 2 apply: measurableT_comp => //. + by under eq_integral => x _ do rewrite /=normr_id ger0_norm ?prodr_ge0//. +under eq_integral => x _. + under eq_integral => y _ do rewrite EFinM. + rewrite integralZl/=; last 2 first. + - apply: measurableT. + - apply/integrableP; split => //; first by apply: measurableT_comp => //. + by under eq_integral => y _ do rewrite /=ger0_norm ?prodr_ge0//. + rewrite -[X in _ * X]fineK; last first. + rewrite ge0_fin_numE ?integral_ge0//=; last first. + by move=> t _; rewrite lee_fin prodr_ge0. over. -simpl. -rewrite [LHS](_ : _ = 'E_(\X_n P)[ \prod_(i < n) Tnth (behead_tuple X) i]); last first. - rewrite [in RHS]unlock /expectation. - apply: eq_integral => t _; congr EFin. - by rewrite fct_prodE. -rewrite IH; last 2 first. +rewrite /= integralZr//; last exact/lfun1_integrable/intX/mem_tnth. +rewrite fineK; last first. + by rewrite ge0_fin_numE// integral_ge0 => //=x _; rewrite lee_fin prodr_ge0//. +rewrite [X in _ * X](_ : _ = 'E_(\X_n P)[\prod_(i < n) Tnth (behead X) i])%R; last first. + rewrite [in RHS]unlock /Tnth. + apply: eq_integral => x _. + rewrite fct_prodE. + congr (_%:E). + apply: eq_bigr => i _. + rewrite tnth_behead. + congr (_ _ _). + congr (_ _ _). + apply: val_inj => /=. + by rewrite /bump/= inordK// ltnS. +rewrite IH; last first. - by move=> i t; rewrite tnth_behead. -- by move=> Xi XiX; apply: intX; rewrite mem_behead. +- by move=> Xi XiX; rewrite intX//= mem_behead. +rewrite big_ord_recl/=. +congr (_ * _). apply: eq_bigr => /=i _. rewrite unlock /expectation. apply: eq_integral => x _. @@ -1177,6 +1184,14 @@ have -> : \int[P]_x `|(EFin \o bool_to_real R X) x| = 'E_P[bool_to_real R X]. by rewrite bernoulli_expectation// ltry. Qed. +Lemma lfun_bernoulli (X : bernoulliRV P p) q : + 1 <= q -> (bool_to_real R X : T -> R) \in lfun P q. +Proof. +move=> q1. +apply: (@lfun_bounded _ _ _ P _ 1%R) => //t. +by rewrite /bool_to_real/= ler_norml lern1 (@le_trans _ _ 0%R) ?leq_b1. +Qed. + Lemma bool_RV_sqr (X : {RV P >-> bool}) : ((bool_to_real R X ^+ 2) = bool_to_real R X :> (T -> R))%R. Proof. @@ -1189,7 +1204,8 @@ Lemma bernoulli_variance (X : bernoulliRV P p) : 'V_P[bool_to_real R X] = (p * (`1-p))%:E. Proof. rewrite (@varianceE _ _ _ _ (bool_to_real R X)); - [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. + [|rewrite ?[X in _ \o X]bool_RV_sqr; apply: lfun_bernoulli..]; last first. + by rewrite lee1n. rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. by rewrite expe2 -EFinD onemMr. Qed. @@ -1211,8 +1227,8 @@ Proof. by rewrite /bool_to_real/=; case: (X t). Qed. Lemma expectation_bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : 'E_(\X_n P)[bool_trial_value X] = (n%:R * p)%:E. Proof. -rewrite (@expectation_sum_ipro _ _ _ _ _ _ 1%R); last first. - by move=> i t; rewrite tnth_map// btr_ge0 btr_le1. +rewrite expectation_sum_ipro; last first. + by move=> Xi /tnthP [i] ->; rewrite tnth_map lfun_bernoulli. transitivity (\sum_(i < n) p%:E). by apply: eq_bigr => k _; rewrite !tnth_map bernoulli_expectation. by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. @@ -1241,22 +1257,14 @@ transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ])%R. apply: eq_bigr => i _. by rewrite /Tnth !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. -rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. -- move=> i ?. - apply/andP. split. - by rewrite tnth_mktuple/= expR_ge0. - rewrite tnth_mktuple/=/bool_to_real/=. - rewrite ler_expR -[leRHS]mul1r. - have [t0|t0] := leP 0%R t. - by rewrite ger0_norm// ler_pM//; case: (tnth X_ i _). - rewrite (@le_trans _ _ 0%R)//. - by rewrite mulr_ge0_le0// ltW. +rewrite expectation_prod_nondep; last 2 first. - move=> _ /mapP[/= i _ ->]. apply: (bounded_RV_integrable (expR `|t|)) => // t0. rewrite expR_ge0/= ler_expR/=. rewrite /bool_to_real/=. case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. by rewrite ler_norm. +- by move=> i t0; rewrite tnth_map/= expR_ge0. apply: eq_bigr => /= i _. congr expectation. rewrite /=. @@ -1662,7 +1670,7 @@ rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. -(* [Ccorollary 2.7, Rajani] / [Corollary 4.7, MU] *) +(* [Corollary 2.7, Rajani] / [Corollary 4.7, MU] *) Corollary bernoulli_trial_inequality4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> (0 < n)%nat -> diff --git a/theories/sampling_wip.v b/theories/sampling_wip.v deleted file mode 100644 index cd9c5833b4..0000000000 --- a/theories/sampling_wip.v +++ /dev/null @@ -1,2705 +0,0 @@ -(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) -From mathcomp Require Import all_ssreflect. -From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. -From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -From mathcomp Require Import cardinality fsbigop. -Require Reals Interval.Tactic. -From mathcomp Require Import (canonicals) Rstruct Rstruct_topology. -From HB Require Import structures. -From mathcomp Require Import exp numfun lebesgue_measure lebesgue_integral. -From mathcomp Require Import reals ereal interval_inference topology normedtype sequences. -From mathcomp Require Import realfun convex. -From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. -From mathcomp Require Import lebesgue_integral kernel probability. -From mathcomp Require Import independence. - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -(**md**************************************************************************) -(* This file copies most of the file sampling.v, to serve as an experiment *) -(* for the formalization of a variant of the sampling theorem *) -(******************************************************************************) - -Reserved Notation "' P [ A | B ]". - -Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Import numFieldTopology.Exports numFieldNormedType.Exports. - -Local Open Scope classical_set_scope. -Local Open Scope ring_scope. - -Section product_probability2. -Local Open Scope ereal_scope. -Lemma product_probability2_setT : - forall (d1 d2 : measure_display) (T1 : measurableType d1) - (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) - (P2 : probability T2 R), (P1 \x^ P2) setT = 1%E. -Proof. -move=> ? ? ? ? ? P1 P2. -rewrite -setXTT product_measure2E// -[RHS]mul1e. -congr mule. -all: rewrite -[LHS]fineK ?fin_num_measure//. -all: congr EFin=> /=. -all: by rewrite probability_setT. -Qed. - -HB.instance Definition _ (d1 d2 : measure_display) (T1 : measurableType d1) - (T2 : measurableType d2) (R : realType) (P1 : probability T1 R) - (P2 : probability T2 R):= - Measure_isProbability.Build _ _ _ (P1 \x^ P2) (product_probability2_setT P1 P2). -End product_probability2. - -(* NB: most of the contents of this section is in PR 1391 and can soon be removed *) -Section independent_events. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Lemma sub_independent_events (I0 : choiceType) (A B : set I0) (E : I0 -> set T) : - A `<=` B -> independent_events P B E -> independent_events P A E. -Proof. -by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. -Qed. - -Definition kwise_independent (I : choiceType) (A : set I) (E : I -> set T) k := - (forall i, A i -> measurable (E i)) /\ - forall B : {fset I}, [set` B] `<=` A -> (#|` B | <= k)%nat -> - P (\bigcap_(i in [set` B]) E i) = \prod_(i <- B) P (E i). - -Lemma sub_kwise_independent (I : choiceType) (A B : set I) (E : I -> set T) k : - A `<=` B -> kwise_independent B E k -> kwise_independent A E k. -Proof. -by move=> AB [mE h]; split=> [i /AB/mE//|C CA]; apply: h; apply: subset_trans AB. -Qed. - -Lemma mutual_indep_is_kwise_indep (I : choiceType) (A : set I) (E : I -> set T) k : - independent_events P A E -> kwise_independent A E k. -Proof. -rewrite /independent_events /kwise_independent. -move=> [mE miE]; split=> // B BleA _. -exact: miE. -Qed. - -Lemma nwise_indep_is_mutual_indep (I : choiceType) (A : {fset I}) (E : I -> set T) n : - #|` A | = n -> kwise_independent [set` A] E n -> independent_events P [set` A] E. -Proof. -rewrite /independent_events /kwise_independent. -move=> nA [mE miE]; split=> // B BleA. -apply: miE => //; rewrite -nA fsubset_leq_card//. -by apply/fsubsetP => x xB; exact: (BleA x). -Qed. - -Lemma mutually_independent_weak (I : choiceType) (E : I -> set T) (B : set I) : - (forall b, ~ B b -> E b = setT) -> - independent_events P [set: I] E <-> - independent_events P B E. -Proof. -move=> BE; split; first exact: sub_independent_events. -move=> [mE h]; split=> [i _|C _]. - by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. -have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. -rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. -rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. -have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. - exists (fset_set ([set` C] `&` B)). - by rewrite fset_setK//; exact: finite_setIl. -rewrite CBD h; last first. - rewrite -CBD; exact: subIsetr. -rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. -rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. - by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. -by rewrite CBD -fsbig_seq. -Qed. - -Lemma kwise_independent_weak (I : choiceType) (E : I -> set T) (B : set I) k : - (forall b, ~ B b -> E b = setT) -> - kwise_independent [set: I] E k <-> - kwise_independent B E k. -Proof. -move=> BE; split; first exact: sub_kwise_independent. -move=> [mE h]; split=> [i _|C _ Ck]. - by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. -have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. -rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. -rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. -have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. - exists (fset_set ([set` C] `&` B)). - by rewrite fset_setK//; exact: finite_setIl. -rewrite CBD h; last 2 first. - - rewrite -CBD; exact: subIsetr. - - rewrite (leq_trans _ Ck)// fsubset_leq_card// -(set_fsetK D) -(set_fsetK C). - by rewrite -fset_set_sub// -CBD; exact: subIsetl. -rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. -rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. - by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. -by rewrite CBD -fsbig_seq. -Qed. - -Lemma kwise_independent_weak01 E1 E2 : - kwise_independent [set: nat] (bigcap2 E1 E2) 2%N <-> - kwise_independent [set 0%N; 1%N] (bigcap2 E1 E2) 2%N. -Proof. -apply: kwise_independent_weak. -by move=> n /= /not_orP[/eqP /negbTE -> /eqP /negbTE ->]. -Qed. - -Lemma independent_events_weak' (I : choiceType) (E : I -> set T) (B : set I) : - (forall b, ~ B b -> E b = setT) -> - independent_events P [set: I] E <-> - independent_events P B E. -Proof. -move=> BE; split; first exact: sub_independent_events. -move=> [mE h]; split=> [i _|C CI]. - by have [Bi|Bi] := pselect (B i); [exact: mE|rewrite BE]. -have [CB|CB] := pselect ([set` C] `<=` B); first by rewrite h. -rewrite -(setIT [set` C]) -(setUv B) setIUr bigcap_setU. -rewrite (@bigcapT _ _ (_ `&` ~` _)) ?setIT//; last by move=> i [_ /BE]. -have [D CBD] : exists D : {fset I}, [set` C] `&` B = [set` D]. - exists (fset_set ([set` C] `&` B)). - by rewrite fset_setK//; exact: finite_setIl. -rewrite CBD h; last first. - - rewrite -CBD; exact: subIsetr. -rewrite [RHS]fsbig_seq//= [RHS](fsbigID B)//=. -rewrite [X in _ * X](_ : _ = 1) ?mule1; last first. - by rewrite fsbig1// => m [_ /BE] ->; rewrite probability_setT. -by rewrite CBD -fsbig_seq. -Qed. - -Definition pairwise_independent E1 E2 := - kwise_independent [set 0; 1]%N (bigcap2 E1 E2) 2. - -Lemma pairwise_independentM_old (E1 E2 : set T) : - pairwise_independent E1 E2 <-> - [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. -Proof. -split. -- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. - rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. - + by rewrite set_fsetU !set_fset1; exact: subset_refl. - + rewrite cardfs2//. - split => //. - + by apply: (mE1E2 0%N) => /=; left. - + by apply: (mE1E2 1%N) => /=; right. -- move=> [mE1 mE2 E1E2M]. - split => //=. - + by move=> [| [| [|]]]//=. - + move=> B _; have [B0|B0] := boolP (0%N \in B); last first. - have [B1|B1] := boolP (1%N \in B); last first. - rewrite big1_fset; last first. - move=> k kB _; rewrite /bigcap2. - move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. - move: kB B1; case: ifPn => [/eqP -> ->//|_ _ _]. - by rewrite probability_setT. - rewrite bigcapT ?probability_setT// => k/= kB. - move: kB B0 B1; case: ifPn => [/eqP -> ->//|k0]. - by case: ifPn => [/eqP -> ->|]. - rewrite (bigcap_setD1 1%N _ [set` B])//=. - rewrite bigcapT ?setIT; last first. - move=> k [/= kB /eqP /negbTE ->]. - by move: kB B0; case: ifPn => [/eqP -> ->|]. - rewrite (big_fsetD1 1%N)//= big1_fset ?mule1// => k. - rewrite !inE => /andP[/negbTE -> kB] _. - move: kB B0; case: ifPn => [/eqP -> ->//|k0 kB B0]. - by rewrite probability_setT. - rewrite (bigcap_setD1 0%N _ [set` B])//. - have [B1|B1] := boolP (1%N \in B); last first. - rewrite bigcapT ?setIT; last first. - move=> k [/= kB /eqP /negbTE ->]. - by move: kB B1; case: ifPn => [/eqP -> ->|]. - rewrite (big_fsetD1 0%N)//= big1_fset ?mule1// => k. - rewrite !inE => /andP[/negbTE -> kB] _. - move: kB B1; case: ifPn => [/eqP -> ->//|k1 kB B1]. - by rewrite probability_setT. - rewrite (bigcap_setD1 1%N _ ([set` B] `\ 0%N))// bigcapT ?setIT; last first. - by move=> n/= [[nB]/eqP/negbTE -> /eqP/negbTE ->]. - rewrite E1E2M (big_fsetD1 0%N)//= (big_fsetD1 1%N)/=; last by rewrite !inE B1. - rewrite big1_fset ?mule1//= => k. - rewrite !inE => -/and3P[/negbTE -> /negbTE -> kB] _; - by rewrite probability_setT. -Qed. - -Lemma pairwise_independentM (E1 E2 : set T) : - pairwise_independent E1 E2 <-> - [/\ d.-measurable E1, d.-measurable E2 & P (E1 `&` E2) = P E1 * P E2]. -Proof. -split. -- move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. - rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => ->; last 2 first. - + by rewrite set_fsetU !set_fset1; exact: subset_refl. - + by rewrite cardfs2. - split => //. - + by apply: (mE1E2 0%N) => /=; left. - + by apply: (mE1E2 1%N) => /=; right. -- move=> [mE1 mE2 E1E2M]. - rewrite /pairwise_independent. - split. - + by move=> [| [| [|]]]//=. - + move=> B B01 B2. - have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. - * rewrite B_set0. - move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. - by rewrite big_nil bigcap_set0 probability_setT. - * rewrite B_set0 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set0 fsbig_set1/=. - * rewrite B_set1 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set1 fsbig_set1/=. - * rewrite B_set01 bigcap_setU1 bigcap_set1/=. - rewrite fsbig_seq//= B_set01. - rewrite fsbigU//=; last first. - by move=> n [/= ->]. - by rewrite !fsbig_set1//=. -Qed. - -Lemma pairwise_independent_setC (E1 E2 : set T) : - pairwise_independent E1 E2 -> pairwise_independent E1 (~` E2). -Proof. -rewrite/pairwise_independent. -move/pairwise_independentM=> [mE1 mE2 h]. -apply/pairwise_independentM; split=> //. -- exact: measurableC. -- rewrite -setDE measureD//; last first. - exact: (le_lt_trans (probability_le1 P mE1) (ltry _)). - rewrite probability_setC// muleBr// ?mule1 -?h//. - by rewrite fin_num_measure. -Qed. - -Lemma pairwise_independentC (E1 E2 : set T) : - pairwise_independent E1 E2 -> pairwise_independent E2 E1. -Proof. -rewrite/pairwise_independent/kwise_independent; move=> [mE1E2 /(_ [fset 0%N; 1%N]%fset)]. -rewrite bigcap_fset !big_fsetU1 ?inE//= !big_seq_fset1/= => h. -split. -- case=> [_|[_|]]//=. - + by apply: (mE1E2 1%N) => /=; right. - + by apply: (mE1E2 0%N) => /=; left. -- move=> B B01 B2. - have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. - + rewrite B_set0. - move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. - by rewrite big_nil bigcap_set0 probability_setT. - + rewrite B_set0 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set0 fsbig_set1/=. - + rewrite B_set1 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set1 fsbig_set1/=. - + rewrite B_set01 bigcap_setU1 bigcap_set1/=. - rewrite fsbig_seq//= B_set01. - rewrite fsbigU//=; last first. - by move=> n [/= ->]. - rewrite !fsbig_set1//= muleC setIC. - apply: h. - * by rewrite set_fsetU !set_fset1; exact: subset_refl. - * by rewrite cardfs2. -Qed. -(* ale: maybe interesting is thm 8.3 and exercise 8.6 from shoup/ntb at this point *) - -End independent_events. - -Section conditional_probability. -Context d (T : measurableType d) (R : realType). -Local Open Scope ereal_scope. - -Definition conditional_probability (P : probability T R) E1 E2 := - (fine (P (E1 `&` E2)) / fine (P E2))%:E. -Local Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). - -Lemma conditional_independence (P : probability T R) E1 E2 : - P E2 != 0 -> pairwise_independent P E1 E2 -> 'P [ E1 | E2 ] = P E1. -Proof. -move=> PE2ne0 iE12. -have /= mE1 := (iE12.1 0%N). -have /= mE2 := (iE12.1 1%N). -rewrite/conditional_probability. -have [_ _ ->] := (pairwise_independentM _ _ _).1 iE12. -rewrite fineM ?fin_num_measure//; [|apply: mE1; left=>//|apply: mE2; right=>//]. -rewrite -mulrA mulfV ?mulr1 ?fineK// ?fin_num_measure//; first by apply: mE1; left. -by rewrite fine_eq0// fin_num_measure//; apply: mE2; right. -Qed. - -(* TODO (klenke thm 8.4): if P B > 0 then 'P[.|B] is a probability measure *) - -Lemma conditional_independent_is_pairwise_independent (P : probability T R) E1 E2 : - d.-measurable E1 -> d.-measurable E2 -> - P E2 != 0 -> - 'P[E1 | E2] = P E1 -> pairwise_independent P E1 E2. -Proof. -rewrite /conditional_probability/pairwise_independent=> mE1 mE2 pE20 pE1E2. -split. -- by case=> [|[|]]//=. -- move=> B B01 B2; have [B_set0|B_set0|B_set1|B_set01] := subset_set2 B01. - + rewrite B_set0. - move: B_set0 => /eqP; rewrite set_fset_eq0 => /eqP ->. - by rewrite big_nil bigcap_set0 probability_setT. - + rewrite B_set0 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set0 fsbig_set1/=. - + rewrite B_set1 bigcap_set1 /=. - by rewrite fsbig_seq//= B_set1 fsbig_set1/=. - + rewrite B_set01 bigcap_setU1 bigcap_set1/=. - rewrite fsbig_seq//= B_set01. - rewrite fsbigU//=; last first. - by move=> n [/= ->]. - rewrite !fsbig_set1//= -pE1E2 -{2}(@fineK _ (P E2)). - rewrite -EFinM -mulrA mulVf ?mulr1 ?fine_eq0// ?fineK//. - all: by apply: fin_num_measure => //; apply: measurableI. -Qed. - -Lemma conditional_independentC (P : probability T R) E1 E2 : - d.-measurable E1 -> d.-measurable E2 -> - P E1 != 0 -> P E2 != 0 -> - reflect ('P[E1 | E2] == P E1) ('P[E2 | E1] == P E2). -Proof. -move=> mE1 mE2 pE10 pE20. -apply/(iffP idP)=>/eqP. -+ move/(@conditional_independent_is_pairwise_independent _ _ _ mE2 mE1 pE10). - move/pairwise_independentC. - by move/(conditional_independence pE20)/eqP. -+ move/(@conditional_independent_is_pairwise_independent _ _ _ mE1 mE2 pE20). - move/pairwise_independentC. - by move/(conditional_independence pE10)/eqP. -Qed. - -(* Lemma summation (I : choiceType) (A : {fset I}) E F (P : probability T R) : *) -(* (* the sets are disjoint *) *) -(* P (\bigcap_(i in [set` A]) F i) = 1 -> P E = \prod_(i <- A) ('P [E | F i] * P (F i)). *) -(* Proof. *) -(* move=> pF1. *) - -Lemma bayes (P : probability T R) E F : - d.-measurable E -> d.-measurable F -> - 'P[ E | F ] = ((fine ('P[F | E] * P E)) / (fine (P F)))%:E. -Proof. -rewrite /conditional_probability => mE mF. -have [PE0|PE0] := eqVneq (P E) 0. - have -> : P (E `&` F) = 0. - by apply/eqP; rewrite eq_le -{1}PE0 (@measureIl _ _ _ P E F mE mF)/= measure_ge0. - by rewrite PE0 fine0 invr0 mulr0 mule0 mul0r. -by rewrite -{2}(@fineK _ (P E)) -?EFinM -?(mulrA (fine _)) ?mulVf ?fine_eq0 ?fin_num_measure// mul1r setIC//. -Qed. - -End conditional_probability. -Notation "' P [ E1 | E2 ]" := (conditional_probability P E1 E2). - -From mathcomp Require Import real_interval. - -Section independent_RVs. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Definition pairwise_independent_RV (X Y : {RV P >-> R}) := - forall s t, pairwise_independent P (X @^-1` s) (Y @^-1` t). - -Lemma conditional_independent_RV (X Y : {RV P >-> R}) : - pairwise_independent_RV X Y -> - forall s t, P (Y @^-1` t) != 0 -> 'P [X @^-1` s | Y @^-1` t] = P (X @^-1` s). -Proof. -move=> iRVXY s t PYtne0. -exact: conditional_independence. -Qed. - -Definition mutually_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := - forall x_ : I -> R, independent_events P A (fun i => X i @^-1` `[(x_ i), +oo[%classic). - -Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := - forall x_ : I -> R, kwise_independent P A (fun i => X i @^-1` `[(x_ i), +oo[%classic) k. - -Lemma nwise_indep_is_mutual_indep_RV (I : choiceType) (A : {fset I}) (X : I -> {RV P >-> R}) n : - #|` A | = n -> kwise_independent_RV [set` A] X n -> mutually_independent_RV [set` A] X. -Proof. -rewrite/mutually_independent_RV/kwise_independent_RV=> nA kwX s. -by apply: nwise_indep_is_mutual_indep; rewrite ?nA. -Qed. - -(* alternative formalization -Definition inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) := - forall (s : I -> set R), mutually_independent P A (fun i => X i @^-1` s i). - -Definition kwise_independent_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) k := - forall (s : I -> set R), kwise_independent P A (fun i => X i @^-1` s i) k. - -this should be equivalent according to wikipedia https://en.wikipedia.org/wiki/Independence_(probability_theory)#For_real_valued_random_variables -*) - -(* Remark 2.15 (i) *) -Lemma prob_inde_RV (I : choiceType) (A : set I) (X : I -> {RV P >-> R}) : - mutually_independent_RV A X -> - forall J : {fset I}, [set` J] `<=` A -> - forall x_ : I -> R, - P (\bigcap_(i in [set` J]) X i @^-1` `[(x_ i), +oo[%classic) = - \prod_(i <- J) P (X i @^-1` `[(x_ i), +oo[%classic). -Proof. -move=> iRVX J JleA x_. -apply: (iRVX _).2 => //. -Qed. - -End independent_RVs. - -(* TODO: this generalize subset_itv! *) -Lemma subset_itvW_bound (d : Order.disp_t) (T : porderType d) - (x y z u : itv_bound T) : - (x <= y)%O -> (z <= u)%O -> [set` Interval y z] `<=` [set` Interval x u]. -Proof. -move=> xy zu. -by apply: (@subset_trans _ [set` Interval x z]); - [exact: subset_itvr | exact: subset_itvl]. -Qed. - -Lemma memB_itv (R : numDomainType) (b0 b1 : bool) (x y z : R) : - (y - z \in Interval (BSide b0 x) (BSide b1 y)) = - (x + z \in Interval (BSide (~~ b1) x) (BSide (~~ b0) y)). -Proof. -rewrite !in_itv /= /Order.lteif !if_neg. -by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. -Qed. - -(* generalizes mem_1B_itvcc *) -Lemma memB_itv0 (R : numDomainType) (b0 b1 : bool) (x y : R) : - (y - x \in Interval (BSide b0 0) (BSide b1 y)) = - (x \in Interval (BSide (~~ b1) 0) (BSide (~~ b0) y)). -Proof. by rewrite memB_itv add0r. Qed. - -Lemma gtr0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : - (forall x : R, x \in `]a, b[ -> derivable f x 1) -> - (forall x : R, x \in `]a, b[ -> 0 < 'D_1 f x) -> - {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> - {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x < y >-> x < y}}. -Proof. -move=> df dfgt0 cf x y + + xy. -rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. -have HMVT1: {within `[x, y], continuous f}%classic. - exact/(continuous_subspaceW _ cf)/subset_itvW_bound. -have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itvW_bound. - by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. - by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. -have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). - by move=> zxy; exact/derivableP/df/zab. -rewrite -subr_gt0. -have[z zxy ->]:= MVT xy HMVT0 HMVT1. -rewrite mulr_gt0// ?subr_gt0// dfgt0//. -exact: zab. -Qed. - -Lemma ger0_derive1_homo (R : realType) (f : R^o -> R^o) (a b : R) (sa sb : bool) : - (forall x : R, x \in `]a, b[ -> derivable f x 1) -> - (forall x : R, x \in `]a, b[ -> 0 <= 'D_1 f x) -> - {within [set` (Interval (BSide sa a) (BSide sb b))], continuous f} -> - {in (Interval (BSide sa a) (BSide sb b)) &, {homo f : x y / x <= y >-> x <= y}}. -Proof. -move=> df dfge0 cf x y + + xy. -rewrite !itv_boundlr /= => /andP [] ax ? /andP [] ? yb. -have HMVT1: {within `[x, y], continuous f}%classic. - exact/(continuous_subspaceW _ cf)/subset_itvW_bound. -have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itvW_bound. - by move: ax; clear; case: sa; rewrite !bnd_simp// => /ltW. - by move: yb; clear; case: sb; rewrite !bnd_simp// => /ltW. -have HMVT0 (z : R^o) : z \in `]x, y[ -> is_derive z 1 f ('D_1 f z). - by move=> zxy; exact/derivableP/df/zab. -rewrite -subr_ge0. -move: (xy); rewrite le_eqVlt=> /orP [/eqP-> | xy']; first by rewrite subrr. -have[z zxy ->]:= MVT xy' HMVT0 HMVT1. -rewrite mulr_ge0// ?subr_ge0// dfge0//. -exact: zab. -Qed. - -Section bool_to_real. -Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). -Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). - -Lemma measurable_bool_to_real : measurable_fun [set: T] bool_to_real. -Proof. -rewrite /bool_to_real. -apply: measurableT_comp => //=. -exact: (@measurable_funPT _ _ _ _ f). -Qed. -(* HB.about isMeasurableFun.Build. *) -HB.instance Definition _ := - isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. - -HB.instance Definition _ := MeasurableFun.on bool_to_real. - -Definition btr : {RV P >-> R} := bool_to_real. - -End bool_to_real. - -Section independent_RVs_btr. -Context {R : realType} d (T : measurableType d). -Variable P : probability T R. -Local Open Scope ring_scope. - -Lemma independent_RVs_btr - n (X : n.-tuple {mfun T >-> bool}) : - independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] (fun i => btr P (tnth X i)). -Proof. -move=> PIX; split. -- move=> i Ii. - rewrite /g_sigma_algebra_preimage/= /preimage_set_system/= => _ [A mA <-]. - by rewrite setTI; exact/measurable_sfunP. -- move=> J JI E/= JEfX; apply PIX => // j jJ. - have := JEfX _ jJ; rewrite !inE. - rewrite /g_sigma_algebra_preimage /preimage_set_system/= => -[A mA <-]. - by exists ((fun x => x%:R) @^-1` A). -Qed. - -End independent_RVs_btr. - -Section mfunM. -Context {d} (T : measurableType d) {R : realType}. - -HB.instance Definition _ (f g : {mfun T >-> R}) := - @isMeasurableFun.Build d _ _ _ (f \* g)%R - (measurable_funM (@measurable_funPT _ _ _ _ f) - ((@measurable_funPT _ _ _ _ g))). - -End mfunM. - -Section move. - -Lemma sumr_map {R : realType} U d (T : measurableType d) (l : seq U) Q - (f : U -> {mfun T >-> R}) (x : T) : - (\sum_(i <- l | Q i) f i) x = \sum_(i <- l | Q i) f i x. -Proof. by elim/big_ind2 : _ => //= _ g _ h <- <-. Qed. - -Lemma prodr_map {R : realType} U d (T : measurableType d) (l : seq U) Q - (f : U -> {mfun T >-> R}) (x : T) : - (\prod_(i <- l | Q i) f i) x = \prod_(i <- l | Q i) f i x. -Proof. by elim/big_ind2 : _ => //= _ h _ g <- <-. Qed. - -Definition sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : T -> R := - fun x => \sum_(f <- s) f x. - -Lemma measurable_sumrfct {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) : - measurable_fun setT (sumrfct s). -Proof. -apply/measurable_EFinP => /=; apply/measurableT_comp => //. -exact: measurable_sum. -Qed. - -HB.instance Definition _ {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (sumrfct s) (measurable_sumrfct s). - -Lemma sum_mfunE {R : realType} d {T : measurableType d} (s : seq {mfun T >-> R}) x : - ((\sum_(f <- s) f) x = sumrfct s x)%R. -Proof. by rewrite/sumrfct; elim/big_ind2 : _ => //= u a v b <- <-. Qed. - -End move. - -Section move_to_bigop_nat_lemmas. -Context {T : Type}. -Implicit Types (A : set T). - -Lemma bigcup_mkord_ord n (F : 'I_n.+1 -> set T) : - \bigcup_(i < n.+1) F (inord i) = \big[setU/set0]_(i < n.+1) F i. -Proof. -rewrite bigcup_mkord; apply: eq_bigr => /= i _; congr F. -by apply/val_inj => /=;rewrite inordK. -Qed. - -End move_to_bigop_nat_lemmas. - -(* in master *) -Lemma preimage_set_systemU {aT rT : Type} {X : set aT} {f : aT -> rT} : - {morph preimage_set_system X f : x y / x `|` y >-> x `|` y}. -Proof. -move=> F G; apply/seteqP; split=> A; rewrite /preimage_set_system /=. - by case=> B + <- => -[? | ?]; [left | right]; exists B. -by case=> -[] B FGB <-; exists B=> //; [left | right]. -Qed. - -(* in master *) -Lemma preimage_set_system0 {aT rT : Type} {X : set aT} {f : aT -> rT} : - preimage_set_system X f set0 = set0. -Proof. by apply/seteqP; split=> A // []. Qed. - -(* in master *) -Lemma preimage_set_system_funcomp - {aT arT rT : Type} {f : aT -> arT} {g : arT -> rT} {F : set_system rT} D : - preimage_set_system D (g \o f) F = - preimage_set_system D f (preimage_set_system setT g F). -Proof. -apply/seteqP; split=> A. - case=> B FB <-. - exists (g @^-1` B)=> //. - exists B=> //. - by rewrite setTI. -case=> B [] C FC <- <-. -exists C=> //. -rewrite !setTI. -by rewrite comp_preimage. -Qed. - -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} (f1 : 'I_n -> T -> T1) [T3 : Type] (g : T3 -> T) : -g_sigma_preimage (fun i => (f1 i \o g)) = -preimage_set_system [set: T3] g (g_sigma_preimage f1). -Proof. -rewrite {1}/g_sigma_preimage. -rewrite -g_sigma_preimageE; congr (<>). -destruct n as [|n]. - rewrite !big_ord0 /preimage_set_system/=. - by apply/esym; rewrite -subset0 => t/= []. -rewrite predeqE => C; split. -- rewrite -bigcup_mkord_ord => -[i Ii [A mA <-{C}]]. - exists (f1 (Ordinal Ii) @^-1` A). - rewrite -bigcup_mkord_ord; exists i => //. - exists A => //; rewrite setTI// (_ : Ordinal _ = inord i)//. - by apply/val_inj => /=;rewrite inordK. - rewrite !setTI// -comp_preimage// (_ : Ordinal _ = inord i)//. - by apply/val_inj => /=;rewrite inordK. -- move=> [A]. - rewrite -bigcup_mkord_ord => -[i Ii [B mB <-{A}]] <-{C}. - rewrite -bigcup_mkord_ord. - exists i => //. - by exists B => //; rewrite !setTI -comp_preimage. -Qed. - -HB.instance Definition _ (n : nat) (T : pointedType) := - isPointed.Build (n.-tuple T) (nseq n point). - -Definition mtuple (n : nat) d (T : measurableType d) : Type := n.-tuple T. - -HB.instance Definition _ (n : nat) d (T : measurableType d) := - Pointed.on (mtuple n T). - -Lemma countable_range_bool d (T : measurableType d) (b : bool) : - countable (range (@cst T _ b)). -Proof. exact: countableP. Qed. - -HB.instance Definition _ d (T : measurableType d) b := - MeasurableFun_isDiscrete.Build d _ T _ (cst b) (countable_range_bool T b). - -Definition measure_tuple_display : measure_display -> measure_display. -Proof. exact. Qed. - -Section measurable_tuple. -Context {d} {T : measurableType d}. -Variable n : nat. - -Let coors := (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) - (mtuple n T) (g_sigma_preimage coors) - (tuple_set0) (tuple_setC) (tuple_bigcup). - -End measurable_tuple. - -(* NB: not used *) -Definition cylinder d {T : measurableType d} m (A : set (m.-tuple T)) - (J : {fset 'I_m}%fset) : set (m.-tuple T) := - \big[setI/setT]_(i <- J) (@tnth _ T ^~ i) @^-1` - ((@tnth _ T ^~ i) @` A). - -(* NB: not used *) -Definition Z d {T : measurableType d} m - (J : {fset 'I_m}%fset) : set_system (m.-tuple T) := - [set B | exists A, B = cylinder A J]. - -Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : - measurable_fun [set: mtuple n 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 cons_measurable_fun. -Context d d1 (T : measurableType d) (T1 : measurableType d1). - -Lemma cons_measurable_funP (n : nat) (h : T -> mtuple n T1) : - measurable_fun setT h <-> - forall i : 'I_n, measurable_fun setT ((@tnth _ T1 ^~ i) \o h). -Proof. -apply: (@iff_trans _ (g_sigma_preimage - (fun i : 'I_n => (@tnth _ T1 ^~ i) \o h) `<=` measurable)). -- rewrite g_sigma_preimage_comp; split=> [mf A [C HC <-]|f12]. - exact: mf. - by move=> _ A mA; apply: f12; exists A. -- split=> [h12|mh]. - move=> i _ A mA. - apply: h12. - apply: sub_sigma_algebra. - destruct n as [|n]. - by case: i => [] []. - rewrite -bigcup_mkord_ord. - exists i => //; first by red. - exists A => //. - rewrite !setTI. - rewrite (_ : inord i = i)//. - by apply/val_inj => /=; rewrite inordK. - apply: smallest_sub; first exact: sigma_algebra_measurable. - destruct n as [|n]. - by rewrite big_ord0. - rewrite -bigcup_mkord_ord. - apply: bigcup_sub => i Ii. - move=> A [C mC <-]. - exact: mh. -Qed. - -(* TODO: rename to measurable_cons *) -Lemma measurable_fun_cons (f : T -> T1) n (g : T -> mtuple n T1) : - measurable_fun setT f -> measurable_fun setT g -> - measurable_fun setT (fun x : T => [the mtuple n.+1 T1 of (f x) :: (g x)]). -Proof. -move=> mf mg; apply/cons_measurable_funP => /= i. -have [->|i0] := eqVneq i ord0. - by rewrite (_ : _ \o _ = f). -have @j : 'I_n. - apply: (@Ordinal _ i.-1). - rewrite prednK//. - have := ltn_ord i. - by rewrite ltnS. - by rewrite lt0n. -rewrite (_ : _ \o _ = (fun x => tnth (g x) j))//. - apply: (@measurableT_comp _ _ _ _ _ _ - (fun x : mtuple n T1 => tnth x j) _ g) => //. - exact: measurable_tnth. -apply/funext => t/=. -rewrite (_ : i = lift ord0 j) ?tnthS//. -apply/val_inj => /=. -by rewrite /bump/= add1n prednK// lt0n. -Qed. - -End cons_measurable_fun. - -Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : - behead t = [tuple (tnth t (lift ord0 i)) | i < n]. -Proof. -destruct n as [|n]. - rewrite !tuple0. - apply: size0nil. - by rewrite size_behead size_tuple. -apply: (@eq_from_nth _ (tnth_default t ord0)). - by rewrite size_behead !size_tuple. -move=> i ti. -rewrite nth_behead/= (nth_map ord0); last first. - rewrite size_enum_ord. - by rewrite size_behead size_tuple in ti. -rewrite (tnth_nth (tnth_default t ord0)). -congr nth. -rewrite /= /bump/= add1n; congr S. -apply/esym. -rewrite size_behead size_tuple in ti. -have := @nth_ord_enum _ ord0 (Ordinal ti). -by move=> ->. -Qed. - -Lemma measurable_behead d (T : measurableType d) n : - measurable_fun setT (fun x : mtuple n.+1 T => [tuple of behead x] : mtuple n T). -Proof. -red=> /=. -move=> _ Y mY. -rewrite setTI. -set bh := (bh in preimage bh). -have bhYE : (bh @^-1` Y) = [set x :: y | x in setT & y in Y]. - rewrite /bh. - apply/seteqP; split=> x /=. - move=> ?; exists (thead x)=> //. - exists [tuple of behead x] => //=. - by rewrite [in RHS](tuple_eta x). - case=> x0 _ [] y Yy xE. - suff->: [tuple of behead x] = y by []. - apply/val_inj=> /=. - by rewrite -xE. -have:= mY. -rewrite /measurable/= => + F [] sF. -pose F' := image_set_system setT bh F. -move=> /(_ F') /=. -have-> : F' Y = F (bh @^-1` Y) by rewrite /F' /image_set_system /= setTI. -move=> /[swap] H; apply; split; first exact: sigma_algebra_image. -move=> A; rewrite /= /F' /image_set_system /= setTI. -set X := (X in X A). -move => XA. -apply: H; rewrite big_ord_recl /=; right. -set X' := (X' in X' (preimage _ _)). -have-> : X' = preimage_set_system setT bh X. - rewrite /X. - rewrite (big_morph _ preimage_set_systemU preimage_set_system0). - apply: eq_bigr=> i _. - rewrite -preimage_set_system_funcomp. - congr preimage_set_system. - apply: funext=> t. - rewrite (tuple_eta t) /bh /= tnthS. - by congr tnth; apply/val_inj. -exists A=> //. -by rewrite setTI. -Qed. - -Section pro1. -Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} - (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). - -Definition pro1 := product_measure1 P1 P2. - -HB.instance Definition _ := Measure.on pro1. - -Lemma pro1_setT : pro1 setT = 1%E. -Proof. -rewrite /pro1 -setXTT product_measure1E// -[RHS]mule1. -by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). -Qed. - -HB.instance Definition _ := - Measure_isProbability.Build _ _ _ pro1 pro1_setT. -End pro1. - -Section pro2. -Context {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} - (R : realType) (P1 : probability T1 R) (P2 : probability T2 R). - -Definition pro2 := product_measure2 P1 P2. - -HB.instance Definition _ := Measure.on pro2. - -Lemma pro2_setT : pro2 setT = 1%E. -Proof. -rewrite /pro2 -setXTT product_measure2E// -[RHS]mule1. -by rewrite -{1}(@probability_setT _ _ _ P1) -(@probability_setT _ _ _ P2). -Qed. - -HB.instance Definition _ := - Measure_isProbability.Build _ _ _ pro2 pro2_setT. -End pro2. - -Section pro. -Context d (T : measurableType d) (R : realType) (P : probability T R). - -Fixpoint mpro (n : nat) : set (mtuple n T) -> \bar R := - match n with - | 0%N => \d_([::] : mtuple 0 T) - | m.+1 => fun A => (P \x^ @mpro m)%E [set (thead x, [tuple of behead x]) | x in A] - end. - -Lemma mpro_measure n : @mpro n set0 = 0 /\ (forall A, (0 <= @mpro n A)%E) - /\ semi_sigma_additive (@mpro n). -Proof. -elim: n => //= [|n ih]. - by repeat split => //; exact: measure_semi_sigma_additive. -pose build_Mpro := isMeasure.Build _ _ _ (@mpro n) ih.1 ih.2.1 ih.2.2. -pose Mpro : measure _ R := HB.pack (@mpro n) build_Mpro. -pose ppro : measure _ R := (P \x^ Mpro)%E. -split. - rewrite image_set0 /product_measure2 /=. - under eq_fun => x do rewrite ysection0 measure0 (_ : 0 = cst 0 x)//. - rewrite (_ : @mpro n = Mpro)//. - by rewrite integral_cst// mul0e. -split. - by move => A; rewrite (_ : @mpro n = Mpro). -rewrite (_ : @mpro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. -move=> F mF dF mUF. -rewrite image_bigcup. -move=> [:save]. -apply: measure_semi_sigma_additive. -- abstract: save. - move=> i. - pose f (t : n.+1.-tuple T) := (@thead n T t, [the mtuple _ T of behead t]). - pose f' (x : T * mtuple n T) := [the mtuple n.+1 T of x.1 :: x.2]. - rewrite [X in measurable X](_ : _ = f' @^-1` F i); last first. - apply/seteqP; split=> [x/= [t Fit] <-{x}|[x1 x2] /= Fif']. - rewrite /f'/=. - by rewrite (tuple_eta t) in Fit. - exists (f' (x1, x2)) => //. - rewrite /f' /= theadE//; congr pair. - exact/val_inj. - rewrite -[X in measurable X]setTI. - suff: measurable_fun setT f' by exact. - rewrite /= /f'. - exact: measurable_fun_cons. -- (* TODO: lemma? *) - apply/trivIsetP => i j _ _ ij. - move/trivIsetP : dF => /(_ i j Logic.I Logic.I ij). - rewrite -!subset0 => ij0 /= [_ _] [[t Fit] [<- <-]]/=. - move=> [u Fju [hut tut]]. - have := ij0 t; apply; split => //. - suff: t = u by move=> ->. - rewrite (tuple_eta t) (tuple_eta u) hut. - by apply/val_inj => /=; rewrite tut. -- apply: bigcup_measurable => j _. - exact: save. -Qed. - -HB.instance Definition _ n := isMeasure.Build _ _ _ (@mpro n) - (@mpro_measure n).1 (@mpro_measure n).2.1 (@mpro_measure n).2.2. - -Lemma mpro_setT n : @mpro n setT = 1%E. -Proof. -elim: n => //=; first by rewrite diracT. -move=> n ih. -rewrite /product_measure2/ysection/=. -under eq_fun => x. - rewrite [X in P X](_ : _ = [set: T]); last first. - under eq_fun => y. rewrite [X in _ \in X](_ : _ = setT); last first. - apply: funext=> z/=. - apply: propT. - exists (z.1 :: z.2) => //=. - case: z => z1 z2/=. - congr pair. - exact/val_inj. - over. - by apply: funext => y/=; rewrite in_setT trueE. - rewrite probability_setT. - over. -by rewrite integral_cst// mul1e. -Qed. - -HB.instance Definition _ n := - Measure_isProbability.Build _ _ _ (@mpro n) (@mpro_setT n). - -Definition pro (n : nat) : probability (mtuple n T) R := @mpro n. - -End pro. -Arguments pro {d T R} P n. - -Notation "\X_ n P" := (pro P n) (at level 10, n, P at next level, - format "\X_ n P"). - -Lemma fubini2' : -forall [d1 d2 : measure_display] [T1 : measurableType d1] - [T2 : measurableType d2] [R : realType] - [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] - f -> (\int[m2]_x fubini_G m1 f x = \int[(m1 \x^ m2)%E]_z f z)%E. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f intf. -rewrite fubini2//. -apply: eq_measure_integral => //= A mA _. -apply: product_measure_unique => // B C mB mC. -rewrite /=. -by rewrite product_measure2E. -Qed. - -Lemma fubini1' : -forall [d1 d2 : measure_display] [T1 : measurableType d1] - [T2 : measurableType d2] [R : realType] - [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] - f -> (\int[m1]_x fubini_F m2 f x = \int[(m1 \x^ m2)%E]_z f z)%E. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f intf. -rewrite fubini1//. -apply: eq_measure_integral => //= A mA _. -apply: product_measure_unique => // B C mB mC. -rewrite /=. -by rewrite product_measure2E. -Qed. - -Lemma integrable_prodP : -forall [d1 d2 : measure_display] [T1 : measurableType d1] [T2 : measurableType d2] - [R : realType] [m1 : {sigma_finite_measure set T1 -> \bar R}] - [m2 : {sigma_finite_measure set T2 -> \bar R}] [f : T1 * T2 -> \bar R], -(m1 \x m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f -> -(m1 \x^ m2)%E.-integrable [set: Datatypes_prod__canonical__measure_Measurable T1 T2] f. -Proof. -move=> d1 d2 T1 T2 R m1 m2 f /integrableP[mf intf]; apply/integrableP; split => //. - rewrite -fubini2'//=. - rewrite fubini2//=. - apply/integrableP; split => //. - by apply/measurableT_comp => //. - by under eq_integral do rewrite abse_id. - apply/integrableP; split => //. - by apply/measurableT_comp => //. - by under eq_integral do rewrite abse_id. -Qed. - -Section proS. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. -Variable n : nat. - -Definition phi := fun (w : T * mtuple n T) => [the mtuple _ _ of w.1 :: w.2]. - -Lemma mphi : measurable_fun [set: T * mtuple _ _] phi. -Proof. exact: measurable_fun_cons. Qed. - -Definition psi := fun (w : mtuple n.+1 T) => (thead w, [the mtuple _ _ of behead w]). - -Lemma mpsi : measurable_fun [set: mtuple _ _] psi. -Proof. -apply/measurable_fun_prod => /=. - exact: measurable_tnth. -exact: measurable_behead. -Qed. - -Lemma phiK : cancel phi psi. -Proof. -by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. -Qed. - -Let psiK : cancel psi phi. -Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. - -Lemma integral_mpro (f : n.+1.-tuple T -> R) : - (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f) -> - \int[\X_n.+1 P]_w (f w)%:E = - \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. -Proof. -move=> /integrableP[mf intf]. -rewrite -(@integral_pushforward _ _ _ _ R _ mphi _ setT - (fun x : mtuple n.+1 T => (f x)%:E)); [|by []| |by []]. - apply: eq_measure_integral => A mA _. - rewrite /=. - rewrite /pushforward. - rewrite /pro2. - rewrite /phi/=. - rewrite /preimage/=. - congr (_ _). - apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. - move: At. - by rewrite {1}(tuple_eta t)//. - exists (x.1 :: x.2) => //=. - destruct x as [x1 x2] => //=. - congr pair. - exact/val_inj. -rewrite /=. -apply/integrable_prodP. -rewrite /=. -apply/integrableP; split => /=. - apply: measurableT_comp => //=. - exact: mphi. -apply: le_lt_trans (intf). -rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x - ((((abse \o (@EFin R \o (f \o phi)))) \o psi) x)); last first. - by apply: eq_integral => x _ /=; rewrite psiK. -rewrite le_eqVlt; apply/orP; left; apply/eqP. -rewrite -[RHS](@integral_pushforward _ _ _ _ R _ mpsi _ setT - (fun x : T * mtuple n T => ((abse \o (EFin \o (f \o phi))) x)))//. -- apply: eq_measure_integral => // A mA _. - apply: product_measure_unique => // B C mB mC. - rewrite /= /pushforward/=. - rewrite -product_measure2E//=. - congr (_ _). - (* TODO: lemma *) - apply/seteqP; split => [[x1 x2]/= [t [Bt Ct]] [<- <-//]|]. - move=> [x1 x2] [B1 C2] /=. - exists (x1 :: x2) => //=. - split=> //. - rewrite [X in C X](_ : _ = x2)//. - exact/val_inj. - congr pair => //. - exact/val_inj. -- apply/measurable_EFinP => //=. - apply: measurableT_comp => //=. - apply: measurableT_comp => //=. - by apply/measurable_EFinP. - exact: mphi. -- have : (\X_n.+1 P).-integrable [set: mtuple n.+1 T] (EFin \o f). - exact/integrableP. -- apply: le_integrable => //=. - + apply: measurableT_comp => //=; last exact: mpsi. - apply/measurable_EFinP => //=. - apply: measurableT_comp => //=. - apply: measurableT_comp => //=; last exact: mphi. - by apply/measurable_EFinP => //=. - + move=> x _. - by rewrite normr_id// psiK. -Qed. - -End proS. - -Section integrable_theory. -Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}). -Variables (D : set T) (mD : measurable D). -Implicit Type f g : T -> \bar R. - -Let ltnP_sumbool (a b : nat) : {(a < b)%N} + {(a >= b)%N}. -Proof. by case: ltnP => _; [left|right]. Qed. - -(* TODO: clean, move near integrable_sum, refactor *) -Lemma integrable_sum_ord n (t : 'I_n -> (T -> \bar R)) : - (forall i, mu.-integrable D (t i)) -> - mu.-integrable D (fun x => \sum_(i < n) t i x). -Proof. -move=> intt. -pose s0 := fun k => match ltnP_sumbool k n with - | left kn => t (Ordinal kn) - | right _ => cst 0%E - end. -pose s := [tuple of map s0 (index_iota 0 n)]. -suff: mu.-integrable D (fun x => (\sum_(i <- s) i x)%R). - apply: eq_integrable => // i iT. - rewrite big_map/=. - rewrite big_mkord. - apply: eq_bigr => /= j _. - rewrite /s0. - case: ltnP_sumbool => // jn. - f_equal. - exact/val_inj. - have := ltn_ord j. - by rewrite ltnNge jn. -apply: (@integrable_sum d T R mu D mD s) => /= h /mapP[/= k]. -rewrite mem_index_iota leq0n/= => kn ->{h}. -have := intt (Ordinal kn). -rewrite /s0. -case: ltnP_sumbool => //. -by rewrite leqNgt kn. -Qed. - -End integrable_theory. - -(* TODO: clean, move near integrableD, refactor *) -Section integral_sum. -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). -Variables (I : eqType) (f : I -> (T -> \bar R)). -Hypothesis intf : forall n, mu.-integrable D (f n). - -Lemma integral_sum (s : seq I) : - \int[mu]_(x in D) (\sum_(k <- s) f k x) = - \sum_(k <- s) \int[mu]_(x in D) (f k x). -Proof. -elim: s => [|h t ih]. - under eq_integral do rewrite big_nil. - by rewrite integral0 big_nil. -rewrite big_cons -ih -integralD//. - by apply: eq_integral => x xD; rewrite big_cons. -rewrite [X in _.-integrable _ X](_ : _ = - (fun x => (\sum_(h0 <- [seq f i | i <- t]) h0 x))); last first. - by apply/funext => x; rewrite big_map. -apply: integrable_sum => //= g /mapP[i ti ->{g}]. -exact: intf. -Qed. - -End integral_sum. - -(* TODO: integral_fune_lt_pinfty does not look useful a lemma *) - -Section integrable_thead. -Context d (T : measurableType d) (R : realType). -Variables (P : probability T R) (n : nat) (X : n.+1.-tuple {RV P >-> R}). - -Lemma integrable_thead : P.-integrable setT (EFin \o thead X) -> - (\X_n.+1 P).-integrable [set: mtuple n.+1 T] - (EFin \o (fun x => thead X (thead x))). -Proof. -move=> intX. -apply/integrableP; split. - apply: measurableT_comp => //. - apply: measurableT_comp => //. - exact: measurable_tnth. -rewrite integral_mpro. -- rewrite -fubini1'//=. - + move/integrableP : (intX) => [_]. - + apply: le_lt_trans. - rewrite le_eqVlt; apply/orP; left; apply/eqP. - apply: eq_integral => x _. - rewrite /fubini_F/=. - admit. - + apply/fubini1b => //=. - * admit. - * admit. -- apply/integrableP; split. - + admit. - + rewrite integral_mpro. -Abort. - -End integrable_thead. - -Lemma bounded_RV_integrable d (T : measurableType d) (R : realType) - (P : probability T R) (X : T -> R) M : - measurable_fun setT X -> - (forall t, (0 <= X t <= M)%R) -> P.-integrable setT (EFin \o X). -Proof. -move=> mf XM. -apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). -- exact/measurable_EFinP. -- move=> t _ /=; rewrite lee_fin/=. - rewrite !ger0_norm//. - + by have /andP[] := XM t. - + by rewrite (@le_trans _ _ (X t))//; have /andP[] := XM t. - + by have /andP[] := XM t. -- exact: finite_measure_integrable_cst. -Qed. -Arguments bounded_RV_integrable {d T R P X} M. - -Module with_interval. -Declare Scope bigQ_scope. -Import Reals. -Import Rstruct. -Import Interval.Tactic. - -Section expR2_le8. -Let R := Rdefinitions.R. -Local Open Scope ring_scope. - -Lemma expR2_le8 : expR 2 <= 8 :> R. -Proof. -rewrite (_ : 2 = 1 + 1)//. -rewrite exp.expRD -RmultE. -rewrite (_ : 8 = 8%R); last first. - by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. -rewrite (_ : 1 = INR 1%N)//=. -rewrite -Rstruct_topology.RexpE. -apply/RleP. -by interval. -Qed. - -End expR2_le8. -End with_interval. - -Section taylor_ln_le. -Let R := Rdefinitions.R. -Local Open Scope ring_scope. - -Lemma taylor_ln_le (x : R) : x \in `]0, 1[ -> (1 + x) * ln (1 + x) >= x + x^+2 / 3. -Proof. -move=> x01; rewrite -subr_ge0. -pose f (x : R^o) := (1 + x) * ln (1 + x) - (x + x ^+ 2 / 3). -have f0 : f 0 = 0 by rewrite /f expr0n /= mul0r !addr0 ln1 mulr0 subr0. -rewrite [leRHS](_ : _ = f x) // -f0. -evar (df0 : R -> R); evar (df : R -> R). -have idf (y : R^o) : 0 < 1 + y -> is_derive y (1:R) f (df y). - move=> y1. - rewrite (_ : df y = df0 y). - apply: is_deriveB; last exact: is_deriveD. - apply: is_deriveM=> //. - apply: is_derive1_comp=> //. - exact: is_derive1_ln. - rewrite /df0. - rewrite deriveD// derive_cst derive_id. - rewrite /GRing.scale /= !(mulr0,add0r,mulr1). - rewrite divff ?lt0r_neq0// opprD addrAC addrA subrr add0r. - instantiate (df := fun y : R => - (3^-1 * (y + y)) + ln (1 + y)). - reflexivity. -clear df0. -have y1cc y : y \in `[0, 1] -> 0 < 1 + y. - rewrite in_itv /= => /andP [] y0 ?. - by have y1: 0 < 1 + y by apply: (le_lt_trans y0); rewrite ltrDr. -have y1oo y : y \in `]0, 1[ -> 0 < 1 + y by move/subset_itv_oo_cc/y1cc. -have dfge0 y : y \in `]0, 1[ -> 0 <= df y. - move=> y01. - have:= y01. - rewrite /df in_itv /= => /andP [] y0 y1. - rewrite -lerBlDl opprK add0r -mulr2n -(mulr_natl _ 2) mulrA. - rewrite [in leLHS](_ : y = 1 + y - 1); last by rewrite addrAC subrr add0r. - pose iy:= Itv01 (ltW y0) (ltW y1). - have y1E: 1 + y = @convex.conv _ R^o iy 1 2. - rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. - by rewrite addrACA (addrC (- y)) subrr addr0. - rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. - rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 add0r /=. - rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. - rewrite ler_pdivrMr//. - rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. - rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. - rewrite !exprS expr0 mulr1 -!natrM mulnE /=. - by rewrite with_interval.expR2_le8. -apply: (@ger0_derive1_homo R f 0 1 true false). -- by move=> y /y1oo /idf /@ex_derive. -- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. -- by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. -- by rewrite bound_itvE. -- exact: subset_itv_oo_cc. -- by have:= x01; rewrite in_itv=> /andP /= [] /ltW. -Qed. - -End taylor_ln_le. - -Section tuple_sum. -Context d (T : measurableType d) (R : realType) (P : probability T R). - -Definition tuple_sum n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := - (fun x => \sum_(i < n) (tnth s i) (tnth x i))%R. - -Lemma measurable_tuple_sum n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (tuple_sum s). -Proof. -apply: measurable_sum => i/=; apply/measurableT_comp => //. -exact: measurable_tnth. -Qed. - -HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (tuple_sum s) (measurable_tuple_sum s). - -Definition tuple_prod n (s : n.-tuple {mfun T >-> R}) : mtuple n T -> R := - (fun x => \prod_(i < n) (tnth s i) (tnth x i))%R. - -Lemma measurable_tuple_prod n (s : n.-tuple {mfun T >-> R}) : - measurable_fun setT (tuple_prod s). -Proof. -apply: measurable_prod => /= i _; apply/measurableT_comp => //. -exact: measurable_tnth. -Qed. - -HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := - isMeasurableFun.Build _ _ _ _ (tuple_prod s) (measurable_tuple_prod s). - -End tuple_sum. - -Section properties_of_expectation. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Lemma expectation_sum_pro n (X : n.-tuple {RV P >-> R}) M : - (forall i t, (0 <= tnth X i t <= M)%R) -> - 'E_(\X_n P)[tuple_sum X] = \sum_(i < n) ('E_P[(tnth X i)]). -Proof. -elim: n X => [X|n IH X] /= XM. - rewrite /tuple_sum. - under eq_fun do rewrite big_ord0. - by rewrite big_ord0 expectation_cst. -pose X0 := thead X. -have intX0 : P.-integrable [set: T] (EFin \o X0). - apply: (bounded_RV_integrable M) => // t. - exact: XM. -have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). - move=> /tnthP[i XiXi]. - apply: (bounded_RV_integrable M) => // t. - rewrite XiXi. - exact: XM. -rewrite big_ord_recl/=. -rewrite /tuple_sum/=. -under eq_fun do rewrite big_ord_recl/=. -pose X1 (x : mtuple n.+1 T) := - (\sum_(i < n) (tnth X (lift ord0 i)) (tnth x (lift ord0 i)))%R. -have mX1 : measurable_fun setT X1. - apply: measurable_sum => /= i; apply: measurableT_comp => //. - exact: measurable_tnth. -pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. -pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). -have mX2 : measurable_fun setT X2. -rewrite /X2 /=. - by apply: measurableT_comp => //; exact: measurable_tnth. -pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. -rewrite [X in 'E__[X]](_ : _ = Y2 \+ Y1)//. -rewrite expectationD; last 2 first. - apply: (bounded_RV_integrable M) => // t. - exact: XM. - rewrite (_ : _ \o _ = fun x => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth x (lift ord0 i)))%:E)); last first. - by apply/funext => t/=; rewrite sumEFin. - apply: integrable_sum_ord => // i. - have : measurable_fun setT (fun x : mtuple n.+1 T => - (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). - apply/measurableT_comp => //=. - exact: measurable_tnth. - by move/(bounded_RV_integrable M); exact. -congr (_ + _). -- rewrite /Y2 /X2/= unlock /expectation. - (* \int[\X_n.+1 P]_w (thead X (thead w))%:E = \int[P]_w (tnth X ord0 w)%:E *) - pose phi : mtuple n.+1 T -> T := (fun w => @tnth n.+1 T w ord0). - have mphi : measurable_fun setT phi. - exact: measurable_tnth. - rewrite -(@integral_pushforward _ _ _ _ _ phi mphi _ setT - (fun w => (tnth X ord0 w)%:E)); last 3 first. - exact/measurable_EFinP. - apply: (bounded_RV_integrable M). - by []. - move=> t. - by apply: XM. - by []. - apply: eq_measure_integral => //= A mA _. - rewrite /pushforward. - rewrite /pro/= /phi. - rewrite [X in (_ \x^ _) X = _](_ : - [set (thead x, [tuple of behead x]) | x in (tnth (T:=T))^~ ord0 @^-1` A] - = A `*` setT); last first. - apply/seteqP; split => [[x1 x2]/= [t At [<- _]]//|]. - move=> [x1 x2]/= [Ax1 _]. - exists [the mtuple _ _ of x1 :: x2] => //=. - by rewrite theadE; congr pair => //; exact/val_inj. - by rewrite product_measure2E//= probability_setT mule1. -- rewrite /Y1 /X1/=. - transitivity ((\sum_(i < n) 'E_ P [(tnth (behead X) i)] )%R); last first. - apply: eq_bigr => /= i _. - congr expectation. - rewrite tnth_behead. - congr (tnth X). - apply/val_inj => /=. - by rewrite /bump/= add1n/= inordK// ltnS. - rewrite -IH; last first. - move=> i t. - rewrite tnth_behead. - exact: XM. - transitivity ('E_\X_n P[(fun x : mtuple n T => - (\sum_(i < n) tnth (behead X) i (tnth x i))%R)]). - rewrite unlock /expectation. - transitivity (\int[(pro2 P (\X_n P))]_w (\sum_(i < n) tnth X (lift ord0 i) (tnth w.2 i))%:E). - rewrite integral_mpro//. - apply: eq_integral => /= -[w1 w2] _. - rewrite -!sumEFin. - apply: eq_bigr => i _ /=. - by rewrite tnthS//. - rewrite (_ : _ \o _ = (fun w => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth w (lift ord0 i)))%:E))); last first. - by apply/funext => t/=; rewrite sumEFin. - apply: integrable_sum_ord => // i. - have : measurable_fun setT (fun x : mtuple n.+1 T => - (tnth X (lift ord0 i) (tnth x (lift ord0 i)))). - apply/measurableT_comp => //=. - exact: measurable_tnth. - by move/(bounded_RV_integrable M); exact. - rewrite /pro2. - rewrite -fubini2'/=; last first. - rewrite [X in integrable _ _ X](_ : _ = (fun z => (\sum_(i < n) - (tnth X (lift ord0 i) (tnth z.2 i))%:E))); last first. - by apply/funext => t/=; rewrite sumEFin. - apply: integrable_sum_ord => //= i. - have : measurable_fun setT (fun x : T * mtuple n T => (tnth X (lift ord0 i) (tnth x.2 i))). - apply/measurableT_comp => //=. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n _ => tnth x i) _ snd) => //=. - exact: measurable_tnth. - move/(@bounded_RV_integrable _ _ R (pro1 P (mpro P (n:=n)))%E _ M) => /=. - apply => t. - by apply: XM. - apply: eq_integral => t _. - rewrite /fubini_G. - transitivity (\sum_(i < n) - (\int[P]_x (tnth X (lift ord0 i) (tnth (x, t).2 i))%:E)). - rewrite -[RHS]integral_sum//. - by apply: eq_integral => x _; rewrite sumEFin. - move=> /= i. - exact: finite_measure_integrable_cst. - rewrite -sumEFin. - apply: eq_bigr => /= i _. - rewrite integral_cst//. - rewrite [X in _ * X]probability_setT mule1. - rewrite tnth_behead//=. - congr (tnth X _ _)%:E. - apply/val_inj => /=. - by rewrite inordK// ltnS. - by []. -Qed. - -Lemma expectation_prod2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) - (P1 : probability T1 R) (P2 : probability T2 R) - (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : - P1.-integrable setT (EFin \o X) -> - P2.-integrable setT (EFin \o Y) -> -(* independent_RVs2 P X Y -> NB: independence not used *) - let XY := fun (x : T1 * T2) => (X x.1 * Y x.2)%R in - 'E_(pro2 P1 P2)[XY] = 'E_P1[X] * 'E_P2[Y]. -Proof. -move=> intX intY/=. -rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. - apply/fubini1b. - - apply/measurable_EFinP => //=. - by apply: measurable_funM => //=; apply: measurableT_comp. - - under eq_integral. - move=> t _. - under eq_integral. - move=> x _. - rewrite /= normrM EFinM muleC. - over. - rewrite /= integralZl//; last first. - by move/integrable_abse : intX. - over. - rewrite /=. - rewrite ge0_integralZr//; last 2 first. - apply/measurable_EFinP => //. - by apply/measurableT_comp => //. - by apply: integral_ge0 => //. - rewrite lte_mul_pinfty//. - by apply: integral_ge0 => //. - apply: integral_fune_fin_num => //. - by move/integrable_abse : intY. - by move/integrableP : intX => []. -rewrite /fubini_F/=. -under eq_integral => x _. - under eq_integral => y _ do rewrite EFinM. - rewrite integralZl//. - rewrite -[X in _ * X]fineK ?integral_fune_fin_num//. - over. -rewrite /=integralZr//. -by rewrite fineK// integral_fune_fin_num. -Qed. - -End properties_of_expectation. - -Section mv_to_inde. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Variable n : nat. - -Lemma independent_RVsD1_ord (*(I : {fset 'I_n.+1})*) (X : n.+1.-tuple {RV P >-> R}) : - independent_RVs (P := P) [set: 'I_n.+1] (tnth X) -> independent_RVs (P := P) ([set: 'I_n.+1] `\ ord0) (tnth X). -Proof. -move=> H. -split => [/= i|/= J JIi0 E EK]. - case=> // ii0 iI. - by apply H. -by apply H => //. -(*move=> /= x /JIi0 /=. -by case.*) -Qed. - -End mv_to_inde. - -Section properties_of_independence. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Lemma independent_mmt_gen_fun n (X : n.-tuple {RV P >-> bool}) t : - let mmtX : 'I_n -> {RV P >-> R} := fun i => expR \o t \o* (btr P (tnth X i)) in - independent_RVs (P := P) [set: 'I_n] (fun i => tnth X i) -> independent_RVs (P := P) [set: 'I_n] mmtX. -Proof. -rewrite /= => PnX. -apply: independent_RVs_comp => //. -apply: independent_RVs_scale => //=. -exact: independent_RVs_btr. -Qed. - -Lemma boundedM U (f g : U -> R) (A : set U) : - [bounded f x | x in A] -> - [bounded g x | x in A] -> - [bounded (f x * g x)%R | x in A]. -Proof. -move=> bF bG. -rewrite/bounded_near. -case: bF => M1 [M1real M1f]. -case: bG => M2 [M2real M2g]. -near=> M. -rewrite/globally/= => x xA. -rewrite normrM. -rewrite (@le_trans _ _ (`|M1 + 1| * `|M2 + 1|)%R)//. -rewrite ler_pM//. - by rewrite M1f// (lt_le_trans _ (ler_norm _))// ltrDl. -by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. -Unshelve. all: by end_near. -Qed. - - -Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) M : - (forall i t, (0 <= tnth X i t <= M)%R) -> - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. -Proof. -elim: n X => [X|n IH X] /= boundedX intX. - rewrite /tuple_prod. - under eq_fun do rewrite big_ord0. - by rewrite big_ord0 expectation_cst. -rewrite big_ord_recl/=. -rewrite unlock /expectation integral_mpro /pro2; last first. - apply: (bounded_RV_integrable (M^+n.+1)%R) => // t. - rewrite /tuple_prod. - apply/andP. split. - rewrite prodr_ge0//= => i _. - by have /andP[] := boundedX i (tnth t i). - rewrite -[in leRHS](subn0 n.+1) -prodr_const_nat. - by rewrite big_mkord ler_prod. -rewrite /tuple_prod/=. -under eq_fun => x do (rewrite big_ord_recl/= tnth0; under eq_bigr => i do rewrite tnthS). -rewrite -fubini1' /fubini_F/=; last first. - apply: measurable_bounded_integrable => //=. - - rewrite /product_measure1/=. - apply: (@le_lt_trans _ _ 1); last exact: ltry. - rewrite -(mule1 1) -{2}(@probability_setT _ _ _ P) -(integral_cst P _ 1)//. - apply: ge0_le_integral => //=. - exact: measurable_fun_xsection. - by move=> x _; apply: probability_le1; exact: measurable_xsection. - - apply: measurable_funM => //=. - exact: measurableT_comp. - apply: measurable_prod => //=i ?. - apply: measurableT_comp => //=. - apply: (@measurableT_comp _ _ _ _ _ _ (fun x : mtuple n T => @tnth n T x i) _ snd) => //=. - exact: measurable_tnth. - apply: boundedM. - apply/ex_bound. exact: (@globally_properfilter _ _ point). (* TODO: need to automate globally_properfilter *) - exists M; rewrite /globally/= => x _. - have /andP[? ?] := boundedX ord0 x.1. - by rewrite ger0_norm. - apply/ex_bound; first exact: (@globally_properfilter _ _ point). - exists (M^+n)%R. rewrite /globally/= => x _. - rewrite normr_prod -[in leRHS](subn0 n) -prodr_const_nat. - rewrite big_mkord ler_prod => //=i _. - have /andP[? ?] := boundedX (lift ord0 i) (tnth x.2 i). - by rewrite normr_ge0/= ger0_norm. -have ? : (mpro P (n:=n)).-integrable [set: mtuple n T] - (fun x : mtuple n T => (\prod_(i < n) tnth X (lift ord0 i) (tnth x i))%:E). - apply: (bounded_RV_integrable (M^+n)%R) => //=. - apply: measurable_prod => /=i _. - apply: measurableT_comp => //. - exact: measurable_tnth. - move=> t. apply/andP. split. - by rewrite prodr_ge0//= => i _; have /andP[] := boundedX (lift ord0 i) (tnth t i). - by rewrite -[in leRHS](subn0 n) -prodr_const_nat big_mkord ler_prod. -under eq_fun => x. - under eq_fun => y do rewrite/= EFinM. - rewrite integralZl//= -[X in _*X]fineK ?integral_fune_fin_num//=. - over. -rewrite integralZr//; last by rewrite intX// (tuple_eta X) tnth0 mem_head. -congr (_ * _). -rewrite fineK ?integral_fune_fin_num//=. -under eq_fun => x. - under eq_bigr => i _. - rewrite [X in tnth X]tuple_eta tnthS. - over. - over. -simpl. -rewrite [LHS](_ : _ = 'E_(\X_n P)[ tuple_prod (behead_tuple X) ]); last first. - by rewrite [in RHS]unlock /expectation [in RHS]/tuple_prod. -rewrite IH; last 2 first. -- by move=> i t; rewrite tnth_behead. -- by move=> Xi XiX; apply: intX; rewrite mem_behead. -apply: eq_bigr => /=i _. -rewrite unlock /expectation. -apply: eq_integral => x _. -congr EFin. -by rewrite [in RHS](tuple_eta X) tnthS. -Qed. - -Section fset. -Local Open Scope fset_scope. -Lemma fset_bool : forall B : {fset bool}, - [\/ B == [fset true], B == [fset false], B == fset0 | B == [fset true; false]]. -Proof. -move=> B. -have:= set_bool [set` B]. -rewrite -!set_fset1 -set_fset0. -rewrite (_ : [set: bool] = [set` [fset true; false]]); last first. - by apply/seteqP; split=> -[]; rewrite /= !inE eqxx. -by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; - [apply: Or41|apply: Or42|apply: Or43|apply: Or44]. -Qed. -End fset. - -Section tmp. -Variable n : nat. - -Definition In1 := 'I_n.+1. -HB.instance Definition _ := Choice.on In1. -HB.instance Definition _ := isPointed.Build In1 ord0. - -Variable X : n.+1.-tuple {RV P >-> R}. - -Lemma expectation_prod_independent_RVs : - independent_RVs (P := P) [set: 'I_n.+1] (tnth X) -> - independent_RVs2 (P := P) (thead X) (\prod_(i < n) (tnth (behead_tuple X) i))%R. -Proof. -rewrite /independent_RVs2. -rewrite /independent_RVs. -move=> H. -pose I_ (b : bool) : set 'I_n.+1 := if b then setT `\ ord0 else [set ord0]. -have H1 : trivIset [set` [fset false; true]%fset] I_. - admit. -have H2 : (forall k : bool, k \in [fset false; true]%fset -> I_ k `<=` [set: 'I_n.+1]). - admit. -evar (h : 'I_n.+1 -> set_system T). -rewrite /=. -have := @mutual_independence_bigcup R _ T P bool In1 [fset false; true]%fset I_ [set: 'I_n.+1] - h H1 H2 H. -rewrite (_ : [set` [fset false; true]%fset] = setT); last admit. -rewrite /=. -suff: (fun k : bool => \bigcup_(i in I_ k) h i) = - (fun i : Datatypes_bool__canonical__choice_Choice => - g_sigma_algebra_preimage - (if i then (\prod_(i0 < n) tnth (behead_tuple X) i0)%R else thead X)). - by move=> ->. -rewrite /=. -apply/funext => -[|]. - rewrite /I_. - rewrite /g_sigma_algebra_preimage. - rewrite /preimage_set_system. - apply/seteqP; split. - move=> A [i/= [_ /eqP i0]] hiA. - rewrite /h in hiA. - case: hiA => Y mY. - rewrite setTI => <-. - set x := [set r | exists t, A t /\ r = (\prod_(i < n) tnth (behead_tuple X) i t)%R]. - exists x. - admit. - rewrite setTI. - apply/seteqP; split => [z|z]. - rewrite /= => -[t [At]]. - admit. -(* -elim: n X => [|n ih X]. - admit. -move=> H. -split. - admit. -move=> /= J _ A JA. -have [| | |/eqP JE]:= fset_bool J. - admit. - admit. - admit. -set X' := behead_tuple X. -have @X'' : n.+1.-tuple {RV P >-> R}. - admit. -have X''E : forall (i : 'I_n.+1) t, - (tnth X'' i) t = if i == ord_max then ((tnth X' i t) * (thead X') t)%R else (tnth X' i) t. - admit. -have ih' : independent_RVs P [set: 'I_n.+1] (tnth X''). -(* have H1 : independent_RVs P ([set: 'I_n.+2] `\ ord0) (tnth X). - by apply: independent_RVsD1_ord => //.*) - split => /=. - admit. - move=> K _ E KE. - case: H => /= H1 H2. - pose K' : {fset 'I_n.+2} := ((fun x : 'I_n.+1 => lift ord0 x) @` K)%fset. - pose E' (i : 'I_n.+2) := if i == inord ((@ord_max n.+1)) then setT else E (inord i.-1). - have K'E' : (forall i : 'I_n.+2, i \in K' -> E' i \in g_sigma_algebra_preimage (tnth X i)). - move=> _ /imfsetP[/= j jK ->]. - rewrite /E' /=. - case: ifPn => [_|j0]. - rewrite inE. - exists setT => //. - by rewrite preimage_setT setTI. - rewrite inE. - have := KE _ jK. - rewrite inE => -[Y mY YEj]. - exists Y => //. - rewrite setTI. - rewrite setTI in YEj. - have : forall t, tnth X'' j t = tnth X (lift ord0 j) t. - move=> r. - rewrite X''E. - rewrite ifF; last first. - apply/negbTE. - apply: contra j0 => /eqP jE. - rewrite jE. - apply/eqP/val_inj => /=. - by rewrite /bump/= inordK//. - rewrite tnth_behead/=. - congr (tnth X _ r). - apply/val_inj => /=. - rewrite inordK; last first. - by rewrite ltnS. - by rewrite /bump/= add1n. - move/funext. - move=> <-. - rewrite YEj. - congr E. - apply/val_inj => /=. - by rewrite inordK. - have {}H2 := H2 K' (@subsetT _ _) E' K'E'. - - admit. -have {}ih := ih X'' ih'. -case: ih => /= ih1 ih2. - -case: H => /= H1 H2. -have : (g_sigma_algebra_preimage (thead X)) (A false). - admit. -case=> Y1 mY1. -rewrite setTI => AfalseE. -have : (g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth (behead_tuple X) i0)%R) (A true). - admit. -case=> /= Y2 mY2. -rewrite setTI => AtrueE. - -apply ih2 => //. -case => _. - rewrite inE. - exists Y2 => //=. - rewrite setTI. - rewrite big_ord_recl /= in AtrueE. - rewrite -AtrueE. - congr (_ @^-1` Y2). - apply/funext => t. - rewrite /= fctE. - destruct n. - admit. - rewrite [in LHS]big_ord_recr/=. - rewrite [in RHS]big_ord_recr/=. - rewrite mulrCA; congr *%R. - admit. - rewrite tnth_behead. - rewrite [in LHS]X''E/= ifT//; last first. - apply/eqP. - apply: val_inj => /=. - by rewrite inordK. - rewrite /X' mulrC. - rewrite !tnth_behead. - congr *%R. - rewrite /thead. - by rewrite tnth_behead//. - congr (tnth X _ t). - apply/val_inj => /=. - by rewrite !inordK//. -rewrite inE. -exists Y1 => //. -rewrite setTI. -rewrite /thead. -have : forall t, thead X t = tnth X'' ord0 t. - move=> t. - rewrite X''E. - rewrite ifF; last first. - apply/negbTE. - apply/eqP. - move=> /(congr1 val) /=. - admit. - rewrite tnth_behead//. - rewrite /thead. -Abort. -*) -Abort. - -End tmp. - -Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) : - independent_RVs (P := P) [set: 'I_n] (tnth X) -> - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_(\X_n P)[ tuple_prod X ] = \prod_(i < n) 'E_P[ (tnth X i) ]. -Proof. -elim: n X => [X|n IH X] /= iRVX intX. - rewrite /tuple_prod. - under eq_fun do rewrite big_ord0. - by rewrite big_ord0 expectation_cst. -pose X0 := thead X. -have intX0 : P.-integrable [set: T] (EFin \o X0). - by apply: intX; rewrite mem_tnth. -have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). - by move=> XiX; exact: intX. - -pose X1 (x : mtuple n.+1 T) := - (\prod_(i < n) tnth X (lift ord0 i) (tnth x (lift ord0 i)))%R. -have mX1 : measurable_fun setT X1. - apply: measurable_prod => /= i ?. apply: measurableT_comp => //. - exact: measurable_tnth. -pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose Y1 : {mfun mtuple n.+1 T >-> R} := HB.pack X1 build_mX1. -pose X2 (x : mtuple n.+1 T) := (thead X) (thead x). -have mX2 : measurable_fun setT X2. -rewrite /X2 /=. - by apply: measurableT_comp => //; exact: measurable_tnth. -pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y2 : {mfun mtuple n.+1 T >-> R} := HB.pack X2 build_mX2. -rewrite /tuple_prod. -under eq_fun => x /=. rewrite big_ord_recl/=. over. -rewrite [X in 'E__[X]](_ : _ = (Y2 \* Y1)%R)//. -simpl in Y1, Y2. - -rewrite expectation_prod; last 3 first. -- split. - move=> i /= _ A. - case: ifP=> Hi /=. - by case=> B mB <-; exact: (mX1). - by case=> B mB <-; exact: (mX2). - move=> /= J ? E Ei. - case: (fset_bool J)=> /eqP HJ; rewrite -> HJ in * |- *; clear J HJ. - + by rewrite !big_seq_fset1. - + by rewrite !big_seq_fset1. - + rewrite !big_seq_fset0. - suff-> : [set (thead x, [tuple of behead x]) | x in [set: mtuple n.+1 T]] = setT. - by rewrite probability_setT. - apply/seteqP; split=> -[t1 t2] //= _. - exists [tuple of t1 :: t2] => //=. - by rewrite theadE; congr pair; exact/val_inj. - + rewrite !big_fsetU1 ?inE//= !big_seq_fset1. - set E1 := E true. - set E2 := E false. - have EX1 : E1 \in g_sigma_algebra_preimage X1. - by have:= Ei true; rewrite !inE eqxx=> /(_ erefl). - have EX2 : E2 \in g_sigma_algebra_preimage X2. - by have:= Ei false; rewrite !inE eqxx orbT=> /(_ erefl). - clear Ei X0 intX0 intX Y1 Y2 build_mX1 build_mX2. - (* analyze EX2 *) - have:= EX2. - rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. - under [f in image _ f]funext=> /= B do rewrite setTI. - rewrite inE/=. - case=> B2 mB2. - move=> /[dup] EX2' <-. - (* analyze EX1 *) - have:= EX1. - rewrite /g_sigma_algebra_preimage /preimage_set_system /preimage /=. - under [f in image _ f]funext=> /= B. - rewrite setTI. - rewrite (_ : mkset _ = [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth (behead_tuple t) (i : 'I_n.+1.-1)))%R]); last first. - apply/eq_set=> t. - rewrite /X1 [in LHS](tuple_eta t) [in LHS](tuple_eta X). - by under eq_bigr do rewrite !tnthS. - rewrite - (_ : - mkset _ = - image (setT `*` - [set t | B (\prod_(i < n) tnth (behead_tuple X) i (tnth t i))%R]) - (fun t => [tuple of t.1 :: t.2]) ); last first. - apply/seteqP; split=> t; rewrite (tuple_eta t) /=. - have-> : behead_tuple [tuple of thead t :: behead t] = behead_tuple t by exact/val_inj. - by move=> H; exists (thead t, behead_tuple t) => //; split. - case=> -[x0 x] [] _ /= H <-. - by have-> : behead_tuple [tuple of x0 :: x] = x by exact/val_inj. - over. - set X' : n.-tuple _ := behead_tuple X. - rewrite inE /=. - case=> B' mB'. - move<-. - (* simplify LHS *) - set E1'' := mkset _. - have mE1'' : measurable (E1'' : set (mtuple _ _)). - rewrite /E1'' -/(preimage _ _). - set f : mtuple n T -> R := (f in preimage f). - suff: measurable_fun setT f by rewrite -[preimage _ _]setTI; exact. - rewrite /f. - apply: measurable_prod=> /= i _. - apply: (measurable_comp measurableT)=> //=. - exact: measurable_tnth. - (* simplify LHS *) - rewrite [image _ _](_ : _ = (thead X @^-1` B2) `*` E1''); last first. - apply/seteqP; split=> -[x0 x] /=. - case=> x1 [] [] [y0 y] /= [] _ ? <- /[!theadE] ? /eqP /[!xpair_eqE] /andP [] /eqP <- /eqP /= <-. - rewrite [y in E1'' y](_ : _ = y)//. - exact/val_inj. - case=> ? ?. - exists [tuple of x0 :: x]; last by congr pair; apply/val_inj. - split=> //. - by exists (x0, x). - rewrite product_measure2E//=; last first. - by rewrite -[preimage _ _]setTI; exact: measurable_funP. - (* simplify RHS *) - rewrite image_comp [f in image _ f](_ : _ = idfun); last first. - by apply/funext=> -[t0 t] /=; congr pair; exact/val_inj. - rewrite image_id product_measure2E//. - rewrite [X in _ = X * _ * _]probability_setT mul1e /=. - rewrite muleC; congr mule. - rewrite (_ : image _ _ = thead X @^-1` B2 `*` setT); last first. - apply/seteqP; split=> /= -[t0 t] /=. - by case=> x ? /eqP /[!xpair_eqE] /andP [] /eqP <- _. - case=> ? _; exists [tuple of t0 :: t]; rewrite ?theadE//. - by congr pair; exact/val_inj. - rewrite product_measure2E//; last first. - by rewrite -[preimage _ _]setTI; exact: measurable_funP. - by rewrite [X in _ = _ * X]probability_setT mule1. -- admit. -- admit. -rewrite big_ord_recl. -congr (_ * _). - admit. - -under eq_bigr => i _ do rewrite [X in tnth X]tuple_eta tnthS. -rewrite -IH; last 2 first. -- admit. -- admit. -rewrite /Y1/X1/tuple_prod/=. -under eq_fun => x. under eq_bigr => i _. rewrite [X in tnth X]tuple_eta [X in _ (tnth X _)]tuple_eta !tnthS. over. over. -rewrite /=. -rewrite unlock /expectation integral_mpro//. - under eq_fun => x. under eq_bigr => i _. - rewrite (tnth_behead (x.1 :: x.2)) (_ : inord i.+1 = lift ord0 i) ?tnthS; last first. - by apply: val_inj; rewrite /=inordK// ltnS. - over. - over. - simpl. - rewrite -fubini2'/fubini_G/=. - apply: eq_integral => x _/=. - by rewrite integral_cst//= probability_setT mule1. - admit. -admit. -Abort. - -Lemma finite_prod n (F : 'I_n -> \bar R) : - (forall i, 0 <= F i < +oo) -> \prod_(i < n) F i < +oo. -Proof. -move: F; elim: n => n; first by rewrite big_ord0 ltry. -move=> ih F Foo. -rewrite big_ord_recl lte_mul_pinfty//. -- by have /andP[] := Foo ord0. -- rewrite fin_numElt. - have /andP[F0 ->] := Foo ord0. - by rewrite (@lt_le_trans _ _ 0). -by rewrite ih. -Qed. - -Lemma sub_independent_RVs d' [T' : measurableType d'] [I : choiceType] [A B : set I] - [X : I -> {RV P >-> T'}]: - A `<=` B -> independent_RVs (P := P) B X -> independent_RVs (P := P) A X. -Proof. -move=> AB [h1 h2]. split. - by move=> i Ai; apply: h1; exact: AB. -move=> J JA E h3. -by apply: h2 => //; apply: subset_trans; first apply: JA. -Qed. - -Lemma expectation_prod_independent_RVs n (X : n.-tuple {RV P >-> R}) M: - independent_RVs (P := P) [set: 'I_n] (tnth X) -> - (forall i t, (0 <= tnth X i t <= M)%R) -> - (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> - 'E_P[ \prod_(i < n) (tnth X i) ] = \prod_(i < n) 'E_P[ (tnth X i) ]. -Proof. -elim: n X => [X|n ih X]. - by rewrite !big_ord0 expectation_cst. -move=> /=iRVs boundedX intX. - -rewrite [RHS]big_ord_recl/=. -rewrite [X in _ * X](_ : _ = \prod_(i < n) ('E_P [ (tnth (behead_tuple X) i) ])); last first. - by apply: eq_bigr => i _; congr expectation; apply funext => x; rewrite [in LHS](tuple_eta X) tnthS. -rewrite -ih; last 3 first. -- suffices: independent_RVs (P := P) [set` behead_tuple (ord_tuple n.+1)] (fun i => tnth X i). - rewrite /independent_RVs. move=> [/=h1 h2]. split => /=. - move=> i _. - have := h1 (lift ord0 i). rewrite {1}(tuple_eta X) tnthS. apply. - apply/tnthP. exists i. - rewrite tnth_behead/= tnth_ord_tuple. - by apply: ord_inj; rewrite lift0 inordK// ltnS. - move=> J JIn E h3. - have /=J' := ((@widen_ord n n.+1 (leqnSn n)) @` J)%fset. - have J'In1 : [set` J'] `<=` [set: 'I_n.+1] by exact: subsetT. - (* have := h2 J' J'In1. *) - admit. - exact: (@sub_independent_RVs _ _ _ _ [set: 'I_n.+1]). -- by move=> i t; rewrite tnth_behead boundedX. -- by move=> Xi XiX; rewrite intX// mem_behead. - -pose X1 := (fun x : mtuple n.+1 R => \prod_(i < n.+1) tnth x i)%R. -pose X2 := (fun t : T => [the mtuple n.+1 R of [tuple of [seq tnth X i t | i <- ord_tuple n.+1]]])%R. -have mX1 : measurable_fun setT X1. admit. -have mX2 : measurable_fun setT X2. admit. -pose build_mX1 := isMeasurableFun.Build _ _ _ _ _ mX1. -pose build_mX2 := isMeasurableFun.Build _ _ _ _ _ mX2. -pose Y1 : {mfun mtuple n.+1 R >-> R} := HB.pack X1 build_mX1. -pose Y2 : {mfun T >-> mtuple n.+1 R} := HB.pack X2 build_mX2. -rewrite [X in 'E_P[X]](_ : _ = Y1 \o Y2)%R; last first. - apply: funext => t. - rewrite /Y1/Y2/X1/X2/=. - under [RHS]eq_bigr => i _ do rewrite tnth_map tnth_ord_tuple. - admit. - -rewrite unlock/expectation -(@integral_pushforward _ _ _ _ _ _ _ _ setT (EFin \o Y1))//=; last first. -- admit. -- exact: measurableT_comp. -pose X3 := (fun t : T => (tnth X ord0 t,[the mtuple n R of [tuple of [seq tnth (behead_tuple X) i t | i <- ord_tuple n]]]))%R. -have mX3 : measurable_fun setT X3. admit. -pose build_mX3 := isMeasurableFun.Build _ _ _ _ _ mX3. -pose Y3 : {mfun T >-> _} := HB.pack X3 build_mX3. -rewrite /X1. -rewrite [LHS](_ : _ = \int[pushforward P mX3]_y (y.1 * \prod_(i < n) tnth y.2 i)%:E); last first. - under eq_integral => y _. - rewrite big_ord_recl/=. - rewrite [X in (_ * X)%R](_ : _ = \prod_(i < n) tnth (behead_tuple y) i )%R; last first. - by apply eq_bigr => j _; rewrite [in LHS](tuple_eta y) tnthS. - over. - simpl. - admit. -rewrite [in LHS]/pushforward/=. - -(* -case: n X => [X|n X]. - by rewrite !big_ord0 expectation_cst. -elim: n X => [X|n IH X] /= iRVX intX. - admit. -rewrite big_ord_recl [in RHS] big_ord_recl. -rewrite expectation_prod; last 3 first. -- apply: (@independent_generators _ _ _ _ _ _ _ _ (fun i => @RGenOInfty.G R)) => //=. - - move=> i _. admit. - - move=> i _. admit. - - admit. - split => /=. - case => _//= A/= []B nB <-. - have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. - apply => //. admit. - have : measurable_fun setT (tnth X ord0) by []. - apply => //. admit. - move=> J _ E JE. - have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. - rewrite setT_bool. - rewrite bigcap_setU1 bigcap_set1. - rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. - case: iRVX => /=H1 H2. - pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else - if i == lift ord0 ord0 then E true - else setT. - pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. - (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) - (* case. case. *) - (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) - (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) - (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) - (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) - (* admit. *) - (* (* have := H2 _ _ _ K1. *) *) - have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). - apply: H2 => //. - case. case. - - move=> i _. rewrite /E'/=. have := JE false. admit. - - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. - by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. -- split => /=. - case => _//= A/= []B nB <-. - have : measurable_fun setT (\prod_(i < n.+1) tnth X (lift ord0 i))%R by []. - exact. - have : measurable_fun setT (tnth X ord0) by []. - exact. - move=> J _ E JE. - - - have [|||] := set_bool [set` J]; move=> /eqP h; rewrite -bigcap_fset -[in RHS](set_fsetK J) !h. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set1 fset_set1 big_seq_fset1. - - by rewrite bigcap_set0 probability_setT fset_set0 big_seq_fset0. - rewrite setT_bool. - rewrite bigcap_setU1 bigcap_set1. - rewrite fset_setU// !fset_set1 big_fsetU1 ?inE//= big_seq_fset1. - case: iRVX => /=H1 H2. - pose E' := fun i : 'I_n.+2 => if i == ord0 then E false else - if i == lift ord0 ord0 then E true - else setT. - pose J' : {fset 'I_n.+2} := [fset ord0; lift ord0 ord0]%fset. - (* have K1 : (forall i : 'I_n.+2, i \in J' -> E' i \in g_sigma_algebra_preimage (tnth X i)). *) - (* case. case. *) - (* - move=> i _. rewrite /E'/=. have := JE false. admit. *) - (* - case. move=> i iJ'. rewrite /E'/=. (* have := JE true. *) *) - (* have : E true \in g_sigma_algebra_preimage (\prod_(i0 < n.+1) tnth X (lift ord0 i0))%R. admit. *) - (* rewrite !inE. case=> B mB h1. red. red. simpl. exists B => //. rewrite /=. *) - (* admit. *) - (* (* have := H2 _ _ _ K1. *) *) - have : P (\big[setI/[set: T]]_(j <- J') E' j) = \prod_(j <- J') P (E' j). - apply: H2 => //. - case. case. - - move=> i _. rewrite /E'/=. have := JE false. admit. - - case. move=> i iJ'. rewrite /E'/= inE/=. red. red. simpl. - by rewrite /J' !big_fsetU1 ?inE//= !big_seq_fset1 /E'/= setIC muleC. -- by rewrite intX// mem_tnth. -- rewrite (_ : (\prod_(i < n) tnth X (lift ord0 i))%R = (\prod_(i < n) tnth (behead_tuple X) i)%R); last first. - by apply: eq_bigr => i _; rewrite [in LHS](tuple_eta X) tnthS. - apply: integrable_prod => i. - by rewrite intX// tnth_behead mem_tnth. -rewrite (_ : \prod_(i < n) tnth X (lift ord0 i) = \prod_(i < n) tnth (behead X) i)%R; last first. - apply: eq_bigr => /=i _. rewrite tnth_behead (_ : inord i.+1 = lift ord0 i)//=. - by apply: val_inj; rewrite /=inordK// ltnS. -rewrite IH//=. -- congr (_ * _). - apply: eq_bigr=> i _. - congr expectation. - by rewrite [in RHS](tuple_eta X) tnthS. -- admit. -- by move=> Xi XiX; rewrite intX// mem_behead.*) -Abort. - -End properties_of_independence. - -Section bernoulli. - -Local Open Scope ereal_scope. -Let R := Rdefinitions.R. -Context d (T : measurableType d) (P : probability T R). -Variable p : R. -Hypothesis p01 : (0 <= p <= 1)%R. - -Definition bernoulli_RV (X : {RV P >-> bool}) := - distribution P X = bernoulli p. - -Lemma bernoulli_RV1 (X : {RV P >-> bool}) : bernoulli_RV X -> - P [set i | X i == 1%R] = p%:E. -Proof. -move=> /(congr1 (fun f => f [set 1%:R])). -rewrite bernoulliE//. -rewrite /mscale/=. -rewrite diracE/= mem_set// mule1// diracE/= memNset//. -rewrite mule0 adde0. -rewrite /distribution /= => <-. -congr (P _). -rewrite /preimage/=. -by apply/seteqP; split => [x /eqP H//|x /eqP]. -Qed. - -Lemma bernoulli_RV2 (X : {RV P >-> bool}) : bernoulli_RV X -> - P [set i | X i == 0%R] = (`1-p)%:E. -Proof. -move=> /(congr1 (fun f => f [set 0%:R])). -rewrite bernoulliE//. -rewrite /mscale/=. -rewrite diracE/= memNset//. -rewrite mule0// diracE/= mem_set// add0e mule1. -rewrite /distribution /= => <-. -congr (P _). -rewrite /preimage/=. -by apply/seteqP; split => [x /eqP H//|x /eqP]. -Qed. - -Lemma bernoulli_expectation (X : {RV P >-> bool}) : - bernoulli_RV X -> 'E_P[btr P X] = p%:E. -Proof. -move=> bX. -rewrite unlock /btr. -rewrite -(@ge0_integral_distribution _ _ _ _ _ _ X (EFin \o [eta GRing.natmul 1]))//; last first. - by move=> y //=. -rewrite /bernoulli/=. -rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. - by move=> A mA _/=; rewrite (_ : distribution P X = bernoulli p). -rewrite integral_bernoulli//=. -by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. -Qed. - -Lemma integrable_bernoulli (X : {RV P >-> bool}) : - bernoulli_RV X -> P.-integrable [set: T] (EFin \o btr P X). -Proof. -move=> bX. -apply/integrableP; split. - by apply: measurableT_comp => //; exact: measurable_bool_to_real. -have -> : \int[P]_x `|(EFin \o btr P X) x| = 'E_P[btr P X]. - rewrite unlock /expectation. - apply: eq_integral => x _. - by rewrite gee0_abs //= lee_fin. -by rewrite bernoulli_expectation// ltry. -Qed. - -Lemma bool_RV_sqr (X : {dRV P >-> bool}) : - ((btr P X ^+ 2) = btr P X :> (T -> R))%R. -Proof. -apply: funext => x /=. -rewrite /GRing.exp /btr/bool_to_real /GRing.mul/=. -by case: (X x) => /=; rewrite ?mulr1 ?mulr0. -Qed. - -Lemma bernoulli_variance (X : {dRV P >-> bool}) : - bernoulli_RV X -> 'V_P[btr P X] = (p * (`1-p))%:E. -Proof. -move=> b. -rewrite (@varianceE _ _ _ _ (btr P X)); - [|rewrite ?[X in _ \o X]bool_RV_sqr; exact: integrable_bernoulli..]. -rewrite [X in 'E_P[X]]bool_RV_sqr !bernoulli_expectation//. -by rewrite expe2 -EFinD onemMr. -Qed. - -(* TODO: define a mixin *) -Definition is_bernoulli_trial n (X : n.-tuple {RV P >-> bool}) := - (forall i : 'I_n, bernoulli_RV (tnth X i)). - -Definition bernoulli_trial n (X : n.-tuple {RV P >-> bool}) : {RV (\X_n P) >-> R : realType} := - tuple_sum [the n.-tuple _ of (map (btr P) - (map (fun t : {RV P >-> bool} => t : {mfun T >-> bool}) X))]. - -(* -was wrong -Definition bernoulli_trial n (X : {dRV P >-> bool}^nat) : {RV (pro n P) >-> R} := - (\sum_(i-> bool}) : - is_bernoulli_trial X -> 'E_(\X_n P)[bernoulli_trial X] = (n%:R * p)%:E. -Proof. -move=> bRV. rewrite /bernoulli_trial. -transitivity ('E_(\X_n P)[tuple_sum (map (btr P) X)]). - congr expectation; apply/funext => t. - by apply: eq_bigr => /= i _; rewrite !tnth_map. -rewrite (@expectation_sum_pro _ _ _ _ _ _ 1%R); last first. - move=> i t. - rewrite tnth_map//. - rewrite /btr/= /bool_to_real/=. - by case: (tnth X i t) => /=; rewrite !lexx !ler01. -transitivity (\sum_(i < n) p%:E). - apply: eq_bigr => k _. - rewrite tnth_map bernoulli_expectation//. -by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. -Qed. - -Lemma bernoulli_trial_ge0 n (X : n.-tuple {RV P >-> bool}) : is_bernoulli_trial X -> - (forall t, 0 <= bernoulli_trial X t)%R. -Proof. -move=> bRV t. -rewrite /bernoulli_trial. -apply/sumr_ge0 => /= i _. -by rewrite !tnth_map. -Qed. - -Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : - is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ in - 'M_X t = \prod_(i < n) 'M_(btr P (tnth X_ i)) t. -Proof. -move=> bRVX/=. -pose mmtX : 'I_n -> {RV P >-> R : realType} := fun i => expR \o t \o* btr P (tnth X_ i). -transitivity ('E_(\X_n P)[ tuple_prod (mktuple mmtX) ])%R. - congr expectation => /=; apply: funext => x/=. - rewrite /tuple_sum big_distrl/= expR_sum; apply: eq_bigr => i _. - by rewrite !tnth_map /mmtX/= tnth_ord_tuple. -rewrite /mmtX. -rewrite (@expectation_prod_nondep _ _ _ _ _ _ (expR (`|t|))%R); last 2 first. -- move=> i ?. - apply/andP. split. - by rewrite tnth_mktuple/= expR_ge0. - rewrite tnth_mktuple/=/bool_to_real/=. - rewrite ler_expR -[leRHS]mul1r. - have [t0|t0] := leP 0%R t. - by rewrite ger0_norm// ler_pM//; case: (tnth X_ i _). - rewrite (@le_trans _ _ 0%R)//. - by rewrite mulr_ge0_le0// ltW. -- move=> _ /mapP[/= i _ ->]. - apply: (bounded_RV_integrable (expR `|t|)) => // t0. - rewrite expR_ge0/= ler_expR/=. - rewrite /bool_to_real/=. - case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. - by rewrite ler_norm. - (* rewrite [X in independent_RVs _ _ X](_ : _ = mmtX)//. *) - (* apply: funext => i. *) - (* by rewrite /mmtX/= tnth_map tnth_ord_tuple. *) -apply: eq_bigr => /= i _. -congr expectation. -rewrite /=. -by rewrite tnth_map/= tnth_ord_tuple. -Qed. - -Arguments sub_countable [T U]. -Arguments card_le_finite [T U]. - -Lemma bernoulli_mmt_gen_fun (X : {RV P >-> bool}) (t : R) : - bernoulli_RV X -> 'M_(btr P X : {RV P >-> R : realType}) t = (p * expR t + (1-p))%:E. -Proof. -move=> bX. rewrite/mmt_gen_fun. -pose mmtX : {RV P >-> R : realType} := expR \o t \o* (btr P X). -set A := X @^-1` [set true]. -set B := X @^-1` [set false]. -have mA: measurable A by exact: measurable_sfunP. -have mB: measurable B by exact: measurable_sfunP. -have dAB: [disjoint A & B] - by rewrite /disj_set /A /B preimage_true preimage_false setICr. -have TAB: setT = A `|` B by rewrite -preimage_setU -setT_bool preimage_setT. -rewrite unlock. -rewrite TAB integral_setU_EFin -?TAB//. -under eq_integral. - move=> x /=. - rewrite /A inE /bool_to_real /= => ->. - rewrite mul1r. - over. -rewrite integral_cst//. -under eq_integral. - move=> x /=. - rewrite /B inE /bool_to_real /= => ->. - rewrite mul0r. - over. -rewrite integral_cst//. -rewrite /A /B /preimage /=. -under eq_set do rewrite (propext (rwP eqP)). -rewrite (bernoulli_RV1 bX). -under eq_set do rewrite (propext (rwP eqP)). -rewrite (bernoulli_RV2 bX). -rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. -by rewrite expR0 mulr1. -Qed. - -(* wrong lemma *) -Lemma binomial_mmt_gen_fun n (X_ : n.-tuple {RV P >-> bool}) (t : R) : - is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in - 'M_X t = ((p * expR t + (1 - p))`^(n%:R))%:E. -Proof. -move: p01 => /andP[p0 p1] bX/=. -rewrite bernoulli_trial_mmt_gen_fun//. -under eq_bigr => i _ do rewrite bernoulli_mmt_gen_fun//. -rewrite big_const iter_mule mule1 cardT size_enum_ord -EFin_expe powR_mulrn//. -by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. -Qed. - -Lemma mmt_gen_fun_expectation n (X_ : n.-tuple {RV P >-> bool}) (t : R) : - (0 <= t)%R -> - is_bernoulli_trial X_ -> - let X := bernoulli_trial X_ : {RV \X_n P >-> R : realType} in - 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. -Proof. -move=> t_ge0 bX/=. -have /andP[p0 p1] := p01. -rewrite binomial_mmt_gen_fun// lee_fin. -rewrite expectation_bernoulli_trial//. -rewrite addrCA -{2}(mulr1 p) -mulrN -mulrDr. -rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. - by rewrite addr_ge0// mulr_ge0// subr_ge0 -expR0 ler_expR. -exact: expR_ge1Dx. -Qed. - -Lemma end_thm24 n (X_ : n.-tuple {RV P >-> bool}) (t delta : R) : - is_bernoulli_trial X_ -> - (0 < delta)%R -> - let X := @bernoulli_trial n X_ in - let mu := 'E_(\X_n P)[X] in - let t := ln (1 + delta) in - (expR (expR t - 1) `^ fine mu)%:E * - (expR (- t * (1 + delta)) `^ fine mu)%:E <= - ((expR delta / (1 + delta) `^ (1 + delta)) `^ fine mu)%:E. -Proof. -move=> bX d0 /=. -rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. -- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). -- by rewrite mulr_ge0// expR_ge0. -- by rewrite divr_ge0 ?expR_ge0// powR_ge0. -- rewrite lnK ?posrE ?addr_gt0// addrAC subrr add0r ler_wpM2l ?expR_ge0//. - by rewrite -powRN mulNr -mulrN expRM lnK// posrE addr_gt0. -Qed. - -(* theorem 2.4 Rajani / thm 4.4.(2) mu-book *) -Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X_ -> - (0 < delta)%R -> - let X := @bernoulli_trial n X_ in - let mu := 'E_(\X_n P)[X] in - (\X_n P) [set i | X i >= (1 + delta) * fine mu]%R <= - ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. -Proof. -rewrite /= => bX delta0. -set X := @bernoulli_trial n X_. -set mu := 'E_(\X_n P)[X]. -set t := ln (1 + delta). -have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. -apply: (le_trans (chernoff _ _ t0)). -apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * - (expR (- (t * ((1 + delta) * fine mu))))%:E)). - rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - by apply: (mmt_gen_fun_expectation _ bX); rewrite ltW. -rewrite mulrC expRM -mulNr mulrA expRM. -exact: (end_thm24 _ bX). -Qed. - -(* theorem 2.5 *) -Theorem bernoulli_trial_inequality2 n (X : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X -> - let X' := @bernoulli_trial n X in - let mu := 'E_(\X_n P)[X'] in - (0 < n)%nat -> - (0 < delta < 1)%R -> - (\X_n P) [set i | X' i >= (1 + delta) * fine mu]%R <= - (expR (- (fine mu * delta ^+ 2) / 3))%:E. -Proof. -move=> bX X' mu n0 /[dup] delta01 /andP[delta0 _]. -apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). - rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. - apply: (bernoulli_trial_inequality1 bX) => //. -apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). - rewrite lee_fin ler_expR ler_wpM2r//. - by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: (bernoulli_trial_ge0 bX). - rewrite lerB//. - apply: taylor_ln_le. - by rewrite in_itv /=. -rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. -by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. -Qed. - -(* TODO: move (to exp.v?) *) -Lemma norm_expR : normr \o expR = (expR : R -> R). -Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. - -(* Rajani thm 2.6 / mu-book thm 4.5.(2) *) -Theorem bernoulli_trial_inequality3 n (X : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X -> (0 < delta < 1)%R -> - let X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType} in - let mu := 'E_(\X_n P)[X'] in - (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. -Proof. -move=> bX /andP[delta0 delta1] /=. -set X' := @bernoulli_trial n X : {RV \X_n P >-> R : realType}. -set mu := 'E_(\X_n P)[X']. -have /andP[p0 p1] := p01. -apply: (@le_trans _ _ (((expR (- delta) / ((1 - delta) `^ (1 - delta))) `^ (fine mu))%:E)). - (* using Markov's inequality somewhere, see mu's book page 66 *) - have H1 t : (t < 0)%R -> - (\X_n P) [set i | (X' i <= (1 - delta) * fine mu)%R] = (\X_n P) [set i | `|(expR \o t \o* X') i|%:E >= (expR (t * (1 - delta) * fine mu))%:E]. - move=> t0; apply: congr1; apply: eq_set => x /=. - rewrite lee_fin ger0_norm ?expR_ge0// ler_expR (mulrC _ t) -mulrA. - by rewrite -[in RHS]ler_ndivrMl// mulrA mulVf ?lt_eqF// mul1r. - set t := ln (1 - delta). - have ln1delta : (t < 0)%R. - (* TODO: lacking a lemma here *) - rewrite -oppr0 ltrNr -lnV ?posrE ?subr_gt0// ln_gt0//. - by rewrite invf_gt1// ?subr_gt0// ltrBlDr ltrDl. - have {H1}-> := H1 _ ln1delta. - apply: (@le_trans _ _ (((fine 'E_(\X_n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). - rewrite EFinM lee_pdivlMr ?expR_gt0// muleC fineK. - apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X' : {RV (\X_n P) >-> R : realType}) id (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. - - by apply: expR_gt0. - - rewrite norm_expR. - have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. - by rewrite (binomial_mmt_gen_fun _ bX)//. - apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). - rewrite norm_expR lee_fin ler_wpM2r ?invr_ge0 ?expR_ge0//. - have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_X' t by []. - rewrite (binomial_mmt_gen_fun _ bX)/=. - rewrite /mu /X' (expectation_bernoulli_trial bX)/=. - rewrite !lnK ?posrE ?subr_gt0//. - rewrite expRM powRrM powRAC. - rewrite ge0_ler_powR ?ler0n// ?nnegrE ?powR_ge0//. - by rewrite addr_ge0 ?mulr_ge0// subr_ge0// ltW. - rewrite addrAC subrr sub0r -expRM. - rewrite addrCA -{2}(mulr1 p) -mulrBr addrAC subrr sub0r mulrC mulNr. - by apply: expR_ge1Dx. - rewrite !lnK ?posrE ?subr_gt0//. - rewrite -addrAC subrr sub0r -mulrA [X in (_ / X)%R]expRM lnK ?posrE ?subr_gt0//. - rewrite -[in leRHS]powR_inv1 ?powR_ge0// powRM// ?expR_ge0 ?invr_ge0 ?powR_ge0//. - by rewrite powRAC powR_inv1 ?powR_ge0// powRrM expRM. -rewrite lee_fin. -rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. -- by rewrite fine_ge0// expectation_ge0// => x; exact: (bernoulli_trial_ge0 bX). -- by rewrite divr_ge0 ?expR_ge0// powR_ge0. -- by rewrite expR_ge0. -- rewrite -ler_ln ?posrE ?divr_gt0 ?expR_gt0 ?powR_gt0 ?subr_gt0//. - rewrite expRK// ln_div ?posrE ?expR_gt0 ?powR_gt0 ?subr_gt0//. - rewrite expRK//. - rewrite /powR (*TODO: lemma ln of powR*) gt_eqF ?subr_gt0// expRK. - (* requires analytical argument: see p.66 of mu's book *) - Local Open Scope ring_scope. - rewrite -(@ler_pM2r _ 2)// -mulrA mulVf// mulr1 mulrDl. - rewrite -subr_le0 mulNr opprK. - rewrite addrC !addrA. - have->: delta ^+ 2 - delta * 2 = (1 - delta)^+2 - 1. - rewrite sqrrB expr1n mul1r [RHS]addrC !addrA addNr add0r addrC -mulNrn. - by rewrite -(mulr_natr (- delta) 2) mulNr. - rewrite addrAC subr_le0. - set f := fun (x : R) => x ^+ 2 + - (x * ln x) * 2. - have @idf (x : R^o) : 0 < x -> {df | is_derive x 1 (f : R^o -> R^o) df}. - move=> x0; evar (df : (R : Type)); exists df. - apply: is_deriveD; first by []. - apply: is_deriveM; last by []. - apply: is_deriveN. - apply: is_deriveM; first by []. - exact: is_derive1_ln. - suff: forall x : R, x \in `]0, 1[ -> f x <= 1. - by apply; rewrite memB_itv0 in_itv /= delta0 delta1. - move=> x x01. - have->: 1 = f 1 by rewrite /f expr1n ln1 mulr0 oppr0 mul0r addr0. - apply: (@ger0_derive1_homo _ f 0 1 false false)=> //. - - move=> t /[!in_itv] /= /andP [] + _. - by case/idf=> ? /@ex_derive. - - move=> t /[!in_itv] /= /andP [] t0 t1. - Local Arguments derive_val {R V W a v f df}. - rewrite (derive_val (svalP (idf _ t0))) /=. - clear idf. - rewrite exp_derive derive_cst derive_id . - rewrite scaler0 add0r /GRing.scale /= !mulr1 expr1. - rewrite -mulrDr mulr_ge0// divff ?lt0r_neq0//. - rewrite opprD addrA subr_ge0 -ler_expR. - have:= t0; rewrite -lnK_eq => /eqP ->. - by rewrite -[leLHS]addr0 -(subrr 1) addrCA expR_ge1Dx. - - apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _. - by case/idf=> ? /@ex_derive. - - by apply: (subset_itvW_bound _ _ x01); rewrite bnd_simp. - - by rewrite in_itv /= ltr01 lexx. - - by move: x01; rewrite in_itv=> /= /andP [] _ /ltW. -Qed. -Local Open Scope ereal_scope. - -(* Rajani -> corollary 2.7 / mu-book -> corollary 4.7 *) -Corollary bernoulli_trial_inequality4 n (X : n.-tuple {RV P >-> bool}) (delta : R) : - is_bernoulli_trial X -> (0 < delta < 1)%R -> - (0 < n)%nat -> - (0 < p)%R -> - let X' := @bernoulli_trial n X in - let mu := 'E_(\X_n P)[X'] in - (\X_n P) [set i | `|X' i - fine mu | >= delta * fine mu]%R <= - (expR (- (fine mu * delta ^+ 2) / 3)%R *+ 2)%:E. -Proof. -move=> bX /andP[d0 d1] n0 p0 /=. -set X' := @bernoulli_trial n X. -set mu := 'E_(\X_n P)[X']. -under eq_set => x. - rewrite ler_normr. - rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. - rewrite -lerBDr -(lerN2 (- _)%R) opprK opprB. - rewrite -{2}(mul1r (fine mu)) -mulrBl. - rewrite -!lee_fin. - over. -rewrite /=. -rewrite set_orb. -rewrite measureU; last 3 first. -- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. - apply: emeasurable_fun_le => //. - apply: measurableT_comp => //. -- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. - apply: emeasurable_fun_le => //. - apply: measurableT_comp => //. -- rewrite disjoints_subset => x /=. - rewrite /mem /in_mem/= => X0; apply/negP. - rewrite -ltNge. - apply: (@lt_le_trans _ _ _ _ _ _ X0). - rewrite !EFinM. - rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. - by rewrite fineK /mu/X' (expectation_bernoulli_trial bX)// lte_fin mulr_gt0 ?ltr0n. -rewrite mulr2n EFinD leeD//=. -- by apply: (bernoulli_trial_inequality2 bX); rewrite //d0 d1. -- have d01 : (0 < delta < 1)%R by rewrite d0. - apply: (le_trans (@bernoulli_trial_inequality3 _ X delta bX d01)). - rewrite lee_fin ler_expR !mulNr lerN2. - rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. - rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. - rewrite /mu unlock /expectation integral_ge0// => x _. - by rewrite /X' lee_fin; apply: (bernoulli_trial_ge0 bX). -Qed. - -(* Rajani thm 3.1 / mu-book thm 4.7 *) -Theorem sampling n (X : n.-tuple {RV P >-> bool}) (theta delta : R) : - let X_sum := bernoulli_trial X in - let X' x := (X_sum x) / n%:R in - (0 < p)%R -> - is_bernoulli_trial X -> - (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%nat -> - (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> - (\X_n P) [set i | `| X' i - p | <= theta]%R >= 1 - delta%:E. -Proof. -move=> X_sum X' p0 bX /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. -have E_X_sum: 'E_(\X_n P)[X_sum] = (p * n%:R)%:E. - by rewrite /X_sum expectation_bernoulli_trial// mulrC. -have /andP[_ p1] := p01. -set epsilon := theta / p. -have epsilon01 : (0 < epsilon < 1)%R. - by rewrite /epsilon ?ltr_pdivrMr ?divr_gt0 ?mul1r. -have thetaE : theta = (epsilon * p)%R. - by rewrite /epsilon -mulrA mulVf ?mulr1// gt_eqF. -have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= - ((expR (- (p * n%:R * (epsilon ^+ 2)) / 3)) *+ 2)%:E. - rewrite [X in (\X_n P) X <= _](_ : _ = - [set i | `| X_sum i - p * n%:R | >= epsilon * p * n%:R]%R); last first. - apply/seteqP; split => [t|t]/=. - move/(@ler_wpM2r _ n%:R (ler0n _ _)) => /le_trans; apply. - rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R)// -normrM mulrBl. - by rewrite -mulrA mulVf ?mulr1// gt_eqF ?ltr0n. - move/(@ler_wpM2r _ n%:R^-1); rewrite invr_ge0// ler0n => /(_ erefl). - rewrite -(mulrA _ _ n%:R^-1) divff ?mulr1 ?gt_eqF ?ltr0n//. - move=> /le_trans; apply. - rewrite -[X in (_ * X)%R](@ger0_norm _ n%:R^-1)// -normrM mulrBl. - by rewrite -mulrA divff ?mulr1// gt_eqF// ltr0n. - rewrite -mulrA. - have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. - rewrite -E_X_sum. - exact: (@bernoulli_trial_inequality4 _ X epsilon bX). -have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= - ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. - rewrite thetaE; move/le_trans : step1; apply. - rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. - rewrite -2![in leRHS]mulrA [in leRHS]mulrCA. - rewrite /epsilon -mulrA mulVf ?gt_eqF// mulr1 -!mulrA !ler_wpM2l ?(ltW theta0)//. - rewrite mulrCA ler_wpM2l ?(ltW theta0)//. - rewrite [X in (_ * X)%R]mulrA mulVf ?gt_eqF// -[leLHS]mul1r [in leRHS]mul1r. - by rewrite ler_wpM2r// invf_ge1. -suff : delta%:E >= (\X_n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) theta)%R]. - rewrite [X in (\X_n P) X <= _ -> _](_ : _ = ~` [set i | (`|X' i - p| < theta)%R]); last first. - apply/seteqP; split => [t|t]/=. - by rewrite leNgt => /negP. - by rewrite ltNge => /negP/negPn. - have ? : measurable [set i | (`|X' i - p| < theta)%R]. - under eq_set => x do rewrite -lte_fin. - rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. - by apply: emeasurable_fun_lt => //; apply: measurableT_comp => //; - apply: measurableT_comp => //; apply: measurable_funD => //; - apply: measurable_funM. - rewrite probability_setC// lee_subel_addr//. - rewrite -lee_subel_addl//; last by rewrite fin_num_measure. - move=> /le_trans; apply. - rewrite le_measure ?inE//. - under eq_set => x do rewrite -lee_fin. - rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. - by apply: emeasurable_fun_le => //; apply: measurableT_comp => //; - apply: measurableT_comp => //; apply: measurable_funD => //; - apply: measurable_funM. - by move=> t/= /ltW. -(* NB: last step in the pdf *) -apply: (le_trans step2). -rewrite lee_fin -(mulr_natr _ 2) -ler_pdivlMr//. -rewrite -(@lnK _ (delta / 2)); last by rewrite posrE divr_gt0. -rewrite ler_expR mulNr lerNl -lnV; last by rewrite posrE divr_gt0. -rewrite invf_div ler_pdivlMr// mulrC. -rewrite -ler_pdivrMr; last by rewrite exprn_gt0. -by rewrite mulrAC. -Qed. - -End bernoulli. From 2ea44905cf3c4f428d33fda0e16c98cba1421d11 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 25 Mar 2025 14:31:06 +0900 Subject: [PATCH 67/73] add integral_pushforward --- experimental_reals/discrete.v | 2 +- reals/reals.v | 2 +- theories/sampling.v | 16 ++++++++-------- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 63ca0e73b8..412877a07b 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -4,7 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -From Corelib Require Setoid. +From Coq Require Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. diff --git a/reals/reals.v b/reals/reals.v index 601ad4fe7c..90bb30d878 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -38,7 +38,7 @@ (* *) (******************************************************************************) -From Corelib Require Import Setoid. +From Coq Require Import Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import boolp classical_sets set_interval. diff --git a/theories/sampling.v b/theories/sampling.v index f2f0af77b7..0f268908e3 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1365,7 +1365,7 @@ rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. Qed. (* [theorem 2.4, Rajani] / [thm 4.4.(2), MU] *) -Theorem bernoulli_trial_inequality1 n (X_ : n.-tuple (bernoulliRV P p)) (delta : R) : +Theorem sampling_ineq1 n (X_ : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta)%R -> let X := bool_trial_value X_ in let mu := 'E_(\X_n P)[X] in @@ -1492,7 +1492,7 @@ Qed. End xlnx_bounding. (* [Theorem 2.6, Rajani] / [thm 4.5.(2), MU] *) -Theorem bernoulli_trial_inequality3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : +Theorem sampling_ineq3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> let X' := bool_trial_value X : {RV \X_n P >-> R : realType} in let mu := 'E_(\X_n P)[X'] in @@ -1648,7 +1648,7 @@ Hypothesis p01 : (0 <= p <= 1)%R. Local Open Scope ereal_scope. (* [Theorem 2.5, Rajani] *) -Theorem bernoulli_trial_inequality2 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : +Theorem sampling_ineq2 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : let X' := bool_trial_value X in let mu := 'E_(\X_n P)[X'] in (0 < n)%nat -> @@ -1659,7 +1659,7 @@ Proof. move=> X' mu n0 /[dup] delta01 /andP[delta0 _]. apply: (@le_trans _ _ (expR ((delta - (1 + delta) * ln (1 + delta)) * fine mu))%:E). rewrite expRM expRB (mulrC _ (ln _)) expRM lnK; last rewrite posrE addr_gt0//. - exact: bernoulli_trial_inequality1. + exact: sampling_ineq1. apply: (@le_trans _ _ (expR ((delta - (delta + delta ^+ 2 / 3)) * fine mu))%:E). rewrite lee_fin ler_expR ler_wpM2r//. by rewrite fine_ge0//; apply: expectation_ge0 => t; exact: bernoulli_trial_ge0. @@ -1671,7 +1671,7 @@ by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. (* [Corollary 2.7, Rajani] / [Corollary 4.7, MU] *) -Corollary bernoulli_trial_inequality4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : +Corollary samping_ineq4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> (0 < n)%nat -> (0 < p)%R -> @@ -1709,9 +1709,9 @@ rewrite measureU; last 3 first. rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. by rewrite fineK /mu/X' expectation_bernoulli_trial// lte_fin mulr_gt0 ?ltr0n. rewrite mulr2n EFinD leeD//=. -- by apply: bernoulli_trial_inequality2; rewrite //d0 d1. +- by apply: sampling_ineq2; rewrite //d0 d1. - have d01 : (0 < delta < 1)%R by rewrite d0. - apply: (le_trans (@bernoulli_trial_inequality3 _ _ _ _ p p01 _ X delta d01)). + apply: (le_trans (@sampling_ineq3 _ _ _ _ p p01 _ X delta d01)). rewrite lee_fin ler_expR !mulNr lerN2. rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. @@ -1750,7 +1750,7 @@ have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -(mulrC _ p) -(expectation_bernoulli_trial p01 X). - exact: (@bernoulli_trial_inequality4 _ X epsilon). + exact: (@samling_ineq4 _ X epsilon). have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. From 460b5b66d38d3ba98bd848ebfd1c0589c1772dbb Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Tue, 25 Mar 2025 18:13:24 +0900 Subject: [PATCH 68/73] doc and nix - docs for sampling.v - add overlay - nix actions --- .github/workflows/nix-action-8.20.yml | 98 +----- .../mathcomp-analysis/default.nix | 290 ++++++++++++++++++ experimental_reals/discrete.v | 2 +- reals/reals.v | 2 +- theories/hoelder.v | 21 ++ theories/sampling.v | 196 ++++++++---- 6 files changed, 465 insertions(+), 144 deletions(-) create mode 100644 .nix/coq-overlays/mathcomp-analysis/default.nix diff --git a/.github/workflows/nix-action-8.20.yml b/.github/workflows/nix-action-8.20.yml index d7c23b1bcf..92af470a6a 100644 --- a/.github/workflows/nix-action-8.20.yml +++ b/.github/workflows/nix-action-8.20.yml @@ -52,92 +52,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "coq" - mathcomp: - needs: - - coq - runs-on: ubuntu-latest - steps: - - name: Determine which commit to initially checkout - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{ - github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha - }}\" >> $GITHUB_ENV\nfi\n" - - name: Git checkout - uses: actions/checkout@v4 - with: - fetch-depth: 0 - ref: ${{ env.target_commit }} - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{ - github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{ github.event.repository.html_url - }} refs/pull/${{ github.event.number }}/merge | cut -f1)\n mergeable=$(git - merge --no-commit --no-ff ${{ github.event.pull_request.base.sha }} > /dev/null - 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n if [ -z \"$merge_commit\"\ - \ -o \"x$mergeable\" != \"x0\" ]; then\n echo \"tested_commit=${{ github.event.pull_request.head.sha - }}\" >> $GITHUB_ENV\n else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n\ - \ fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v4 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v30 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v15 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepGetDerivation - name: Getting derivation for current job (mathcomp) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"8.20\" --argstr job \"mathcomp\" \\\n --dry-run 2> err > out || (touch - fail; true)\n" - - name: Error reporting - run: "echo \"out=\"; cat out\necho \"err=\"; cat err\n" - - name: Failure check - run: if [ -e fail ]; then exit 1; else exit 0; fi; - - id: stepCheck - name: Checking presence of CI target for current job - run: (echo -n status=; cat out err | grep "built:" | sed "s/.*/built/") >> $GITHUB_OUTPUT - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: coq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "coq" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-ssreflect' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-ssreflect" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-fingroup' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-fingroup" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-algebra' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-algebra" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-solvable' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-solvable" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-field' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-field" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-character' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-character" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp" mathcomp-analysis: needs: - coq @@ -291,6 +205,10 @@ jobs: name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "stdlib" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: interval' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "interval" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -367,6 +285,10 @@ jobs: name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "stdlib" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: interval' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "interval" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -646,6 +568,10 @@ jobs: name: 'Building/fetching previous CI target: stdlib' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "stdlib" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: interval' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "interval" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr diff --git a/.nix/coq-overlays/mathcomp-analysis/default.nix b/.nix/coq-overlays/mathcomp-analysis/default.nix new file mode 100644 index 0000000000..e2fe0a3f75 --- /dev/null +++ b/.nix/coq-overlays/mathcomp-analysis/default.nix @@ -0,0 +1,290 @@ +{ + lib, + mkCoqDerivation, + mathcomp, + mathcomp-finmap, + mathcomp-bigenough, + hierarchy-builder, + interval, + stdlib, + single ? false, + coqPackages, + coq, + version ? null, +}@args: + +let + repo = "analysis"; + owner = "math-comp"; + + release."1.9.0".sha256 = "sha256-zj7WSDUg8ISWxcipGpjEwvvnLp1g8nm23BZiib/15+g="; + release."1.8.0".sha256 = "sha256-2ZafDmZAwGB7sxdUwNIE3xvwBRw1kFDk0m5Vz+onWZc="; + release."1.7.0".sha256 = "sha256-GgsMIHqLkWsPm2VyOPeZdOulkN00IoBz++qA6yE9raQ="; + release."1.5.0".sha256 = "sha256-EWogrkr5TC5F9HjQJwO3bl4P8mij8U7thUGJNNI+k88="; + release."1.4.0".sha256 = "sha256-eDggeuEU0fMK7D5FbxvLkbAgpLw5lwL/Rl0eLXAnJeg="; + release."1.2.0".sha256 = "sha256-w6BivDM4dF4Iv4rUTy++2feweNtMAJxgGExPfYGhXxo="; + release."1.1.0".sha256 = "sha256-wl4kZf4mh9zbFfGcqaFEgWRyp0Bj511F505mYodpS6o="; + release."1.0.0".sha256 = "sha256-KiXyaWB4zQ3NuXadq4BSWfoN1cIo1xiLVSN6nW03tC4="; + release."0.7.0".sha256 = "sha256-JwkyetXrFsFHqz8KY3QBpHsrkhmEFnrCGuKztcoen60="; + release."0.6.7".sha256 = "sha256-3i2PBMEwihwgwUmnS0cmrZ8s+aLPFVq/vo0aXMUaUyA="; + release."0.6.6".sha256 = "sha256-tWtv6yeB5/vzwpKZINK9OQ0yQsvD8qu9zVSNHvLMX5Y="; + release."0.6.5".sha256 = "sha256-oJk9/Jl1SWra2aFAXRAVfX7ZUaDfajqdDksYaW8dv8E="; + release."0.6.1".sha256 = "sha256-1VyNXu11/pDMuH4DmFYSUF/qZ4Bo+/Zl3Y0JkyrH/r0="; + release."0.6.0".sha256 = "sha256-0msICcIrK6jbOSiBu0gIVU3RHwoEEvB88CMQqW/06rg="; + release."0.5.3".sha256 = "sha256-1NjFsi5TITF8ZWx1NyppRmi8g6YaoUtTdS9bU/sUe5k="; + release."0.5.2".sha256 = "0yx5p9zyl8jv1vg7rgkyq8dqzkdnkqv969mi62whmhkvxbavgzbw"; + release."0.5.1".sha256 = "1hnzqb1gxf88wgj2n1b0f2xm6sxg9j0735zdsv6j12hlvx5lwk68"; + release."0.3.13".sha256 = "sha256-Yaztew79KWRC933kGFOAUIIoqukaZOdNOdw4XszR1Hg="; + release."0.3.10".sha256 = "sha256-FBH2c8QRibq5Ycw/ieB8mZl0fDiPrYdIzZ6W/A3pIhI="; + release."0.3.9".sha256 = "sha256-uUU9diBwUqBrNRLiDc0kz0CGkwTZCUmigPwLbpDOeg4="; + release."0.3.6".sha256 = "0g2j7b2hca4byz62ssgg90bkbc8wwp7xkb2d3225bbvihi92b4c5"; + release."0.3.4".sha256 = "18mgycjgg829dbr7ps77z6lcj03h3dchjbj5iir0pybxby7gd45c"; + release."0.3.3".sha256 = "1m2mxcngj368vbdb8mlr91hsygl430spl7lgyn9qmn3jykack867"; + release."0.3.1".sha256 = "1iad288yvrjv8ahl9v18vfblgqb1l5z6ax644w49w9hwxs93f2k8"; + release."0.2.3".sha256 = "0p9mr8g1qma6h10qf7014dv98ln90dfkwn76ynagpww7qap8s966"; + + defaultVersion = + let + inherit (lib.versions) range; + in + lib.switch + [ coq.version mathcomp.version ] + [ + { + cases = [ + (range "8.19" "8.20") + (range "2.1.0" "2.3.0") + ]; + out = "1.9.0"; + } + { + cases = [ + (range "8.17" "8.20") + (range "2.0.0" "2.2.0") + ]; + out = "1.1.0"; + } + { + cases = [ + (range "8.17" "8.19") + (range "1.17.0" "1.19.0") + ]; + out = "0.7.0"; + } + { + cases = [ + (range "8.17" "8.18") + (range "1.15.0" "1.18.0") + ]; + out = "0.6.7"; + } + { + cases = [ + (range "8.17" "8.18") + (range "1.15.0" "1.18.0") + ]; + out = "0.6.6"; + } + { + cases = [ + (range "8.14" "8.18") + (range "1.15.0" "1.17.0") + ]; + out = "0.6.5"; + } + { + cases = [ + (range "8.14" "8.18") + (range "1.13.0" "1.16.0") + ]; + out = "0.6.1"; + } + { + cases = [ + (range "8.14" "8.18") + (range "1.13" "1.15") + ]; + out = "0.5.2"; + } + { + cases = [ + (range "8.13" "8.15") + (range "1.13" "1.14") + ]; + out = "0.5.1"; + } + { + cases = [ + (range "8.13" "8.15") + (range "1.12" "1.14") + ]; + out = "0.3.13"; + } + { + cases = [ + (range "8.11" "8.14") + (range "1.12" "1.13") + ]; + out = "0.3.10"; + } + { + cases = [ + (range "8.10" "8.12") + "1.11.0" + ]; + out = "0.3.3"; + } + { + cases = [ + (range "8.10" "8.11") + "1.11.0" + ]; + out = "0.3.1"; + } + { + cases = [ + (range "8.8" "8.11") + (range "1.8" "1.10") + ]; + out = "0.2.3"; + } + ] + null; + + # list of analysis packages sorted by dependency order + packages = { + "classical" = [ ]; + "reals" = [ "classical" ]; + "experimental-reals" = [ "reals" ]; + "analysis" = [ "reals" ]; + "reals-stdlib" = [ "reals" ]; + "analysis-stdlib" = [ + "analysis" + "reals-stdlib" + ]; + }; + + mathcomp_ = + package: + let + classical-deps = [ + mathcomp.algebra + mathcomp-finmap + ]; + experimental-reals-deps = [ mathcomp-bigenough ]; + analysis-deps = [ + mathcomp.field + mathcomp-bigenough + ]; + intra-deps = lib.optionals (package != "single") (map mathcomp_ packages.${package}); + pkgpath = lib.switch package [ + { case = "single"; out = "."; } + { case = "analysis"; out = "theories"; } + { case = "experimental-reals"; out = "experimental_reals"; } + { case = "reals-stdlib"; out = "reals_stdlib"; } + { case = "analysis-stdlib"; out = "analysis_stdlib"; } + ] package; + pname = if package == "single" then "mathcomp-analysis-single" else "mathcomp-${package}"; + derivation = mkCoqDerivation ({ + inherit + version + pname + defaultVersion + release + repo + owner + ; + + namePrefix = [ + "coq" + "mathcomp" + ]; + + propagatedBuildInputs = + intra-deps + ++ lib.optionals (lib.elem package [ + "classical" + "single" + ]) classical-deps + ++ lib.optionals (lib.elem package [ + "experimental-reals" + "single" + ]) experimental-reals-deps + ++ lib.optionals (lib.elem package [ + "analysis" + "single" + ]) analysis-deps + ++ lib.optionals (lib.elem package [ + "reals-stdlib" + "analysis-stdlib" + "single" + ]) [stdlib interval]; + + preBuild = '' + cd ${pkgpath} + ''; + + meta = { + description = "Analysis library compatible with Mathematical Components"; + maintainers = [ lib.maintainers.cohencyril ]; + license = lib.licenses.cecill-c; + }; + + passthru = lib.mapAttrs (package: deps: mathcomp_ package) packages; + }); + # split packages didn't exist before 0.6, so building nothing in that case + patched-derivation1 = derivation.overrideAttrs ( + o: + lib.optionalAttrs + ( + o.pname != null + && o.pname != "mathcomp-analysis" + && o.version != null + && o.version != "dev" + && lib.versions.isLt "0.6" o.version + ) + { + preBuild = ""; + buildPhase = "echo doing nothing"; + installPhase = "echo doing nothing"; + } + ); + patched-derivation2 = patched-derivation1.overrideAttrs ( + o: + lib.optionalAttrs ( + o.pname != null + && o.pname == "mathcomp-analysis" + && o.version != null + && o.version != "dev" + && lib.versions.isLt "0.6" o.version + ) { preBuild = ""; } + ); + # only packages classical and analysis existed before 1.7, so building nothing in that case + patched-derivation3 = patched-derivation2.overrideAttrs ( + o: + lib.optionalAttrs + ( + o.pname != null + && o.pname != "mathcomp-classical" + && o.pname != "mathcomp-analysis" + && o.version != null + && o.version != "dev" + && lib.versions.isLt "1.7" o.version + ) + { + preBuild = ""; + buildPhase = "echo doing nothing"; + installPhase = "echo doing nothing"; + } + ); + patched-derivation = patched-derivation3.overrideAttrs ( + o: + lib.optionalAttrs (o.version != null && (o.version == "dev" || lib.versions.isGe "0.3.4" o.version)) + { + propagatedBuildInputs = o.propagatedBuildInputs ++ [ hierarchy-builder ]; + } + ); + in + patched-derivation; +in +mathcomp_ (if single then "single" else "analysis") diff --git a/experimental_reals/discrete.v b/experimental_reals/discrete.v index 412877a07b..63ca0e73b8 100644 --- a/experimental_reals/discrete.v +++ b/experimental_reals/discrete.v @@ -4,7 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -From Coq Require Setoid. +From Corelib Require Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. diff --git a/reals/reals.v b/reals/reals.v index 90bb30d878..601ad4fe7c 100644 --- a/reals/reals.v +++ b/reals/reals.v @@ -38,7 +38,7 @@ (* *) (******************************************************************************) -From Coq Require Import Setoid. +From Corelib Require Import Setoid. From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra archimedean. From mathcomp Require Import boolp classical_sets set_interval. diff --git a/theories/hoelder.v b/theories/hoelder.v index 5dccdf06bb..28be0971a6 100644 --- a/theories/hoelder.v +++ b/theories/hoelder.v @@ -100,6 +100,16 @@ rewrite unlock invr1// poweRe1//; under eq_integral do [rewrite poweRe1//=] => / exact: integral_ge0. Qed. +Lemma Lnorm_abse f p : + 'N_p[abse \o f] = 'N_p[f]. +Proof. +rewrite unlock/=. +have -> : (abse \o (abse \o f)) = abse \o f. + by apply: funext => x/=; rewrite abse_id. +case: p => [r|//|//]. +by under eq_integral => x _ do rewrite abse_id. +Qed. + Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. Proof. by move=> fg; congr Lnorm; apply/eq_fun => ?; rewrite /= fg. Qed. @@ -1130,4 +1140,15 @@ apply: (@le_lt_trans _ _ M%:E). by rewrite ltry. Qed. +Lemma lfun_norm (f : T -> R) : + f \in lfun mu 1 -> (normr \o f) \in lfun mu 1. +Proof. +move=> /andP[]. +rewrite !inE/= => mf finf; apply/andP; split. + by rewrite inE/=; exact: measurableT_comp. +rewrite inE/=/finite_norm. +under [X in 'N[_]__[X]]eq_fun => x do rewrite -abse_EFin. +by rewrite Lnorm_abse. +Qed. + End lfun_inclusion. diff --git a/theories/sampling.v b/theories/sampling.v index 0f268908e3..dcb01a8370 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -25,21 +25,47 @@ Unset Printing Implicit Defensive. (* sampling_theorem_part2. *) (* *) (* References: *) -(* - Samir Rajani. Applications of Chernoff bounds, 2019 *) -(* http://math.uchicago.edu/~may/REU2019/REUPapers/Rajani.pdf *) (* - Michael Mitzenmacher and Eli Upfal. Probability and Computing—Randomized *) (* Algorithms and Probabilistic Analysis. Cambridge University Press, 2005 *) +(* - Samir Rajani. Applications of Chernoff bounds, 2019 *) +(* http://math.uchicago.edu/~may/REU2019/REUPapers/Rajani.pdf *) (* *) +(* ## Construction of the product probability measure *) (* 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 *) -(* Tnth == TODO *) +(* Tnth X i x == the i-th component of X applied to the i-th component of x *) (* pro1 P Q == the probability measure P \x Q *) (* P and Q are probability measures. *) (* pro2 P Q == the probability measure P \x^ Q *) (* P and Q are probability measures. *) (* \X_n P == the product probability measure P \x P \x ... \x P *) +(* *) +(* ## Lemmas for Expectation of Sum and Product on the Product Measure *) +(* - expectation_sum_ipro: The expectation of the sum of random variables on *) +(* the product measure is the sum of their expectations. *) +(* - expectation_product: The expectation of the product of random variables *) +(* on the product measure is the product of their expectations. *) +(* Independence of the variables follows by construction on the product *) +(* measure. *) +(* *) +(* ## Key steps in the Sampling theorem *) +(* - mmt_gen_fun_expectation: Expectation of the moment generating function *) +(* of a Bernoulli trial. *) +(* - bernoulli_trial_mmt_gen_fun: the moment generating function of a *) +(* Bernoulli trial is the product of each moment generating function. *) +(* - exp2_le8: inequality solved by interval. *) +(* - xlnx_lbound_i01: lower bound for x * ln x in the interval `]0, 1[. *) +(* - xlnx_ubound_i1y: upper bound for x * ln x for x greater than 1. *) +(* - sampling_ineq1: Concentration inequality on a Bernoulli trial X, *) +(* bounding the probability of X >= (1+delta) * 'E_(\X_n P)[X] *) +(* - sampling_ineq2: Specialization of sampling_ineq1 using xlnx_lbound_i12 *) +(* - sampling_ineq3: Concentration inequality on a Bernoulli trial X, *) +(* bounding the probability of X <= (1-delta) * 'E_(\X_n P)[X] *) +(* - sampling_ineq4: Combines the previous two inequalities to obtain a bound *) +(* on the probability of `|X - 'E_(\X_n P)[X]| >= delta * 'E_(\X_n P)[X] *) +(* - sampling: The main sampling theorem combining the above inequalities. *) (******************************************************************************) Import Order.TTheory GRing.Theory Num.Def Num.Theory. @@ -73,7 +99,7 @@ rewrite /bool_to_real. apply: measurableT_comp => //=. exact: (@measurable_funPT _ _ _ _ f). Qed. -(* HB.about isMeasurableFun.Build. *) + HB.instance Definition _ := isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. @@ -124,7 +150,17 @@ by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; Qed. End fset. -Lemma finite_prod {R : realType} n (F : 'I_n -> \bar R) : +Lemma finite_prod_fin_num {R : realType} n (F : 'I_n -> \bar R) : + (forall i, F i \is a fin_num)%E -> (\prod_(i < n) F i \is a fin_num)%E. +Proof. +move: F; elim: n => n; first by rewrite big_ord0 fin_numE. +move=> ih F Foo. +rewrite big_ord_recl fin_numM//. +apply:ih => i. +exact: Foo. +Qed. + +Lemma finite_prod_ge0 {R : realType} n (F : 'I_n -> \bar R) : (forall i, 0 <= F i < +oo)%E -> (\prod_(i < n) F i < +oo)%E. Proof. move: F; elim: n => n; first by rewrite big_ord0 ltry. @@ -766,11 +802,11 @@ rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (@mpsi n) _ setT by rewrite normr_id// psiK. Qed. -Lemma integral_ipro_ge0 n (f : {mfun n.+1.-tuple T >-> R}) : - (forall x, 0 <= f x)%R -> +Lemma integral_ipro_ge0 n (f : n.+1.-tuple T -> R) : + measurable_fun setT f -> (forall x, 0 <= f x)%R -> \int[\X_n.+1 P]_w (f w)%:E = \int[pro2 P (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. -move=> f0. +move=> mf f0. rewrite -(@ge0_integral_pushforward _ _ _ _ R _ (@mphi n) _ setT (fun x : n.+1.-tuple T => (f x)%:E)); [ | by [] | exact: measurableT_comp | ]. apply: eq_measure_integral => A mA _. @@ -946,25 +982,26 @@ Qed. Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (P1 : probability T1 R) (P2 : probability T2 R) - (X : {mfun T1 >-> R}) (Y : {mfun T2 >-> R}) : + (X : T1 -> R) (Y : T2 -> R) : (X : _ -> _) \in lfun P1 1 -> (Y : _ -> _) \in lfun P2 1 -> let XY := fun (x : T1 * T2) => (X x.1 * Y x.2)%R in 'E_(pro2 P1 P2)[XY] = 'E_P1[X] * 'E_P2[Y]. Proof. -move=> intX intY/=. +move=> /[dup]lX /sub_lfun_mfun +/[dup]lY /sub_lfun_mfun. +rewrite !inE/= => mX mY. rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. apply/integrable21ltyP. - apply/measurable_EFinP => //=. - by apply: measurable_funM => //=; apply: measurableT_comp. + by apply: measurable_funM => //=; apply/measurableT_comp. - under eq_integral. move=> t _. under eq_integral. move=> x _. rewrite /= normrM EFinM muleC. over. - rewrite /= integralZl//; last first. - by move/lfun1_integrable/integrable_abse : intX. + rewrite integralZl//; last first. + exact/lfun1_integrable/lfun_norm. over. rewrite /=. rewrite ge0_integralZr//; last 2 first. @@ -972,10 +1009,9 @@ rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. by apply/measurableT_comp => //. by apply: integral_ge0 => //. rewrite lte_mul_pinfty//. - by apply: integral_ge0 => //. - apply: integral_fune_fin_num => //. - by move/lfun1_integrable/integrable_abse : intY. - by move/lfun1_integrable/integrableP : intX => []. + - exact: integral_ge0. + - exact/integral_fune_fin_num/lfun1_integrable/lfun_norm. + - by move: lX => /lfun1_integrable/integrableP[_ /=]. rewrite /fubini_F/=. under eq_integral => x _. under eq_integral => y _ do rewrite EFinM. @@ -992,6 +1028,7 @@ Section properties_of_independence. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. +(* TODO: delete? *) Lemma boundedM U (f g : U -> R) (A : set U) : [bounded f x | x in A] -> [bounded g x | x in A] -> @@ -1011,11 +1048,20 @@ by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. Unshelve. all: by end_near. Qed. -Lemma expectation_prod_nondep n (X : n.-tuple {RV P >-> R}) : - [set` X] `<=` lfun P 1 -> (forall i t, 0 <= tnth X i t)%R -> +Lemma abse_prod [I : Type] (r : seq I) (Q : pred I) (F : I -> \bar R) : + `|\prod_(i <- r | Q i) F i| = (\prod_(i <- r | Q i) `|F i|). +Proof. +elim/big_ind2 : _ => //. + by rewrite abse1. +move=> x1 x2 ? ? <- <-. +by rewrite abseM. +Qed. + +Lemma expectation_product n (X : n.-tuple {RV P >-> R}) : + [set` X] `<=` lfun P 1 -> 'E_(\X_n P)[ \prod_(i < n) Tnth X i] = \prod_(i < n) 'E_P[ (tnth X i) ]. Proof. -elim: n X => [X|n IH X] intX posX/=. +elim: n X => [X|n IH X] lfunX/=. by rewrite !big_ord0 expectation_cst. rewrite unlock /expectation. rewrite [X in integral X](_ : _ = \X_n.+1 P)//. @@ -1023,20 +1069,56 @@ pose F : n.+1.-tuple T -> R := (\prod_(i < n.+1) Tnth X i)%R. have mF : measurable_fun setT F by apply: measurable_tuple_prod. pose build_mF := isMeasurableFun.Build _ _ _ _ F mF. pose MF : {mfun _ >-> _} := HB.pack F build_mF. -rewrite [LHS](@integral_ipro_ge0 _ _ _ _ _ MF) /pro2; last first. - by rewrite /MF/F/= => t; rewrite fct_prodE/Tnth/= prodr_ge0//. +have h1 : (thead X : _ -> _) \in lfun P 1 by exact/lfunX/mem_tnth. +have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in lfun (\X_n P) 1. + apply/lfun1_integrable/integrableP => /=; split. + apply: measurableT_comp => //. + exact: measurable_tuple_prod. + under eq_integral => x _ do rewrite -abse_EFin. + apply/abse_integralP => //=. + apply: measurableT_comp => //. + exact: measurable_tuple_prod. + have := IH (behead_tuple X). + rewrite unlock /= => ->; last by move => x /mem_behead/lfunX. + rewrite abse_prod finite_prod_ge0// => i. + rewrite abse_ge0//= abse_integralP//; last first. + exact: measurableT_comp. + have: (tnth (behead_tuple X) i) \in X by apply/mem_behead/mem_tnth. + by move/(lfunX (tnth (behead_tuple X) i))/lfun1_integrable/integrableP => [_]. +rewrite [LHS](@integral_ipro _ _ _ _ _ MF) /pro2; last first. + rewrite /MF/F; apply/integrableP; split. + exact: measurableT_comp. + rewrite integral_ipro_ge0/=; last 2 first. + - exact: measurableT_comp. + - by []. + rewrite [ltLHS](_ : _ = \int[pro2 P (\X_n P)]_x (`|thead X x.1| * `|(\prod_(i < n) Tnth (behead_tuple X) i) x.2|)%:E); last first. + apply: eq_integral => x _. + rewrite big_ord_recl normrM /Tnth (tuple_eta X) !fct_prodE/= !tnth0/=. + congr ((_ * `|_|)%:E). + by apply: eq_bigr => i _/=; rewrite !tnthS -tuple_eta. + pose tuple_prod := (\prod_(i < n) Tnth (behead_tuple X) i)%R. + pose meas_tuple_prod := measurable_tuple_prod (behead_tuple X) id. + pose build_MTP := isMeasurableFun.Build _ _ _ _ tuple_prod meas_tuple_prod. + pose MTP : {mfun _ >-> _} := HB.pack tuple_prod build_MTP. + pose normMTP : {mfun _ >-> _} := normr \o MTP. + rewrite [ltLHS](_ : _ = \int[P]_w `|thead X w|%:E * \int[\X_n P]_w `|tuple_prod w|%:E); last first. + have := @expectation_pro2 _ _ _ _ _ P (\X_n P) (normr \o thead X) (normMTP). + rewrite unlock /= /tuple_prod => <- //. + - exact/lfun_norm. + - exact/lfun_norm. + rewrite lte_mul_pinfty ?ge0_fin_numE ?integral_ge0//. + by move: h1 => /lfun1_integrable/integrableP[_]. + by move: h2 => /lfun1_integrable/integrableP[_]. under eq_fun. move=> /=x. - rewrite /F/MF. - rewrite big_ord_recl/=. - rewrite /Tnth/= fctE tnth0. + rewrite /F/MF big_ord_recl/= /Tnth/= fctE tnth0. rewrite fct_prodE. under eq_bigr. move=> i _. rewrite tnthS. over. over. -have /lfun1_integrable/integrableP/=[mXi iXi] := intX _ (mem_tnth ord0 X). +have /lfun1_integrable/integrableP/=[mXi iXi] := lfunX _ (mem_tnth ord0 X). have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < +oo. under eq_integral => x _. rewrite [X in X%:E](_ : _ = \prod_(i < n) tnth (behead_tuple X) i (tnth x i))%R; last first. @@ -1047,23 +1129,28 @@ have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < + apply: eq_integral => /=x _. by rewrite /Tnth fct_prodE. rewrite IH. - - apply: finite_prod => i; rewrite expectation_ge0//=. - rewrite unlock tnth_behead. - have /lfun1_integrable/integrableP[?] := (intX (tnth X (inord i.+1)) (mem_tnth _ _)). - apply: le_lt_trans. - apply: ge0_le_integral => //. - - by move=> x _; rewrite lee_fin posX. - - by apply: measurableT_comp => //. - by move=> x _; rewrite lee_fin ler_norm. - by move=> x; rewrite tnth_behead posX. - - by move=> Xi XiX; rewrite intX//= mem_behead. - by move=> i t; rewrite tnth_behead posX. + rewrite ltey_eq finite_prod_fin_num//= => i. + rewrite fin_num_abs unlock. + apply/abse_integralP => //. + exact: measurableT_comp. + have: (tnth (behead_tuple X) i) \in X by apply/mem_behead/mem_tnth. + by move/(lfunX (tnth (behead_tuple X) i))/lfun1_integrable/integrableP => [_/=]. + by move=> Xi XiX; rewrite lfunX//= mem_behead. have ? : measurable_fun [set: n.-tuple T] (fun x : n.-tuple T => \prod_(i < n) tnth X (lift ord0 i) (tnth x i))%R. apply: measurable_prod => //= i i_n. apply: measurableT_comp => //. exact: measurable_tnth. rewrite /=. +have ? : \int[\X_n P]_x `|\prod_(i < n) tnth X (lift ord0 i) (tnth x i)|%:E < +oo. + move: h2 => /lfun1_integrable/integrableP[?]. + apply: le_lt_trans. + rewrite le_eqVlt; apply/orP; left; apply/eqP. + apply: eq_integral => x _/=. + rewrite fct_prodE/=. + congr (`| _ |%:E). + apply: eq_bigr => i _. + by rewrite {1}(tuple_eta X) tnthS. rewrite -fubini1' /fubini_F/=; last first. apply/integrable21ltyP => //=. apply: measurableT_comp => //. @@ -1074,28 +1161,27 @@ rewrite -fubini1' /fubini_F/=; last first. exact: (measurableT_comp (measurable_tnth i) measurable_snd). under eq_integral => y _. under eq_integral => x _ do rewrite normrM EFinM. - rewrite integralZr//; last exact/lfun1_integrable/lfun_norm/intX/mem_tnth. + rewrite integralZr//; last exact/lfun1_integrable/lfun_norm/lfunX/mem_tnth. rewrite -[X in X * _]fineK ?ge0_fin_numE ?integral_ge0//. over. rewrite integralZl ?fineK ?lte_mul_pinfty ?integral_ge0//=. - by rewrite ge0_fin_numE ?integral_ge0. - - by under eq_integral => x _ do rewrite ger0_norm ?prodr_ge0//. - by rewrite ge0_fin_numE ?integral_ge0. - apply/integrableP; split; first by do 2 apply: measurableT_comp => //. - by under eq_integral => x _ do rewrite /=normr_id ger0_norm ?prodr_ge0//. + by under eq_integral => x _ do rewrite /=normr_id. under eq_integral => x _. under eq_integral => y _ do rewrite EFinM. rewrite integralZl/=; last 2 first. - apply: measurableT. - - apply/integrableP; split => //; first by apply: measurableT_comp => //. - by under eq_integral => y _ do rewrite /=ger0_norm ?prodr_ge0//. + - by apply/integrableP; split => //; first by apply: measurableT_comp => //. rewrite -[X in _ * X]fineK; last first. - rewrite ge0_fin_numE ?integral_ge0//=; last first. - by move=> t _; rewrite lee_fin prodr_ge0. + rewrite fin_num_abs. apply/abse_integralP => //. + exact/measurable_EFinP. over. -rewrite /= integralZr//; last exact/lfun1_integrable/intX/mem_tnth. +rewrite /= integralZr//; last exact/lfun1_integrable/lfunX/mem_tnth. rewrite fineK; last first. - by rewrite ge0_fin_numE// integral_ge0 => //=x _; rewrite lee_fin prodr_ge0//. + rewrite fin_num_abs. apply/abse_integralP => //. + exact/measurable_EFinP. rewrite [X in _ * X](_ : _ = 'E_(\X_n P)[\prod_(i < n) Tnth (behead X) i])%R; last first. rewrite [in RHS]unlock /Tnth. apply: eq_integral => x _. @@ -1108,8 +1194,7 @@ rewrite [X in _ * X](_ : _ = 'E_(\X_n P)[\prod_(i < n) Tnth (behead X) i])%R; la apply: val_inj => /=. by rewrite /bump/= inordK// ltnS. rewrite IH; last first. -- by move=> i t; rewrite tnth_behead. -- by move=> Xi XiX; rewrite intX//= mem_behead. +- by move => x /mem_behead/lfunX. rewrite big_ord_recl/=. congr (_ * _). apply: eq_bigr => /=i _. @@ -1228,7 +1313,7 @@ Lemma expectation_bernoulli_trial n (X : n.-tuple (bernoulliRV P p)) : 'E_(\X_n P)[bool_trial_value X] = (n%:R * p)%:E. Proof. rewrite expectation_sum_ipro; last first. - by move=> Xi /tnthP [i] ->; rewrite tnth_map lfun_bernoulli. + by move=> Xi /tnthP [i] ->; rewrite tnth_map; apply: lfun_bernoulli. transitivity (\sum_(i < n) p%:E). by apply: eq_bigr => k _; rewrite !tnth_map bernoulli_expectation. by rewrite sumEFin big_const_ord iter_addr addr0 mulrC mulr_natr. @@ -1257,14 +1342,14 @@ transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ])%R. apply: eq_bigr => i _. by rewrite /Tnth !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. -rewrite expectation_prod_nondep; last 2 first. -- move=> _ /mapP[/= i _ ->]. +rewrite expectation_product; last first. +- move=> _ /mapP [/= i _ ->]. + apply/lfun1_integrable. apply: (bounded_RV_integrable (expR `|t|)) => // t0. rewrite expR_ge0/= ler_expR/=. rewrite /bool_to_real/=. case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. by rewrite ler_norm. -- by move=> i t0; rewrite tnth_map/= expR_ge0. apply: eq_bigr => /= i _. congr expectation. rewrite /=. @@ -1358,8 +1443,7 @@ Proof. move=> d0 /=. rewrite -EFinM lee_fin -powRM ?expR_ge0// ge0_ler_powR ?nnegrE//. - by rewrite fine_ge0// expectation_ge0// => x; exact: bernoulli_trial_ge0. -- by rewrite mulr_ge0// expR_ge0. -- by rewrite divr_ge0 ?expR_ge0// powR_ge0. +- by rewrite divr_ge0// powR_ge0. - rewrite lnK ?posrE ?addr_gt0// addrAC subrr add0r ler_wpM2l ?expR_ge0//. by rewrite -powRN mulNr -mulrN expRM lnK// posrE addr_gt0. Qed. @@ -1671,7 +1755,7 @@ by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. (* [Corollary 2.7, Rajani] / [Corollary 4.7, MU] *) -Corollary samping_ineq4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : +Corollary sampling_ineq4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> (0 < n)%nat -> (0 < p)%R -> @@ -1750,7 +1834,7 @@ have step1 : (\X_n P) [set i | `| X' i - p | >= epsilon * p]%R <= rewrite -mulrA. have -> : (p * n%:R)%R = fine (p * n%:R)%:E by []. rewrite -(mulrC _ p) -(expectation_bernoulli_trial p01 X). - exact: (@samling_ineq4 _ X epsilon). + exact: (@sampling_ineq4 _ X epsilon). have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= ((expR (- (n%:R * theta ^+ 2) / 3)) *+ 2)%:E. rewrite thetaE; move/le_trans : step1; apply. From 6c0899991827ba4c9aef8317cb7e78622678472e Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Mon, 28 Apr 2025 15:25:08 +0900 Subject: [PATCH 69/73] removing independence.v --- theories/sampling.v | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index dcb01a8370..df853165a4 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -11,7 +11,7 @@ From mathcomp Require Import reals ereal interval_inference topology normedtype. From mathcomp Require Import sequences realfun convex real_interval. From mathcomp Require Import derive esum measure exp numfun lebesgue_measure. From mathcomp Require Import lebesgue_integral kernel probability. -From mathcomp Require Import hoelder independence. +From mathcomp Require Import hoelder unstable. Set Implicit Arguments. Unset Strict Implicit. @@ -581,7 +581,7 @@ Proof. rewrite [X in measurable_fun _ X](_ : _ = (fun x => \prod_(i < n) Tnth s (f i) x)); last first. by apply/funext => x; rewrite fct_prodE. -by apply: measurable_prod => /= i _; apply/measurableT_comp => //. +by apply: measurable_prod => /= i _; apply/measurableT_comp. Qed. HB.instance Definition _ m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) := From a1f807c1dbfc25bd29c8a4e44c1871f439edf380 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 14:07:31 +0900 Subject: [PATCH 70/73] minor cleaning --- theories/sampling.v | 54 ++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 30 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index df853165a4..7c2941ca2c 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -75,6 +75,7 @@ Import hoelder ess_sup_inf. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +(* PR in progress *) Lemma memB_itv (R : numDomainType) (b0 b1 : bool) (x y z : R) : (y - z \in Interval (BSide b0 x) (BSide b1 y)) = (x + z \in Interval (BSide (~~ b1) x) (BSide (~~ b0) y)). @@ -83,21 +84,20 @@ rewrite !in_itv /= /Order.lteif !if_neg. by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. Qed. -(* generalizes mem_1B_itvcc *) +(* PR in progress *) Lemma memB_itv0 (R : numDomainType) (b0 b1 : bool) (x y : R) : (y - x \in Interval (BSide b0 0) (BSide b1 y)) = (x \in Interval (BSide (~~ b1) 0) (BSide (~~ b0) y)). Proof. by rewrite memB_itv add0r. Qed. Section bool_to_real. -Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). +Context d (T : measurableType d) (R : realType) (P : probability T R) + (f : {mfun T >-> bool}). Definition bool_to_real : T -> R := (fun x => x%:R) \o (f : T -> bool). Lemma measurable_bool_to_real : measurable_fun [set: T] bool_to_real. Proof. -rewrite /bool_to_real. -apply: measurableT_comp => //=. -exact: (@measurable_funPT _ _ _ _ f). +by apply: measurableT_comp => //=; exact: (@measurable_funPT _ _ _ _ f). Qed. HB.instance Definition _ := @@ -107,6 +107,8 @@ HB.instance Definition _ := MeasurableFun.on bool_to_real. End bool_to_real. +(* + Section mfunM. Context {d} (T : measurableType d) {R : realType}. @@ -114,7 +116,7 @@ HB.instance Definition _ (f g : {mfun T >-> R}) := @isMeasurableFun.Build d _ _ _ (f \* g)%R (measurable_funM (measurable_funPT f) (measurable_funPT g)). -End mfunM. +End mfunM.*) HB.instance Definition _ (n : nat) := isPointed.Build 'I_n.+1 ord0. @@ -724,7 +726,7 @@ Definition psi n := fun w : n.+1.-tuple T => (thead w, [the _.-tuple _ of behead Lemma mpsi n : measurable_fun [set: _.-tuple _] (@psi n). Proof. -by apply/measurable_fun_prod => /=; +by apply/measurable_fun_pair => /=; [exact: measurable_tnth|exact: measurable_behead]. Qed. @@ -1767,6 +1769,8 @@ Proof. move=> /andP[d0 d1] n0 p0 /=. set X' := bool_trial_value X. set mu := 'E_(\X_n P)[X']. +have mu_gt0 : (0 < fine mu)%R. + by rewrite /mu /X' expectation_bernoulli_trial// mulr_gt0// ltr0n. under eq_set => x. rewrite ler_normr. rewrite lerBrDl opprD opprK -{1}(mul1r (fine mu)) -mulrDl. @@ -1775,32 +1779,22 @@ under eq_set => x. rewrite -!lee_fin. over. rewrite /=. -rewrite set_orb. -rewrite measureU; last 3 first. -- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. - apply: emeasurable_fun_le => //. - apply/measurable_EFinP. - exact: measurableT_comp. -- rewrite -(@setIidr _ setT [set _ | _]) ?subsetT//. - apply: emeasurable_fun_le => //. - apply/measurable_EFinP. - exact: measurableT_comp. -- rewrite disjoints_subset => x /=. - rewrite /mem /in_mem/= => X0; apply/negP. - rewrite -ltNge. - apply: (@lt_le_trans _ _ _ _ _ _ X0). - rewrite !EFinM. - rewrite lte_pmul2r//; first by rewrite lte_fin ltrD2l gt0_cp. - by rewrite fineK /mu/X' expectation_bernoulli_trial// lte_fin mulr_gt0 ?ltr0n. +rewrite set_orb measureU; last 3 first. +- rewrite -[X in measurable X]setTI; apply: measurable_lee => //. + exact/measurable_EFinP/measurableT_comp. +- rewrite -[X in measurable X]setTI; apply: measurable_lee => //. + exact/measurable_EFinP/measurableT_comp. +- rewrite disjoints_subset => /= x deltaX; apply/negP. + rewrite -ltNge (lt_le_trans _ deltaX)// lte_fin ltr_pM2r//. + by rewrite ltrD2l gt0_cp. rewrite mulr2n EFinD leeD//=. - by apply: sampling_ineq2; rewrite //d0 d1. - have d01 : (0 < delta < 1)%R by rewrite d0. - apply: (le_trans (@sampling_ineq3 _ _ _ _ p p01 _ X delta d01)). + rewrite (le_trans (sampling_ineq3 p01 X d01))//. rewrite lee_fin ler_expR !mulNr lerN2. rewrite ler_pM//; last by rewrite lef_pV2 ?posrE ?ler_nat. - rewrite mulr_ge0 ?fine_ge0 ?sqr_ge0//. - rewrite /mu unlock /expectation integral_ge0// => x _. - by rewrite /X' lee_fin; exact: bernoulli_trial_ge0. + rewrite mulr_ge0 ?sqr_ge0// fine_ge0//. + by rewrite /mu expectation_ge0//= => t; exact: bernoulli_trial_ge0. Qed. (* [Theorem 3.1, Rajani] / [thm 4.7, MU] *) @@ -1852,7 +1846,7 @@ suff : delta%:E >= (\X_n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) have ? : measurable [set i | (`|X' i - p| < theta)%R]. under eq_set => x do rewrite -lte_fin. rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. - by apply: emeasurable_fun_lt => //; apply: measurableT_comp => //; + by apply: measurable_lte => //; apply: measurableT_comp => //; apply: measurableT_comp => //; apply: measurable_funD => //; apply: measurable_funM. rewrite probability_setC// lee_subel_addr//. @@ -1861,7 +1855,7 @@ suff : delta%:E >= (\X_n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) rewrite le_measure ?inE//. under eq_set => x do rewrite -lee_fin. rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. - by apply: emeasurable_fun_le => //; apply: measurableT_comp => //; + by apply: measurable_lee => //; apply: measurableT_comp => //; apply: measurableT_comp => //; apply: measurable_funD => //; apply: measurable_funM. by move=> t/= /ltW. From 61c4b1a54f757a3314f924c6a36165cd13ac0fd2 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 14:23:56 +0900 Subject: [PATCH 71/73] use `expeR` to rm one `fine` --- theories/sampling.v | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 7c2941ca2c..75f4172f83 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1411,13 +1411,14 @@ Qed. Lemma mmt_gen_fun_expectation n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : (0 <= t)%R -> let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in - 'M_X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. + 'M_X t <= expeR ('E_(\X_n P)[X] * (expR t - 1)%:E). Proof. move=> t_ge0/=. have /andP[p0 p1] := p01. -rewrite binomial_mmt_gen_fun// lee_fin. +rewrite binomial_mmt_gen_fun//. rewrite expectation_bernoulli_trial//. rewrite addrCA -{2}(mulr1 p) -mulrN -mulrDr. +rewrite /= lee_fin. rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR// ?nnegrE ?expR_ge0//. by rewrite addr_ge0// mulr_ge0// subr_ge0 -expR0 ler_expR. exact: expR_ge1Dx. @@ -1464,11 +1465,13 @@ set mu := 'E_(\X_n P)[X]. set t := ln (1 + delta). have t0 : (0 < t)%R by rewrite ln_gt0// ltrDl. apply: (le_trans (chernoff _ _ t0)). -apply: (@le_trans _ _ ((expR (fine mu * (expR t - 1)))%:E * +apply: (@le_trans _ _ ((expeR (mu * (expR t - 1)%:E)) * (expR (- (t * ((1 + delta) * fine mu))))%:E)). rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - by apply: mmt_gen_fun_expectation => //; exact: ltW. -rewrite mulrC expRM -mulNr mulrA expRM. + by rewrite (le_trans (mmt_gen_fun_expectation p01 _ (ltW t0))). +rewrite -(@fineK _ mu)//; last first. + by rewrite /mu expectation_bernoulli_trial. +rewrite [expeR _]/= mulrC expRM -mulNr mulrA expRM. exact: end_thm24. Qed. From 765d797d1756dc61107cd7354256bb7b2f6ce88c Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 18:29:24 +0900 Subject: [PATCH 72/73] fin_num_prod --- theories/sampling.v | 35 +++++++++++------------------------ 1 file changed, 11 insertions(+), 24 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 75f4172f83..b29372d262 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -137,37 +137,24 @@ Qed. End move_to_bigop_nat_lemmas. -Section fset. -Local Open Scope fset_scope. -Lemma fset_bool : forall B : {fset bool}, - [\/ B == [fset true], B == [fset false], B == fset0 | B == [fset true; false]]. -Proof. -move=> B. -have:= set_bool [set` B]. -rewrite -!set_fset1 -set_fset0. -rewrite (_ : [set: bool] = [set` [fset true; false]]); last first. - by apply/seteqP; split=> -[]; rewrite /= !inE eqxx. -by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; - [apply: Or41|apply: Or42|apply: Or43|apply: Or44]. -Qed. -End fset. - -Lemma finite_prod_fin_num {R : realType} n (F : 'I_n -> \bar R) : - (forall i, F i \is a fin_num)%E -> (\prod_(i < n) F i \is a fin_num)%E. +Local Open Scope ereal_scope. +Lemma fin_num_prod {R : numDomainType} I (s : seq I) (P : pred I) (F : I -> \bar R) : + (forall i, P i -> F i \is a fin_num) -> + \prod_(i <- s | P i) F i \is a fin_num. Proof. -move: F; elim: n => n; first by rewrite big_ord0 fin_numE. -move=> ih F Foo. -rewrite big_ord_recl fin_numM//. -apply:ih => i. -exact: Foo. +elim/big_ind : _ => //. +- by move=> x y ihx ihy PF; rewrite fin_numM ?ihx ?ihy. +- by move=> i Pi; exact. Qed. +Local Close Scope ereal_scope. Lemma finite_prod_ge0 {R : realType} n (F : 'I_n -> \bar R) : (forall i, 0 <= F i < +oo)%E -> (\prod_(i < n) F i < +oo)%E. Proof. move: F; elim: n => n; first by rewrite big_ord0 ltry. move=> ih F Foo. -rewrite big_ord_recl lte_mul_pinfty//. +rewrite big_ord_recl. +rewrite lte_mul_pinfty//. - by have /andP[] := Foo ord0. - rewrite fin_numElt. have /andP[F0 ->] := Foo ord0. @@ -1131,7 +1118,7 @@ have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < + apply: eq_integral => /=x _. by rewrite /Tnth fct_prodE. rewrite IH. - rewrite ltey_eq finite_prod_fin_num//= => i. + rewrite ltey_eq fin_num_prod//= => i _. rewrite fin_num_abs unlock. apply/abse_integralP => //. exact: measurableT_comp. From 71a35c3b6c6077226998cdd5f929672eb44e6d25 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 18:35:07 +0900 Subject: [PATCH 73/73] fin_num_prod already exists --- theories/sampling.v | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index b29372d262..c3c9f7d202 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -137,17 +137,6 @@ Qed. End move_to_bigop_nat_lemmas. -Local Open Scope ereal_scope. -Lemma fin_num_prod {R : numDomainType} I (s : seq I) (P : pred I) (F : I -> \bar R) : - (forall i, P i -> F i \is a fin_num) -> - \prod_(i <- s | P i) F i \is a fin_num. -Proof. -elim/big_ind : _ => //. -- by move=> x y ihx ihy PF; rewrite fin_numM ?ihx ?ihy. -- by move=> i Pi; exact. -Qed. -Local Close Scope ereal_scope. - Lemma finite_prod_ge0 {R : realType} n (F : 'I_n -> \bar R) : (forall i, 0 <= F i < +oo)%E -> (\prod_(i < n) F i < +oo)%E. Proof. @@ -1118,7 +1107,7 @@ have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < + apply: eq_integral => /=x _. by rewrite /Tnth fct_prodE. rewrite IH. - rewrite ltey_eq fin_num_prod//= => i _. + rewrite ltey_eq prode_fin_num//= => i _. rewrite fin_num_abs unlock. apply/abse_integralP => //. exact: measurableT_comp.