From 11e8a7d81453f0ca8f148b6e5422702a4dfa8230 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Thu, 19 Jun 2025 17:24:21 +0200 Subject: [PATCH 01/28] Sampling theorem replaces the sampling PR#1240 --- _CoqProject | 1 + classical/functions.v | 9 + theories/Make | 1 + theories/sampling.v | 1954 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 1965 insertions(+) create mode 100644 theories/sampling.v diff --git a/_CoqProject b/_CoqProject index 7feb87c50..45e35a9d8 100644 --- a/_CoqProject +++ b/_CoqProject @@ -118,6 +118,7 @@ theories/charge.v theories/kernel.v theories/pi_irrational.v theories/gauss_integral.v +theories/sampling.v theories/showcase/summability.v analysis_stdlib/Rstruct_topology.v analysis_stdlib/showcase/uniform_bigO.v diff --git a/classical/functions.v b/classical/functions.v index 020908965..4c0c0cf42 100644 --- a/classical/functions.v +++ b/classical/functions.v @@ -2657,6 +2657,11 @@ Lemma fct_prodE (I : Type) (T : pointedType) (M : ringType) r (P : {pred I}) \prod_(i <- r | P i) f i = fun x => \prod_(i <- r | P i) f i x. Proof. by apply/funext => ?; 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. @@ -2679,6 +2684,10 @@ Lemma prodrfctE (T : pointedType) (K : ringType) (s : seq (T -> K)) : \prod_(f <- s) f = (fun x => \prod_(f <- s) f x). Proof. exact: fct_prodE. 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 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. diff --git a/theories/Make b/theories/Make index d80af9e6f..826718833 100644 --- a/theories/Make +++ b/theories/Make @@ -83,5 +83,6 @@ charge.v kernel.v pi_irrational.v gauss_integral.v +sampling.v all_analysis.v showcase/summability.v diff --git a/theories/sampling.v b/theories/sampling.v new file mode 100644 index 000000000..83044619b --- /dev/null +++ b/theories/sampling.v @@ -0,0 +1,1954 @@ +(* 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. +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 unstable. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +(**md**************************************************************************) +(* # 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: *) +(* - 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 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. +Import numFieldTopology.Exports numFieldNormedType.Exports. +Import hoelder ess_sup_inf. + +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). + +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.instance Definition _ := + isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. + +HB.instance Definition _ := MeasurableFun.on bool_to_real. + +End bool_to_real. + +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. + +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). + +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. + +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. +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. +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. + +(* 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). +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. + +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) + (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). + +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 : 'I_n -> n.-tuple T -> T := fun i x => @tnth n T x i. + +Let tuple_set0 : g_sigma_preimage coors set0. +Proof. exact: sigma_algebra0. Qed. + +Let tuple_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). +Proof. exact: sigma_algebraC. Qed. + +Let tuple_bigcup (F : _^nat) : (forall i, g_sigma_preimage coors (F i)) -> + g_sigma_preimage coors (\bigcup_i (F i)). +Proof. exact: sigma_algebra_bigcup. Qed. + +HB.instance Definition _ := @isMeasurable.Build (measure_tuple_display d) + (n.-tuple T) (g_sigma_preimage coors) tuple_set0 tuple_setC tuple_bigcup. + +End measurable_tuple. + +Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : + measurable_fun [set: n.-tuple T] (@tnth _ T ^~ i). +Proof. +move=> _ Y mY; rewrite setTI; apply: sub_sigma_algebra => /=. +rewrite -bigcup_seq/=; exists i => //=; first by rewrite mem_index_enum. +by exists Y => //; rewrite setTI. +Qed. + +Section measurable_cons. +Context d d1 (T : measurableType d) (T1 : measurableType d1). + +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. +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. + +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 n.+1.-tuple 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 : n.-tuple 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 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. +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 : n.+1.-tuple T => [tuple of behead x] : n.-tuple 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_comp. + 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 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 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 := (P1 \x P2)%E. + +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 := (P1 \x^ P2)%E. + +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 iterated_product_of_probability_measures. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Fixpoint ipro (n : nat) : set (n.-tuple T) -> \bar R := + match n with + | 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 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 _ _ _ (@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)//. + by rewrite (_ : @ipro n = Mpro)// integral_cst// mul0e. +split. + 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 _.-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'/=. + 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. + exact: measurable_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 _ _ _ (@ipro n) + (@ipro_measure n).1 (@ipro_measure n).2.1 (@ipro_measure n).2.2. + +Lemma ipro_setT n : @ipro n setT = 1%E. +Proof. +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. + 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 _ _ _ (@ipro n) (@ipro_setT n). + +End iterated_product_of_probability_measures. +Arguments ipro {d T R} P n. + +Notation "\X_ n P" := (ipro P n) (at level 10, n, P at next level, + format "\X_ n P"). + +Section integral_ipro. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Definition phi n := fun w : T * n.-tuple T => [the _.-tuple _ of w.1 :: w.2]. + +Lemma mphi n : measurable_fun [set: T * n.-tuple T] (@phi n). +Proof. exact: measurable_cons. Qed. + +Definition psi n := fun w : n.+1.-tuple T => (thead w, [the _.-tuple _ of behead w]). + +Lemma mpsi n : measurable_fun [set: _.-tuple _] (@psi n). +Proof. +by apply/measurable_fun_prod => /=; + [exact: measurable_tnth|exact: measurable_behead]. +Qed. + +Lemma phiK n : cancel (@phi n) (@psi n). +Proof. +by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. +Qed. + +Let psiK n : cancel (@psi n) (@phi n). +Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. + +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 n) _ 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 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 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/=. + 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. + +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=> 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 _. + 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_Lfun n (F : n.-tuple {mfun T >-> R}) i : + (tnth F i :> T -> R) \in Lfun P 1 -> (Tnth F i) \in Lfun (\X_n P) 1. +Proof. +rewrite !inE /Tnth => /andP[]. +rewrite !inE /finite_norm/= unlock /Lnorm invr1 poweRe1; last first. +rewrite ?integral_ge0// => x _; rewrite poweRe1//. +under eq_integral => x _ do rewrite poweRe1//=. +move=> mF iF; apply/andP; rewrite !inE/=; split. + apply: measurableT_comp => //. + exact: measurable_tnth. +rewrite /finite_norm unlock /Lnorm/= invr1 poweRe1 ?integral_ge0//. +under eq_integral => x _ do rewrite powRr1//. +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. + exact/Lfun1_integrable/tnth_Lfun/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. + exact/Lfun1_integrable/tnth_Lfun/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/tnth_Lfun/Lfun1_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 move. +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 -> \bar R) (r : R). + +Lemma Lnorm_abse f p : + 'N[mu]_p[abse \o f] = 'N[mu]_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 Lfun1_integrable (f : T -> R) : + f \in Lfun mu 1 <-> mu.-integrable setT (EFin \o f). +Proof. +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. + + +End move. + +Section move. +Context d (T : measurableType d) (R : realType). +Variable mu : {finite_measure set T -> \bar R}. +Local Open Scope ereal_scope. + +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_subset p1 (leey _)). +- by rewrite fin_num_measure. +- by rewrite 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. + +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 move. + +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}) : + [set` X] `<=` Lfun P 1 -> + 'E_(\X_n P)[\sum_(i < n) Tnth X i] = \sum_(i < n) ('E_P[(tnth X i)]). +Proof. +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. +rewrite /image_tuple tnth_map. +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 apply/tnth_Lfun/bX/tnthP; exists j. +Qed. + +Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) + (P1 : probability T1 R) (P2 : probability 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=> /[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. + - under eq_integral. + move=> t _. + under eq_integral. + move=> x _. + rewrite /= normrM EFinM muleC. + over. + rewrite integralZl//; last first. + exact/Lfun1_integrable/Lfun_norm. + over. + rewrite /=. + rewrite ge0_integralZr//; last 2 first. + apply/measurable_EFinP => //. + by apply/measurableT_comp => //. + by apply: integral_ge0 => //. + rewrite lte_mul_pinfty//. + - 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. + rewrite integralZl//; last exact/Lfun1_integrable. + rewrite -[X in _ * X]fineK ?integral_fune_fin_num//; last exact/Lfun1_integrable. + over. +rewrite /=integralZr//; last exact/Lfun1_integrable. +by rewrite fineK// integral_fune_fin_num; last exact/Lfun1_integrable. +Qed. + +End properties_of_expectation. + +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] -> + [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 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] lfunX/=. + by rewrite !big_ord0 expectation_cst. +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. +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 big_ord_recl/= /Tnth/= fctE tnth0. + rewrite fct_prodE. + under eq_bigr. + move=> i _. + rewrite tnthS. + over. + over. +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. + 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. + 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 => //. + apply: measurable_funM => //=. + exact: measurableT_comp. + 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/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 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. +under eq_integral => x _. + under eq_integral => y _ do rewrite EFinM. + rewrite integralZl/=; last 2 first. + - apply: measurableT. + - by apply/integrableP; split => //; first by apply: measurableT_comp => //. + rewrite -[X in _ * X]fineK; last first. + rewrite fin_num_abs. apply/abse_integralP => //. + exact/measurable_EFinP. + over. +rewrite /= integralZr//; last exact/Lfun1_integrable/lfunX/mem_tnth. +rewrite fineK; last first. + 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 _. + 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 => x /mem_behead/lfunX. +rewrite big_ord_recl/=. +congr (_ * _). +apply: eq_bigr => /=i _. +rewrite unlock /expectation. +apply: eq_integral => x _. +congr EFin. +by rewrite [in RHS](tuple_eta X) tnthS. +Qed. + +End properties_of_independence. + +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 properties_of_BernoulliRV. +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. + +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 diracE/= mem_set// mule1// diracE/= memNset//. +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. +Proof. +have/(congr1 (fun f => f [set 0%:R])):= @bernoulliP _ _ _ _ _ X. +rewrite bernoulliE//. +rewrite diracE/= memNset//. +rewrite mule0// diracE/= mem_set// add0e mule1. +rewrite /distribution /= => <-. +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 GRing.natmul 1))//; last first. + by move=> y //=. +rewrite /bernoulli/=. +rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. + by move=> A mA _ /=; congr (_ _); exact: bernoulliP. +rewrite integral_bernoulli//=. +by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. +Qed. + +Lemma integrable_bernoulli (X : bernoulliRV P p) : + 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 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. +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. +apply: funext => x /=. +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[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; 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. + +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. + +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 : (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)[bool_trial_value X] = (n%:R * p)%:E. +Proof. +rewrite expectation_sum_ipro; last first. + 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. +Qed. + +Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) : + (forall t, 0 <= bool_trial_value X t)%R. +Proof. +move=> t. +rewrite [leRHS]fct_sumE. +apply/sumr_ge0 => /= i _. +rewrite /Tnth. +by rewrite !tnth_map. +Qed. + +Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : + let X := bool_trial_value X_ in + mmt_gen_fun (\X_n P) X t = \prod_(i < n) mmt_gen_fun P (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* 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. + 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_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. +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 : bernoulliRV P p) (t : R) : + mmt_gen_fun P (bool_to_real R X) t = (p * expR t + (1-p))%:E. +Proof. +rewrite/mmt_gen_fun. +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. +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. +under eq_set do rewrite (propext (rwP eqP)). +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 (bernoulliRV P p)) (t : R) : + let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in + mmt_gen_fun (\X_n P) 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 (bernoulliRV P p)) (t : R) : + (0 <= t)%R -> + let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in + mmt_gen_fun (\X_n P) X t <= (expR (fine '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 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. + +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 + 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=> 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 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. + +(* [theorem 2.4, Rajani] / [thm 4.4.(2), MU] *) +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 + (\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 := 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. +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 => //; exact: ltW. +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. + +(* TODO : move *) +Lemma norm_expR : normr \o expR = (expR : R -> R). +Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. + + +(* [Theorem 2.6, Rajani] / [thm 4.5.(2), MU] *) +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 + (\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' := 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)). + (* 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; last first. + rewrite norm_expR. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = mmt_gen_fun (\X_n P) X' t by []. + by rewrite binomial_mmt_gen_fun. + 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. + 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'] = mmt_gen_fun (\X_n P) X' t by []. + 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//. + 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. +- 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. + (* 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 *) +Module with_interval. +Declare Scope bigQ_scope. +Import Reals. +Import Rstruct Rstruct_topology. +Import Interval.Tactic. + +Section exp2_le8. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. + +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 RexpE (_ : 8%R = 8); last + by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. +by apply: (iffP idP) => /RleP. +Qed. + +End exp2_le8. +End with_interval. + +Section xlnx_bounding_with_interval. +Let R := Rdefinitions.R. +Local Open Scope ring_scope. + +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). +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 2 1. + rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. + by rewrite addrACA subrr addr0 addrC. + rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. + rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 addr0 /=. + 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 /=. + 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. +- 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 xlnx_bounding_with_interval. + +(* 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. + +(* [Theorem 2.5, Rajani] *) +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 -> + (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: 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. + rewrite lerB//. + 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. +Qed. + +(* [Corollary 2.7, Rajani] / [Corollary 4.7, MU] *) +Corollary sampling_ineq4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : + (0 < delta < 1)%R -> + (0 < n)%nat -> + (0 < p)%R -> + 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' := bool_trial_value 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/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 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 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. +Qed. + +(* [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)%R in + (0 < p)%R -> + (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%N -> + (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' p0 /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. +have /andP[_ p1] := p01. +set epsilon := (theta / p)%R. +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 | `| 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. + move/(@ler_wpM2r _ n%:R^-1); rewrite invr_ge0// ler0n => /(_ erefl). + rewrite -(mulrA _ _ n%:R^-1)%R 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 -(mulrC _ p) -(expectation_bernoulli_trial p01 X). + 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. + 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)%R); 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 sampling_theorem_part2. From 3723148c89e4681a52f7073eb7bcc1d70681170d Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Fri, 20 Jun 2025 08:16:10 +0200 Subject: [PATCH 02/28] mfunM no longer needed --- theories/sampling.v | 9 --------- 1 file changed, 9 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 83044619b..20a4d926a 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -107,15 +107,6 @@ HB.instance Definition _ := MeasurableFun.on bool_to_real. End bool_to_real. -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. - HB.instance Definition _ (n : nat) := isPointed.Build 'I_n.+1 ord0. HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_display From 6e8c01a16490784df3c64ee3176b81e19ac2b467 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Fri, 20 Jun 2025 08:43:25 +0200 Subject: [PATCH 03/28] removed finite_prod_fin_num and finite_prod_ge0 --- theories/sampling.v | 40 ++++++---------------------------------- 1 file changed, 6 insertions(+), 34 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 20a4d926a..f3a27417b 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -141,29 +141,6 @@ by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; 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. -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. -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. - (* TODO: this generalize subset_itv! *) Lemma subset_itvW_bound (d : Order.disp_t) (T : porderType d) (x y z u : itv_bound T) : @@ -1142,11 +1119,9 @@ have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in Lfun (\X_n P) 1. 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 abse_prod -ge0_fin_numE ?prode_ge0// prode_fin_num// => i _. + rewrite abse_fin_num integral_fune_fin_num//. + exact/Lfun1_integrable/lfunX/mem_behead/mem_tnth. rewrite [LHS](@integral_ipro _ _ _ _ _ MF) /pro2; last first. rewrite /MF/F; apply/integrableP; split. exact: measurableT_comp. @@ -1191,12 +1166,9 @@ 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 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 => [_/=]. + rewrite ltey_eq prode_fin_num// => i _. + rewrite expectation_fin_num//. + exact/lfunX/mem_behead/mem_tnth. 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. From 1bc17544d688504095917f3d178890207189fcd0 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Fri, 20 Jun 2025 09:15:32 +0200 Subject: [PATCH 04/28] removing subset_itvW_bound --- theories/sampling.v | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index f3a27417b..8c0e30791 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -141,16 +141,6 @@ by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; Qed. End fset. -(* 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) -> @@ -160,9 +150,9 @@ 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. + exact/(continuous_subspaceW _ cf)/subset_itv. have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itvW_bound. + apply: subset_itv. 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). @@ -182,9 +172,9 @@ 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. + exact/(continuous_subspaceW _ cf)/subset_itv. have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itvW_bound. + apply/subset_itv. 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). From c8be49c0cef0dd91a5f49054ff3afbab1c465a3d Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Fri, 20 Jun 2025 17:52:40 +0200 Subject: [PATCH 05/28] removed gtr0_derive1_homo and ger0_derive1_homo --- theories/sampling.v | 57 ++++++--------------------------------------- 1 file changed, 7 insertions(+), 50 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 8c0e30791..0c7c5e63c 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -141,51 +141,6 @@ by case=> /eqP /(congr1 (@fset_set _)) /[!set_fsetK] /eqP H; Qed. End fset. -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_itv. -have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply: subset_itv. - 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_itv. -have zab z : z \in `]x, y[ -> z \in `]a, b[. - apply/subset_itv. - 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). @@ -1531,11 +1486,12 @@ rewrite in_itv=> /andP [] x0 x1. fold (f x). simpl in idf. rewrite -f1E. -apply: (@gtr0_derive1_homo _ f 0 1 false false). +apply: (@gtr0_derive1_lt _ 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=> //. + rewrite derive1E. + apply: Df_gt0 => //. by rewrite (lt_eqF t1). - apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _. by case/idf=> ? /@ex_derive. @@ -1552,12 +1508,13 @@ 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). +apply: (@gtr0_derive1_lt _ 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). + rewrite derive1E. apply: Df_gt0=> //. by rewrite (gt_eqF t1). - apply: derivable_within_continuous => t /[!in_itv] /= /andP [] + _ => t1. @@ -1740,9 +1697,9 @@ have dfge0 y : y \in `]0, 1[ -> 0 <= df y. rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. rewrite !exprS expr0 mulr1 -!natrM mulnE /=. exact/with_interval.exp2_le8_conversion/with_interval.exp2_le8. -apply: (@ger0_derive1_homo R f 0 1 true false). +apply: (@ger0_derive1_le R f 0 1 _ _ true false). - by move=> y /y1oo /idf /@ex_derive. -- by move=> y /[dup] /y1oo /idf /@derive_val ->; exact: dfge0. +- by move=> y /[dup] /y1oo /idf /@derive_val; rewrite derive1E => ->; exact: dfge0. - by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. - by rewrite bound_itvE. - exact: subset_itv_oo_cc. From 1a7cd3f632839834a34e7fc9d23e5fbb00bd60a3 Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Fri, 20 Jun 2025 17:54:03 +0200 Subject: [PATCH 06/28] removed bigcup_mkord_ord --- theories/sampling.v | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 0c7c5e63c..09d8821ce 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -113,19 +113,6 @@ HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_displa '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). - -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. - Section fset. Local Open Scope fset_scope. Lemma fset_bool : forall B : {fset bool}, From 1fbff46bb6e752bf9a959f0bbd89765f07a3303b Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Sat, 21 Jun 2025 09:12:54 +0200 Subject: [PATCH 07/28] removed measurability of tuples --- theories/sampling.v | 54 +-------------------------------------------- 1 file changed, 1 insertion(+), 53 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 09d8821ce..51e25b8c3 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -256,38 +256,6 @@ apply/integrableP; split => //. by under eq_integral do rewrite abse_id. 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). - Lemma countable_range_bool d (T : measurableType d) (b : bool) : countable (range (@cst T _ b)). Proof. exact: countableP. Qed. @@ -298,27 +266,6 @@ HB.instance Definition _ d (T : measurableType d) 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 : 'I_n -> n.-tuple T -> T := fun i x => @tnth n T x i. - -Let tuple_set0 : g_sigma_preimage coors set0. -Proof. exact: sigma_algebra0. Qed. - -Let tuple_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). -Proof. exact: sigma_algebraC. Qed. - -Let tuple_bigcup (F : _^nat) : (forall i, g_sigma_preimage coors (F i)) -> - g_sigma_preimage coors (\bigcup_i (F i)). -Proof. exact: sigma_algebra_bigcup. Qed. - -HB.instance Definition _ := @isMeasurable.Build (measure_tuple_display d) - (n.-tuple T) (g_sigma_preimage coors) tuple_set0 tuple_setC tuple_bigcup. - -End measurable_tuple. - Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : measurable_fun [set: n.-tuple T] (@tnth _ T ^~ i). Proof. @@ -484,6 +431,7 @@ rewrite [X in measurable_fun _ X](_ : _ by apply: measurable_prod => /= i _; apply/measurableT_comp. Qed. +(* TODO: check this warning (and the entire section) *) 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). From 2947a5fdbc13302040d478e8f4f5317af4d16eeb Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 19:32:51 +0900 Subject: [PATCH 08/28] cleaning --- theories/sampling.v | 101 +++++++++++++++++++++----------------------- 1 file changed, 47 insertions(+), 54 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 51e25b8c3..d8fbf9975 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 _ := @@ -113,20 +113,18 @@ HB.instance Definition _ (n : nat) := @isMeasurable.Build default_measure_displa 'I_n.+1 discrete_measurable discrete_measurable0 discrete_measurableC discrete_measurableU. -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]. +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 fset. + +End move_to_bigop_nat_lemmas. Section integrable_theory. Local Open Scope ereal_scope. @@ -572,7 +570,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. @@ -1323,13 +1321,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 - mmt_gen_fun (\X_n P) X t <= (expR (fine 'E_(\X_n P)[X] * (expR t - 1)))%:E. + mmt_gen_fun (\X_n P) 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. @@ -1376,11 +1375,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. + 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. @@ -1421,7 +1422,7 @@ rewrite in_itv=> /andP [] x0 x1. fold (f x). simpl in idf. rewrite -f1E. -apply: (@gtr0_derive1_lt _ f 0 1 _ _ false false). +apply: (@gtr0_derive1_lt_oc _ f 0 1). - move=> t /[!in_itv] /= /andP [] + _. by case/idf=> ? /@ex_derive. - move=> t /[!in_itv] /= /andP [] t0 t1. @@ -1435,15 +1436,14 @@ apply: (@gtr0_derive1_lt _ f 0 1 _ _ false false). - assumption. Qed. -Let sqrxB2xlnx_gt1 (c x : R) : - 1 < x -> 1 < x ^+ 2 - 2 * x * ln x. +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_lt _ f 1 x _ _ true false). +apply: (@gtr0_derive1_lt_cc _ f 1 x). - move=> t /[!in_itv] /= /andP [] + _ => t1. have: 0 < t by rewrite (lt_trans _ t1). by case/idf=> ? /@ex_derive. @@ -1632,9 +1632,10 @@ have dfge0 y : y \in `]0, 1[ -> 0 <= df y. rewrite expRM/= powR_mulrn ?expR_ge0// lnK ?posrE//. rewrite !exprS expr0 mulr1 -!natrM mulnE /=. exact/with_interval.exp2_le8_conversion/with_interval.exp2_le8. -apply: (@ger0_derive1_le R f 0 1 _ _ true false). +apply: (@ger0_derive1_le_cc R f 0 1). - by move=> y /y1oo /idf /@ex_derive. -- by move=> y /[dup] /y1oo /idf /@derive_val; rewrite derive1E => ->; exact: dfge0. +- move=> y /[dup] /y1oo /idf /@derive_val. + by rewrite derive1E => ->; exact: dfge0. - by apply: derivable_within_continuous=> y /y1cc /idf /@ex_derive. - by rewrite bound_itvE. - exact: subset_itv_oo_cc. @@ -1685,9 +1686,11 @@ Corollary sampling_ineq4 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (\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 /=. +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. @@ -1696,32 +1699,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] *) @@ -1773,7 +1766,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//. @@ -1782,7 +1775,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 a693dbd46904419e154df488ab749ec8d12f4078 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 19:51:02 +0900 Subject: [PATCH 09/28] rm dup --- theories/sampling.v | 100 ++++---------------------------------------- 1 file changed, 9 insertions(+), 91 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index d8fbf9975..860adbb6d 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -137,6 +137,7 @@ 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 *) +(* NB: not used *) 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). @@ -261,21 +262,11 @@ 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. - -Lemma measurable_tnth d (T : measurableType d) n (i : 'I_n) : - measurable_fun [set: n.-tuple T] (@tnth _ T ^~ i). -Proof. -move=> _ Y mY; rewrite setTI; apply: sub_sigma_algebra => /=. -rewrite -bigcup_seq/=; exists i => //=; first by rewrite mem_index_enum. -by exists Y => //; rewrite setTI. -Qed. - Section measurable_cons. Context d d1 (T : measurableType d) (T1 : measurableType d1). -Lemma cons_measurable_funP (n : nat) (h : T -> n.-tuple T1) : +(* NB: not used anymore *) +Let 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. @@ -305,29 +296,6 @@ apply: (@iff_trans _ (g_sigma_preimage exact: mh. Qed. -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 n.+1.-tuple 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 : n.-tuple 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 measurable_cons. (* NB: not used *) @@ -353,47 +321,6 @@ have := @nth_ord_enum _ ord0 (Ordinal ti). by move=> ->. Qed. -Lemma measurable_behead d (T : measurableType d) n : - measurable_fun setT (fun x : n.+1.-tuple T => [tuple of behead x] : n.-tuple 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_comp. - 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 tuple_sum. Context d (T : measurableType d) (R : realType) (P : probability T R). @@ -813,26 +740,17 @@ case: p => [r|//|//]. by under eq_integral => x _ do rewrite abse_id. Qed. - -Lemma Lfun1_integrable (f : T -> R) : +Lemma Lfun1_integrable' (f : T -> R) : f \in Lfun mu 1 <-> mu.-integrable setT (EFin \o f). Proof. 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. + exact: Lfun1_integrable. move/integrableP => [mF iF]. rewrite inE; apply/andP; split; rewrite inE/=. exact/measurable_EFinP. by rewrite /finite_norm Lnorm1. Qed. - End move. Section move. @@ -883,7 +801,7 @@ rewrite expectation_sum/=. rewrite big_map big_enum/=. apply: eq_bigr => i i_n. rewrite unlock. - exact: integral_ipro_tnth. + exact: integral_ipro_tnth. move=> Xi /tnthP[i] ->. pose j := cast_ord (card_ord _) i. rewrite /image_tuple tnth_map. @@ -988,7 +906,7 @@ pose build_mF := isMeasurableFun.Build _ _ _ _ F mF. pose MF : {mfun _ >-> _} := HB.pack F build_mF. 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/Lfun1_integrable'/integrableP => /=; split. apply: measurableT_comp => //. exact: measurable_tuple_prod. under eq_integral => x _ do rewrite -abse_EFin. @@ -1255,8 +1173,8 @@ transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ])%R. by rewrite /Tnth !tnth_map /mmtX/= tnth_ord_tuple. rewrite /mmtX. rewrite expectation_product; last first. -- move=> _ /mapP [/= i _ ->]. - apply/Lfun1_integrable. +- move=> _ /mapP [/= i _ ->]. + apply/Lfun1_integrable'. apply: (bounded_RV_integrable (expR `|t|)) => // t0. rewrite expR_ge0/= ler_expR/=. rewrite /bool_to_real/=. From 071657de0f1f37dc4548619ecb0489397455d1d5 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 24 Jun 2025 23:08:41 +0900 Subject: [PATCH 10/28] generalize integral_sum so that integrable_sum_ord becomes a consequence and integral_sum can be generalized from eqType to Type. --- theories/sampling.v | 61 +++++++++++++-------------------------------- 1 file changed, 18 insertions(+), 43 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 860adbb6d..3adbfa8db 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -129,68 +129,43 @@ End move_to_bigop_nat_lemmas. Section integrable_theory. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}). +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. +Notation mu_int := (integrable mu D). -(* TODO: clean, move near integrable_sum, refactor *) -(* NB: not used *) -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). +Lemma integrable_sum I (s : seq I) (P : pred I) (h : I -> T -> \bar R) : + (forall i, P i -> mu_int (h i)) -> + mu_int (fun x => \sum_(i <- s | P i) h 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. +elim: s => [_|i s ih hs]. + by under eq_fun do rewrite big_nil; exact: integrable0. +under eq_fun do rewrite big_cons. +have [Pi|Pi] := boolP (P i); last exact: ih. +by apply: integrableD => //; [exact: hs|exact: ih]. 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)). +Variables (I : Type) (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). +Lemma integral_sum (s : seq I) (P : pred I) : + \int[mu]_(x in D) (\sum_(k <- s | P k) f k x) = + \sum_(k <- s | P k) \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. + case: ifPn => Ph. + by apply: eq_integral => x xD; rewrite big_cons Ph. + by apply: eq_integral => x xD; rewrite big_cons (negbTE Ph). +by apply: integrable_sum => //. Qed. End integral_sum. From f15bf26846c7d8b27b9aa9e943042c8d9e446b9c Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 25 Jun 2025 00:25:16 +0900 Subject: [PATCH 11/28] renaming --- theories/sampling.v | 64 ++++++++------------------------------------- 1 file changed, 11 insertions(+), 53 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 3adbfa8db..59b238063 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -126,50 +126,6 @@ Qed. End move_to_bigop_nat_lemmas. -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). - -Notation mu_int := (integrable mu D). - -Lemma integrable_sum I (s : seq I) (P : pred I) (h : I -> T -> \bar R) : - (forall i, P i -> mu_int (h i)) -> - mu_int (fun x => \sum_(i <- s | P i) h i x). -Proof. -elim: s => [_|i s ih hs]. - by under eq_fun do rewrite big_nil; exact: integrable0. -under eq_fun do rewrite big_cons. -have [Pi|Pi] := boolP (P i); last exact: ih. -by apply: integrableD => //; [exact: hs|exact: ih]. -Qed. - -End integrable_theory. - -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 : Type) (f : I -> (T -> \bar R)). -Hypothesis intf : forall n, mu.-integrable D (f n). - -Lemma integral_sum (s : seq I) (P : pred I) : - \int[mu]_(x in D) (\sum_(k <- s | P k) f k x) = - \sum_(k <- s | P k) \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//. - case: ifPn => Ph. - by apply: eq_integral => x xD; rewrite big_cons Ph. - by apply: eq_integral => x xD; rewrite big_cons (negbTE Ph). -by apply: integrable_sum => //. -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) @@ -189,7 +145,7 @@ apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). Qed. Arguments bounded_RV_integrable {d T R P X} M. -Lemma fubini2' {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} +Lemma integral21_prod_meas2 {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 -> @@ -201,8 +157,9 @@ 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}) +Lemma integral12_prod_meas2 {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. @@ -220,7 +177,7 @@ Lemma integrable_prodP {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} (m1 \x^ m2)%E.-integrable [set: T1 * T2] f. Proof. move=> /integrableP[mf intf]; apply/integrableP; split => //. -rewrite -fubini2'//=. +rewrite -integral21_prod_meas2//=. rewrite fubini2//=. apply/integrableP; split => //. exact/measurableT_comp. @@ -660,11 +617,11 @@ case; case => [i0|i im]. exact/Lfun1_integrable/tnth_Lfun/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. + rewrite -integral12_prod_meas2 /fubini_F/=; last first. apply/integrable12ltyP => /=. apply: measurableT_comp => //=. exact: measurableT_comp. - under eq_integral => x _ do rewrite integral_cst//= probability_setT mule1. + 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 _. @@ -676,7 +633,7 @@ 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. +rewrite -integral21_prod_meas2 /fubini_G/=; last first. apply/integrable12ltyP => /=. apply: measurableT_comp => //=. apply: measurableT_comp => //=. @@ -800,7 +757,8 @@ Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) Proof. move=> /[dup]lX /sub_Lfun_mfun +/[dup]lY /sub_Lfun_mfun. rewrite !inE/= => mX mY. -rewrite unlock /expectation/=. rewrite /pro2. rewrite -fubini1'/=; last first. +rewrite unlock /expectation/=. rewrite /pro2. +rewrite -integral12_prod_meas2/=; last first. apply/integrable21ltyP. - apply/measurable_EFinP => //=. by apply: measurable_funM => //=; apply/measurableT_comp. @@ -956,7 +914,7 @@ have ? : \int[\X_n P]_x `|\prod_(i < n) tnth X (lift ord0 i) (tnth x i)|%:E < + congr (`| _ |%:E). apply: eq_bigr => i _. by rewrite {1}(tuple_eta X) tnthS. -rewrite -fubini1' /fubini_F/=; last first. +rewrite -integral12_prod_meas2 /fubini_F/=; last first. apply/integrable21ltyP => //=. apply: measurableT_comp => //. apply: measurable_funM => //=. From 0b25b9ed47073c9283d52d90a248045866df77b2 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 25 Jun 2025 01:26:21 +0900 Subject: [PATCH 12/28] rebase --- theories/sampling.v | 37 ++++++++++--------------------------- 1 file changed, 10 insertions(+), 27 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 59b238063..99c5e563f 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -75,21 +75,6 @@ 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)). -Proof. -rewrite !in_itv /= /Order.lteif !if_neg. -by rewrite gerBl gtrBl lerDl ltrDl lerBrDr ltrBrDr andbC. -Qed. - -(* 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}). @@ -145,6 +130,7 @@ apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst M)). Qed. Arguments bounded_RV_integrable {d T R P X} M. +(* PR in progress *) Lemma integral21_prod_meas2 {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) : @@ -157,6 +143,7 @@ apply: product_measure_unique => // B C mB mC/=. by rewrite product_measure2E. Qed. +(* PR in progress *) Lemma integral12_prod_meas2 {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) @@ -170,21 +157,17 @@ apply: product_measure_unique => // B C mB mC/=. by rewrite product_measure2E. Qed. -Lemma integrable_prodP {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} +Lemma integrable_prod_measP {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 <-> (m1 \x^ m2)%E.-integrable [set: T1 * T2] f. Proof. -move=> /integrableP[mf intf]; apply/integrableP; split => //. -rewrite -integral21_prod_meas2//=. - 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. +split => /integrableP[mf intf]; apply/integrableP; split => //. +- rewrite (eq_measure_integral (m1 \x m2)%E)//= => C mC _. + by apply/esym/product_measure_unique => //= *; rewrite product_measure2E. +- rewrite (eq_measure_integral (m1 \x^ m2)%E)//= => C mC _. + by apply: product_measure_unique => //= *; rewrite product_measure2E. Qed. Lemma countable_range_bool d (T : measurableType d) (b : bool) : @@ -464,7 +447,7 @@ rewrite -(@integral_pushforward _ _ _ _ R _ (@mphi n) _ setT congr pair. exact/val_inj. rewrite /=. -apply/integrable_prodP. +apply/integrable_prod_measP. rewrite /=. apply/integrableP; split => /=. apply: measurableT_comp => //=. From cf458def2dc702dc2f1957158e8a18dcf44b5269 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 26 Jun 2025 11:56:21 +0900 Subject: [PATCH 13/28] rm dead code, cleaning, rebase --- theories/sampling.v | 356 ++++++++++++++------------------------------ 1 file changed, 111 insertions(+), 245 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 99c5e563f..60135e091 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -1,4 +1,4 @@ -(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From 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. @@ -31,10 +31,6 @@ Unset Printing Implicit Defensive. (* 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 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. *) @@ -75,60 +71,8 @@ Import hoelder ess_sup_inf. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -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. -by apply: measurableT_comp => //=; exact: (@measurable_funPT _ _ _ _ f). -Qed. - -HB.instance Definition _ := - isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. - -HB.instance Definition _ := MeasurableFun.on bool_to_real. - -End bool_to_real. - -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). - -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. - -(* 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. +Reserved Notation "\X_ n P" (at level 10, n, P at next level, + format "\X_ n P"). (* PR in progress *) Lemma integral21_prod_meas2 {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} @@ -170,70 +114,41 @@ split => /integrableP[mf intf]; apply/integrableP; split => //. by apply: product_measure_unique => //= *; rewrite product_measure2E. Qed. -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). +Lemma integral_prod_meas1E {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^ m2]_x f x = \int[(m1 \x m2)%E]_z f z)%E. +Proof. by move=> intf; rewrite -fubini1// integral12_prod_meas2. Qed. -Section measurable_cons. -Context d d1 (T : measurableType d) (T1 : measurableType d1). +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). -(* NB: not used anymore *) -Let 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). +Lemma measurable_bool_to_real : measurable_fun [set: T] bool_to_real. 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. +by apply: measurableT_comp => //=; exact: (@measurable_funPT _ _ _ _ f). Qed. -End measurable_cons. +HB.instance Definition _ := + isMeasurableFun.Build _ _ _ _ bool_to_real measurable_bool_to_real. + +End bool_to_real. -(* NB: not used *) -Lemma behead_mktuple n {T : eqType} (t : n.+1.-tuple T) : - behead t = [tuple (tnth t (lift ord0 i)) | i < n]. +Lemma bounded_integrable d (T : measurableType d) (R : realType) + (P : {finite_measure set T -> \bar R}) (X : T -> R) : + measurable_fun setT X -> + bounded_fun X -> P.-integrable [set: T] (EFin \o X). 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=> ->. +move=> mf [M [Mreal HM]]. +apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst (M + 1))). +- exact/measurable_EFinP. +- move=> t _ /=; rewrite lee_fin/=. + apply: HM => //=. + by rewrite (lt_le_trans _ (ler_norm _))// ltrDl. +- exact: finite_measure_integrable_cst. Qed. Section tuple_sum. @@ -249,8 +164,8 @@ 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 measurable_sum_Tnth n (X : n.-tuple {mfun T >-> R}) : + measurable_fun [set: n.-tuple T] (\sum_(i < n) Tnth X i). Proof. rewrite [X in measurable_fun _ X](_ : _ = (fun x => \sum_(i < n) Tnth X i x)); last first. @@ -260,10 +175,10 @@ 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). + isMeasurableFun.Build _ _ _ _ (\sum_(i < n) Tnth s i) (measurable_sum_Tnth 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. +Lemma measurable_prod_Tnth m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) : + measurable_fun [set: m.-tuple T] (\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. @@ -271,50 +186,16 @@ rewrite [X in measurable_fun _ X](_ : _ by apply: measurable_prod => /= i _; apply/measurableT_comp. Qed. -(* TODO: check this warning (and the entire section) *) 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). + isMeasurableFun.Build _ _ _ _ (\prod_(i < n) Tnth s (f i)) + (measurable_prod_Tnth 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 := (P1 \x P2)%E. - -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 := (P1 \x^ P2)%E. - -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 iterated_product_finite_measures. +Context d (T : measurableType d) (R : realType) (P : {finite_measure set T -> \bar R}). -Section iterated_product_of_probability_measures. -Context d (T : measurableType d) (R : realType) (P : probability T R). - -Fixpoint ipro (n : nat) : set (n.-tuple T) -> \bar R := +Fixpoint ipro n : set (n.-tuple T) -> \bar R := match n with | 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] @@ -345,15 +226,15 @@ apply: measure_semi_sigma_additive. 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'/=. - by rewrite (tuple_eta t) in Fit. - exists (f' (x1, x2)) => //. - rewrite /f' /= theadE//; congr pair. - exact/val_inj. + 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. exact: measurable_cons. -- (* TODO: lemma? *) +- (* NB: lemma? *) apply/trivIsetP => i j _ _ ij. move/trivIsetP : dF => /(_ i j Logic.I Logic.I ij). rewrite -!subset0 => ij0 /= [_ _] [[t Fit] [<- <-]]/=. @@ -367,9 +248,17 @@ apply: measure_semi_sigma_additive. Qed. HB.instance Definition _ n := isMeasure.Build _ _ _ (@ipro n) - (@ipro_measure n).1 (@ipro_measure n).2.1 (@ipro_measure n).2.2. + (ipro_measure n).1 (ipro_measure n).2.1 (ipro_measure n).2.2. + +End iterated_product_finite_measures. +Arguments ipro {d T R} P n. + +Notation "\X_ n P" := (ipro P n). + +Section iterated_product_probability_measures. +Context d (T : measurableType d) (R : realType) (P : probability T R). -Lemma ipro_setT n : @ipro n setT = 1%E. +Lemma ipro_setT n : \X_n P [set: n.-tuple T] = 1%E. Proof. elim: n => [|n ih]/=; first by rewrite diracT. rewrite /product_measure2 /ysection/=. @@ -377,11 +266,9 @@ 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. + apply: funext => z/=; apply: propT. exists (z.1 :: z.2) => //=. - case: z => z1 z2/=. - congr pair. + case: z => z1 z2/=; congr pair. exact/val_inj. over. by apply: funext => y /=; rewrite in_setT trueE. @@ -391,24 +278,20 @@ by rewrite integral_cst// mul1e. Qed. HB.instance Definition _ n := - Measure_isProbability.Build _ _ _ (@ipro n) (@ipro_setT n). - -End iterated_product_of_probability_measures. -Arguments ipro {d T R} P n. + Measure_isProbability.Build _ _ _ (\X_n P) (@ipro_setT n). -Notation "\X_ n P" := (ipro P n) (at level 10, n, P at next level, - format "\X_ n P"). +End iterated_product_probability_measures. Section integral_ipro. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Definition phi n := fun w : T * n.-tuple T => [the _.-tuple _ of w.1 :: w.2]. +Definition phi n (w : T * n.-tuple T) := [the _.-tuple _ of w.1 :: w.2]. Lemma mphi n : measurable_fun [set: T * n.-tuple T] (@phi n). Proof. exact: measurable_cons. Qed. -Definition psi n := fun w : n.+1.-tuple T => (thead w, [the _.-tuple _ of behead w]). +Definition psi n (w : n.+1.-tuple T) := (thead w, [the _.-tuple _ of behead w]). Lemma mpsi n : measurable_fun [set: _.-tuple _] (@psi n). Proof. @@ -424,10 +307,34 @@ Qed. Let psiK n : cancel (@psi n) (@phi n). Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. -Lemma integral_ipro n (f : n.+1.-tuple T -> R) : +Lemma ge0_integral_ipro n (f : n.+1.-tuple T -> R) : + measurable_fun [set: n.+1.-tuple T] f -> (forall x, 0 <= f x)%R -> + \int[\X_n.+1 P]_w (f w)%:E = \int[P \x^ (\X_n P)]_w (f (w.1 :: w.2))%:E. +Proof. +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 _. + rewrite /=. + rewrite /pushforward. + 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 integral_iproS 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. + \int[P \x^ (\X_n P)]_w (f (w.1 :: w.2))%:E. Proof. move=> /integrableP[mf intf]. rewrite -(@integral_pushforward _ _ _ _ R _ (@mphi n) _ setT @@ -435,7 +342,6 @@ rewrite -(@integral_pushforward _ _ _ _ R _ (@mphi n) _ setT apply: eq_measure_integral => A mA _. rewrite /=. rewrite /pushforward. - rewrite /pro2. rewrite /phi/=. rewrite /preimage/=. congr (_ _). @@ -473,10 +379,8 @@ rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (@mpsi n) _ setT exact/val_inj. congr pair => //. exact/val_inj. -- apply/measurable_EFinP => //=. - apply: measurableT_comp => //=. - apply: measurableT_comp => //=. - exact/measurable_EFinP. +- apply/measurable_EFinP => //=; apply: measurableT_comp => //=. + apply: measurableT_comp => //=; first exact/measurable_EFinP. exact: mphi. - have : (\X_n.+1 P).-integrable [set: n.+1.-tuple T] (EFin \o f). exact/integrableP. @@ -490,30 +394,6 @@ rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (@mpsi n) _ setT by rewrite normr_id// psiK. Qed. -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=> 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 _. - 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 -> @@ -596,7 +476,7 @@ 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. + rewrite [LHS](@integral_iproS m (Tnth F (Ordinal i0))); last first. exact/Lfun1_integrable/tnth_Lfun/lfunFi/mem_tnth. under eq_fun => x do rewrite /Tnth (_ : tnth (_ :: _) _ = tnth [tuple of x.1 :: x.2] ord0)// tnth0. @@ -609,7 +489,7 @@ case; case => [i0|i im]. 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. +rewrite [LHS](@integral_iproS m (Tnth F (Ordinal im))); last first. exact/Lfun1_integrable/tnth_Lfun/lfunFi/mem_tnth. have jm : (i < m)%nat by rewrite ltnS in im. have liftjm : Ordinal im = lift ord0 (Ordinal jm). @@ -645,8 +525,7 @@ Variable mu : {measure set T -> \bar R}. Local Open Scope ereal_scope. Implicit Types (p : \bar R) (f g : T -> \bar R) (r : R). -Lemma Lnorm_abse f p : - 'N[mu]_p[abse \o f] = 'N[mu]_p[f]. +Lemma Lnorm_abse f p : 'N[mu]_p[abse \o f] = 'N[mu]_p[f]. Proof. rewrite unlock/=. have -> : (abse \o (abse \o f)) = abse \o f. @@ -655,17 +534,6 @@ case: p => [r|//|//]. by under eq_integral => x _ do rewrite abse_id. Qed. -Lemma Lfun1_integrable' (f : T -> R) : - f \in Lfun mu 1 <-> mu.-integrable setT (EFin \o f). -Proof. -split. - exact: Lfun1_integrable. -move/integrableP => [mF iF]. -rewrite inE; apply/andP; split; rewrite inE/=. - exact/measurable_EFinP. -by rewrite /finite_norm Lnorm1. -Qed. - End move. Section move. @@ -736,11 +604,11 @@ Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (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]. + 'E_(P1 \x^ P2)[XY] = 'E_P1[X] * 'E_P2[Y]. Proof. move=> /[dup]lX /sub_Lfun_mfun +/[dup]lY /sub_Lfun_mfun. rewrite !inE/= => mX mY. -rewrite unlock /expectation/=. rewrite /pro2. +rewrite unlock /expectation/=. rewrite -integral12_prod_meas2/=; last first. apply/integrable21ltyP. - apply/measurable_EFinP => //=. @@ -808,7 +676,7 @@ move=> x1 x2 ? ? <- <-. by rewrite abseM. Qed. -Lemma expectation_product n (X : n.-tuple {RV P >-> R}) : +Lemma expectation_ipro 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. @@ -817,36 +685,36 @@ elim: n X => [X|n IH X] lfunX/=. 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. +have mF : measurable_fun setT F by apply: measurable_prod_Tnth. pose build_mF := isMeasurableFun.Build _ _ _ _ F mF. pose MF : {mfun _ >-> _} := HB.pack F build_mF. 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/Lfun1_integrable/integrableP => /=; split. apply: measurableT_comp => //. - exact: measurable_tuple_prod. + exact: measurable_prod_Tnth. under eq_integral => x _ do rewrite -abse_EFin. apply/abse_integralP => //=. apply: measurableT_comp => //. - exact: measurable_tuple_prod. + exact: measurable_prod_Tnth. have := IH (behead_tuple X). rewrite unlock /= => ->; last by move => x /mem_behead/lfunX. rewrite abse_prod -ge0_fin_numE ?prode_ge0// prode_fin_num// => i _. rewrite abse_fin_num integral_fune_fin_num//. exact/Lfun1_integrable/lfunX/mem_behead/mem_tnth. -rewrite [LHS](@integral_ipro _ _ _ _ _ MF) /pro2; last first. +rewrite [LHS](@integral_iproS _ _ _ _ _ MF); last first. rewrite /MF/F; apply/integrableP; split. exact: measurableT_comp. - rewrite integral_ipro_ge0/=; last 2 first. + rewrite ge0_integral_ipro/=; 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. + rewrite [ltLHS](_ : _ = \int[P \x^ (\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 meas_tuple_prod := measurable_prod_Tnth (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. @@ -899,8 +767,7 @@ have ? : \int[\X_n P]_x `|\prod_(i < n) tnth X (lift ord0 i) (tnth x i)|%:E < + by rewrite {1}(tuple_eta X) tnthS. rewrite -integral12_prod_meas2 /fubini_F/=; last first. apply/integrable21ltyP => //=. - apply: measurableT_comp => //. - apply: measurable_funM => //=. + apply: measurableT_comp => //=; apply: measurable_funM => //=. exact: measurableT_comp. apply: measurable_prod => //= i i_n. apply: measurableT_comp => //. @@ -1088,17 +955,16 @@ 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_product; last first. +rewrite expectation_ipro; last first. - move=> _ /mapP [/= i _ ->]. - apply/Lfun1_integrable'. - apply: (bounded_RV_integrable (expR `|t|)) => // t0. - rewrite expR_ge0/= ler_expR/=. + apply/Lfun1_integrable/bounded_integrable => //. + exists (expR `|t|); split => // M etM x _ /=. + rewrite ger0_norm// (le_trans _ (ltW etM))// ler_expR/=. rewrite /bool_to_real/=. - case: (tnth X_ i t0) => //=; rewrite ?mul1r ?mul0r//. + case: (tnth X_ i x) => //=; rewrite ?mul1r ?mul0r//. by rewrite ler_norm. apply: eq_bigr => /= i _. congr expectation. -rewrite /=. by rewrite tnth_map/= tnth_ord_tuple. Qed. From 64d49d827ecb60bb301ee309e68822605ed14def Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 26 Jun 2025 19:47:43 +0900 Subject: [PATCH 14/28] tuple_of_pair --- theories/sampling.v | 326 ++++++++++++++++++++------------------------ 1 file changed, 148 insertions(+), 178 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 60135e091..58d4c0474 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -32,10 +32,6 @@ Unset Printing Implicit Defensive. (* *) (* ## Construction of the product probability measure *) (* 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 *) @@ -151,7 +147,7 @@ apply: (@le_integrable _ T R _ _ measurableT _ (EFin \o cst (M + 1))). - exact: finite_measure_integrable_cst. Qed. -Section tuple_sum. +Section Tnth. 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 := @@ -190,18 +186,96 @@ 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)) (measurable_prod_Tnth s f). -End tuple_sum. +End Tnth. + +Section tuple_of_pair. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Definition tuple_of_pair n (w : T * n.-tuple T) := + [the _.-tuple _ of w.1 :: w.2]. + +Lemma measurable_tuple_of_pair n : + measurable_fun [set: T * n.-tuple T] (@tuple_of_pair n). +Proof. exact: measurable_cons. Qed. + +Definition pair_of_tuple n (w : n.+1.-tuple T) := + (thead w, [the _.-tuple _ of behead w]). + +Lemma measurable_pair_of_tuple n : + measurable_fun [set: _.-tuple _] (@pair_of_tuple n). +Proof. +by apply/measurable_fun_pair => /=; + [exact: measurable_tnth|exact: measurable_behead]. +Qed. + +Lemma trivIset_pair_of_tuple n (F : nat -> set (n.+1.-tuple T)) : + trivIset [set: nat] F -> + trivIset [set: nat] (fun m => @pair_of_tuple n @` F m). +Proof. +move=> tF; apply/trivIsetP => i j _ _ ij. +move/trivIsetP : tF => /(_ 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. +Qed. + +Lemma pair_of_tupleK n : cancel (@tuple_of_pair n) (@pair_of_tuple n). +Proof. +move=> [x1 x2]; rewrite /pair_of_tuple /tuple_of_pair/=; congr pair => /=. +exact/val_inj. +Qed. + +Lemma tuple_of_pairK n : cancel (@pair_of_tuple n) (@tuple_of_pair n). +Proof. by move=> x; rewrite /pair_of_tuple /tuple_of_pair/= [RHS]tuple_eta. Qed. + +Lemma thead_behead_preimage n (A : set (n.+1.-tuple T)) : + @pair_of_tuple n @` A = @tuple_of_pair n @^-1` A. +Proof. + apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. + by move: At; rewrite {1}(tuple_eta t). +exists (x.1 :: x.2) => //=. +by rewrite [RHS]surjective_pairing; congr pair; exact/val_inj. +Qed. + +Lemma measurable_image_pair_of_tuple n (A : set (n.+1.-tuple T)) : + measurable A -> measurable (@pair_of_tuple n @` A). +Proof. +move=> mA. +rewrite [X in measurable X](_ : _ = @tuple_of_pair n @^-1` A); last first. + by rewrite thead_behead_preimage. +by rewrite -[X in measurable X]setTI; exact: measurable_cons. +Qed. + +Lemma thead_behead_preimage' n (A : set (T * n.-tuple T)) : + @pair_of_tuple n @` (@pair_of_tuple n @^-1` A) = A. +Proof. +apply/seteqP; split => [[x1 x2]/= [t At] [<- <-//]|]. +move=> [x1 x2] Ax1x2/=. +exists (x1 :: x2) => //=. + rewrite /pair_of_tuple/= theadE/= [X in A (_, X)](_ : _ = x2)//. + exact/val_inj. +by congr pair => //; exact/val_inj. +Qed. + +End tuple_of_pair. +Arguments pair_of_tuple {d T} n. +Arguments tuple_of_pair {d T} n. Section iterated_product_finite_measures. -Context d (T : measurableType d) (R : realType) (P : {finite_measure set T -> \bar R}). +Context d (T : measurableType d) (R : realType) + (P : {finite_measure set T -> \bar R}). Fixpoint ipro n : set (n.-tuple T) -> \bar R := match n with | 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] + | m.+1 => fun A => (P \x^ @ipro m)%E (pair_of_tuple m @` A) end. -Lemma ipro_measure n : @ipro n set0 = 0 /\ (forall A, 0 <= @ipro n A)%E +Let ipro_measure n : @ipro n set0 = 0 /\ (forall A, 0 <= @ipro n A)%E /\ semi_sigma_additive (@ipro n). Proof. elim: n => //= [|n ih]. @@ -217,34 +291,10 @@ split. 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 _.-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'/=. - 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. - exact: measurable_cons. -- (* NB: 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. +rewrite image_bigcup; apply: measure_semi_sigma_additive. +- by move=> i ; apply: measurable_image_pair_of_tuple. +- exact: trivIset_pair_of_tuple. +- by apply: bigcup_measurable => j _; apply: measurable_image_pair_of_tuple. Qed. HB.instance Definition _ n := isMeasure.Build _ _ _ (@ipro n) @@ -283,174 +333,94 @@ HB.instance Definition _ n := End iterated_product_probability_measures. Section integral_ipro. -Context d (T : measurableType d) (R : realType) (P : probability T R). -Local Open Scope ereal_scope. - -Definition phi n (w : T * n.-tuple T) := [the _.-tuple _ of w.1 :: w.2]. - -Lemma mphi n : measurable_fun [set: T * n.-tuple T] (@phi n). -Proof. exact: measurable_cons. Qed. - -Definition psi n (w : n.+1.-tuple T) := (thead w, [the _.-tuple _ of behead w]). - -Lemma mpsi n : measurable_fun [set: _.-tuple _] (@psi n). -Proof. -by apply/measurable_fun_pair => /=; - [exact: measurable_tnth|exact: measurable_behead]. -Qed. - -Lemma phiK n : cancel (@phi n) (@psi n). -Proof. -by move=> [x1 x2]; rewrite /psi /phi/=; congr pair => /=; exact/val_inj. -Qed. -Let psiK n : cancel (@psi n) (@phi n). -Proof. by move=> x; rewrite /psi /phi/= [RHS]tuple_eta. Qed. - -Lemma ge0_integral_ipro n (f : n.+1.-tuple T -> R) : +Lemma ge0_integral_iproS n (f : n.+1.-tuple T -> R) : measurable_fun [set: n.+1.-tuple T] f -> (forall x, 0 <= f x)%R -> - \int[\X_n.+1 P]_w (f w)%:E = \int[P \x^ (\X_n P)]_w (f (w.1 :: w.2))%:E. + \int[\X_n.+1 P]_w (f w)%:E = \int[P \x^ \X_n P]_w (f (w.1 :: w.2))%:E. Proof. 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 _. - rewrite /=. - rewrite /pushforward. - 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. + (fun x : n.+1.-tuple T => (f x)%:E)). +- apply: eq_measure_integral => A mA _ /=. + by rewrite /pushforward /phi/= thead_behead_preimage. +- exact: measurableT. +- exact: measurableT_comp. +- by move=> x/= _; rewrite lee_fin. Qed. Lemma integral_iproS 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[P \x^ (\X_n P)]_w (f (w.1 :: w.2))%:E. + \int[\X_n.+1 P]_w (f w)%:E = \int[P \x^ \X_n P]_w (f (w.1 :: w.2))%:E. Proof. move=> /integrableP[mf intf]. 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 /=. - rewrite /pushforward. - 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_prod_measP. -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 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 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/=. - 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 => //=; first 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. + (fun x : n.+1.-tuple T => (f x)%:E)). +- apply: eq_measure_integral => A mA _ /=. + by rewrite /pushforward /phi/= thead_behead_preimage. +- exact: mf. +- rewrite /=. + apply/integrable_prod_measP => /=. + apply/integrableP; split => /=. + by 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 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 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/= -product_measure2E//; congr (_ _). + exact: thead_behead_preimage'. + - apply/measurable_EFinP => //=; apply: measurableT_comp => //=. + by 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 => //=. + by apply: measurableT_comp => //=; [exact/measurable_EFinP|exact: mphi]. + + by move=> x _; rewrite normr_id// psiK. +- exact: measurableT. Qed. - -Lemma ipro_tnth n A i: - d.-measurable A -> - (\X_n P) ((tnth (T:=T))^~ i @^-1` A) = P A. +Lemma ipro_tnth n A i: d.-measurable A -> + (\X_n P) ((@tnth n 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 /=; congr (_ _). + by rewrite thead_behead_preimage// setXT. 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]. +- have mn' : (m < n)%N by rewrite -ltnS. + transitivity ((P \x^ \X_n P) (setT `*` ((@tnth _ T)^~ (Ordinal mn') @^-1` A))). + rewrite /=; congr (_ _). + rewrite thead_behead_preimage//= setTX/=. + apply: funext => -[x1 x2]//=. + rewrite /phi/=. rewrite (_ : Ordinal mn = lift ord0 (Ordinal mn'))//=; last first. - apply: val_inj => /=. - by rewrite /bump//=. + exact: val_inj. 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. + 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. +Lemma integral_ipro_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). +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. +- by move=> y _/=; rewrite lee_fin normr_ge0. Qed. Lemma tnth_Lfun n (F : n.-tuple {mfun T >-> R}) i : @@ -465,10 +435,10 @@ move=> mF iF; apply/andP; rewrite !inE/=; split. exact: measurable_tnth. rewrite /finite_norm unlock /Lnorm/= invr1 poweRe1 ?integral_ge0//. under eq_integral => x _ do rewrite powRr1//. -by rewrite (integral_tnth (tnth F i)). +by rewrite (integral_ipro_tnth (tnth F i)). Qed. -Lemma integral_ipro_tnth n (F : n.-tuple {mfun T >-> R}) : +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. @@ -584,7 +554,7 @@ rewrite expectation_sum/=. rewrite big_map big_enum/=. apply: eq_bigr => i i_n. rewrite unlock. - exact: integral_ipro_tnth. + exact: integral_ipro_Tnth. move=> Xi /tnthP[i] ->. pose j := cast_ord (card_ord _) i. rewrite /image_tuple tnth_map. @@ -705,7 +675,7 @@ have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in Lfun (\X_n P) 1. rewrite [LHS](@integral_iproS _ _ _ _ _ MF); last first. rewrite /MF/F; apply/integrableP; split. exact: measurableT_comp. - rewrite ge0_integral_ipro/=; last 2 first. + rewrite ge0_integral_iproS/=; last 2 first. - exact: measurableT_comp. - by []. rewrite [ltLHS](_ : _ = \int[P \x^ (\X_n P)]_x (`|thead X x.1| * `|(\prod_(i < n) Tnth (behead_tuple X) i) x.2|)%:E); last first. From ff9e066bec3a94a5624194bea83a3dc3eceae89f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 26 Jun 2025 23:20:10 +0900 Subject: [PATCH 15/28] cleaning --- theories/sampling.v | 505 +++++++++++++++++++++----------------------- 1 file changed, 246 insertions(+), 259 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 58d4c0474..39d5511d1 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -70,6 +70,17 @@ Local Open Scope ring_scope. Reserved Notation "\X_ n P" (at level 10, n, P at next level, format "\X_ n P"). +(* NB: also in Jairo's PR about lne *) +Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). +Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. + +(* TODO: put back in probability.v *) +Notation "'M_ X t" := (mmt_gen_fun X t). + +Lemma preimage_set1 T {U : eqType} (X : T -> U) r : + X @^-1` [set r] = [set i | X i == r]. +Proof. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. + (* PR in progress *) Lemma integral21_prod_meas2 {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) @@ -97,6 +108,7 @@ apply: product_measure_unique => // B C mB mC/=. by rewrite product_measure2E. Qed. +(* PR in progress *) Lemma integrable_prod_measP {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) : @@ -110,6 +122,7 @@ split => /integrableP[mf intf]; apply/integrableP; split => //. by apply: product_measure_unique => //= *; rewrite product_measure2E. Qed. +(* PR in progress *) Lemma integral_prod_meas1E {d1} {T1 : measurableType d1} {d2} {T2 : measurableType d2} {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) @@ -118,6 +131,57 @@ Lemma integral_prod_meas1E {d1} {T1 : measurableType d1} (\int[m1 \x^ m2]_x f x = \int[(m1 \x m2)%E]_z f z)%E. Proof. by move=> intf; rewrite -fubini1// integral12_prod_meas2. Qed. +Section PR_to_hoelder. +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 -> \bar R) (r : R). + +Lemma Lnorm_abse f p : 'N[mu]_p[abse \o f] = 'N[mu]_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 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 PR_to_hoelder. + +Section PR_to_hoelder. +Context d (T : measurableType d) (R : realType). +Variable mu : {finite_measure set T -> \bar R}. +Local Open Scope ereal_scope. + +Lemma Lfun_bounded (f : T -> R) p : 1 <= p -> + measurable_fun [set: T] f -> bounded_fun f -> f \in Lfun mu p. +Proof. +move=> p1 mX bX. +apply: (Lfun_subset p1 (leey _)). +- by rewrite fin_num_measure. +- by rewrite leey. +rewrite inE/=; apply/andP; split; rewrite inE//=. +rewrite /finite_norm unlock. +case: ifPn => P0//. +case: bX => M [Mreal bX]. +apply: (@le_lt_trans _ _ (M + 1)%:E). + by rewrite ess_sup_ler// => t; apply: bX => //; rewrite ltrDl. +by rewrite ltry. +Qed. + +End PR_to_hoelder. + Section bool_to_real. Context d (T : measurableType d) (R : realType) (P : probability T R) (f : {mfun T >-> bool}). @@ -192,13 +256,6 @@ Section tuple_of_pair. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Definition tuple_of_pair n (w : T * n.-tuple T) := - [the _.-tuple _ of w.1 :: w.2]. - -Lemma measurable_tuple_of_pair n : - measurable_fun [set: T * n.-tuple T] (@tuple_of_pair n). -Proof. exact: measurable_cons. Qed. - Definition pair_of_tuple n (w : n.+1.-tuple T) := (thead w, [the _.-tuple _ of behead w]). @@ -223,6 +280,20 @@ rewrite (tuple_eta t) (tuple_eta u) hut. by apply/val_inj => /=; rewrite tut. Qed. +Lemma range_pair_of_tuple n : + range (pair_of_tuple (n:=n)) = [set: T * n.-tuple T]. +Proof. +rewrite -subTset => -[x y] _; exists (x :: y) => //=. +by rewrite /pair_of_tuple/= theadE//; congr pair; exact/val_inj. +Qed. + +Definition tuple_of_pair n (w : T * n.-tuple T) := + [the _.-tuple _ of w.1 :: w.2]. + +Lemma measurable_tuple_of_pair n : + measurable_fun [set: T * n.-tuple T] (@tuple_of_pair n). +Proof. exact: measurable_cons. Qed. + Lemma pair_of_tupleK n : cancel (@tuple_of_pair n) (@pair_of_tuple n). Proof. move=> [x1 x2]; rewrite /pair_of_tuple /tuple_of_pair/=; congr pair => /=. @@ -232,7 +303,7 @@ Qed. Lemma tuple_of_pairK n : cancel (@pair_of_tuple n) (@tuple_of_pair n). Proof. by move=> x; rewrite /pair_of_tuple /tuple_of_pair/= [RHS]tuple_eta. Qed. -Lemma thead_behead_preimage n (A : set (n.+1.-tuple T)) : +Lemma image_pair_of_tuple n (A : set (n.+1.-tuple T)) : @pair_of_tuple n @` A = @tuple_of_pair n @^-1` A. Proof. apply/seteqP; split => [x/= [t At <-/=]|x/= Ax]. @@ -242,28 +313,17 @@ by rewrite [RHS]surjective_pairing; congr pair; exact/val_inj. Qed. Lemma measurable_image_pair_of_tuple n (A : set (n.+1.-tuple T)) : - measurable A -> measurable (@pair_of_tuple n @` A). + measurable A -> measurable (@pair_of_tuple n @` A). Proof. -move=> mA. -rewrite [X in measurable X](_ : _ = @tuple_of_pair n @^-1` A); last first. - by rewrite thead_behead_preimage. +move=> mA; rewrite image_pair_of_tuple. by rewrite -[X in measurable X]setTI; exact: measurable_cons. Qed. -Lemma thead_behead_preimage' n (A : set (T * n.-tuple T)) : - @pair_of_tuple n @` (@pair_of_tuple n @^-1` A) = A. -Proof. -apply/seteqP; split => [[x1 x2]/= [t At] [<- <-//]|]. -move=> [x1 x2] Ax1x2/=. -exists (x1 :: x2) => //=. - rewrite /pair_of_tuple/= theadE/= [X in A (_, X)](_ : _ = x2)//. - exact/val_inj. -by congr pair => //; exact/val_inj. -Qed. - End tuple_of_pair. Arguments pair_of_tuple {d T} n. Arguments tuple_of_pair {d T} n. +Arguments measurable_tuple_of_pair {d T} n. +Arguments measurable_pair_of_tuple {d T} n. Section iterated_product_finite_measures. Context d (T : measurableType d) (R : realType) @@ -333,98 +393,98 @@ HB.instance Definition _ n := End iterated_product_probability_measures. Section integral_ipro. +Context d (T : measurableType d) (R : realType). +Local Open Scope ereal_scope. -Lemma ge0_integral_iproS n (f : n.+1.-tuple T -> R) : - measurable_fun [set: n.+1.-tuple T] f -> (forall x, 0 <= f x)%R -> +Lemma ge0_integral_iproS (P : {finite_measure set T -> \bar R}) + n (f : n.+1.-tuple T -> R) : + measurable_fun [set: n.+1.-tuple T] f -> + (forall x, 0 <= f x)%R -> \int[\X_n.+1 P]_w (f w)%:E = \int[P \x^ \X_n P]_w (f (w.1 :: w.2))%:E. Proof. move=> mf f0. -rewrite -(@ge0_integral_pushforward _ _ _ _ R _ (@mphi n) _ setT - (fun x : n.+1.-tuple T => (f x)%:E)). -- apply: eq_measure_integral => A mA _ /=. - by rewrite /pushforward /phi/= thead_behead_preimage. +rewrite -(@ge0_integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ + setT (fun x : n.+1.-tuple T => (f x)%:E)). +- by apply: eq_measure_integral => A mA _ /=; rewrite image_pair_of_tuple. - exact: measurableT. - exact: measurableT_comp. - by move=> x/= _; rewrite lee_fin. Qed. -Lemma integral_iproS n (f : n.+1.-tuple T -> R) : - (\X_n.+1 P).-integrable [set: n.+1.-tuple T] (EFin \o f) -> +Lemma ipro_tnth n A i (P : probability T R) : d.-measurable A -> + (\X_n P) ((@tnth n T)^~ i @^-1` A) = P A. +Proof. +elim: n A i => [A [] []//|n ih A [] [i0|m mn mA]]. +- transitivity ((P \x^ \X_n P) (A `*` [set: n.-tuple T])). + by rewrite /= image_pair_of_tuple setXT. + 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) + (setT `*` ((@tnth _ T) ^~ (Ordinal mn') @^-1` A))). + rewrite /= image_pair_of_tuple//= setTX/=; congr (_ _). + rewrite (_ : Ordinal mn = lift ord0 (Ordinal mn'))//=; last first. + exact: val_inj. + by apply: funext => -[x1 x2]//=; rewrite tnthS. + rewrite product_measure2E//=; first by rewrite probability_setT mul1e ih. + by rewrite -[X in measurable X]setTI; exact: measurable_tnth. +Qed. + +Lemma integral_iproS (P : probability T R) + 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[P \x^ \X_n P]_w (f (w.1 :: w.2))%:E. Proof. move=> /integrableP[mf intf]. -rewrite -(@integral_pushforward _ _ _ _ R _ (@mphi n) _ setT - (fun x : n.+1.-tuple T => (f x)%:E)). +rewrite -(@integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ + setT (fun x : n.+1.-tuple T => (f x)%:E)). - apply: eq_measure_integral => A mA _ /=. - by rewrite /pushforward /phi/= thead_behead_preimage. + by rewrite image_pair_of_tuple. - exact: mf. - rewrite /=. apply/integrable_prod_measP => /=. apply/integrableP; split => /=. - by apply: measurableT_comp => //=; exact: mphi. + by apply: measurableT_comp => //=; exact: measurable_tuple_of_pair. apply: le_lt_trans (intf). rewrite [leRHS](_ : _ = \int[\X_n.+1 P]_x - (((abse \o (@EFin R \o (f \o @phi n)))) \o (@psi n)) x); last first. - by apply: eq_integral => x _ /=; rewrite psiK. + (((abse \o (@EFin R \o (f \o tuple_of_pair n)))) + \o (pair_of_tuple n)) x); last first. + by apply: eq_integral => x _ /=; rewrite tuple_of_pairK. rewrite le_eqVlt; apply/orP; left; apply/eqP. - 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 _. + rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (measurable_pair_of_tuple n) + _ setT (fun x => (abse \o (EFin \o (f \o (tuple_of_pair n)))) x))//. + + apply: eq_measure_integral => // A mA _. apply: product_measure_unique => // B C mB mC. rewrite /= /pushforward/= -product_measure2E//; congr (_ _). - exact: thead_behead_preimage'. - - apply/measurable_EFinP => //=; apply: measurableT_comp => //=. - by apply: measurableT_comp => //=; [exact/measurable_EFinP|exact: mphi]. - - have : (\X_n.+1 P).-integrable [set: n.+1.-tuple T] (EFin \o f). + by rewrite image_preimage// range_pair_of_tuple. + + apply/measurable_EFinP => //=; apply: measurableT_comp => //=. + by apply: measurableT_comp => //=; [exact/measurable_EFinP| + exact: measurable_tuple_of_pair]. + + 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: le_integrable => //=. + * apply: measurableT_comp => //=; last exact: measurable_pair_of_tuple. apply/measurable_EFinP => //=; apply: measurableT_comp => //=. - by apply: measurableT_comp => //=; [exact/measurable_EFinP|exact: mphi]. - + by move=> x _; rewrite normr_id// psiK. + by apply: measurableT_comp => //=; [exact/measurable_EFinP| + exact: measurable_tuple_of_pair]. + * by move=> x _; rewrite normr_id// tuple_of_pairK. - exact: measurableT. Qed. -Lemma ipro_tnth n A i: d.-measurable A -> - (\X_n P) ((@tnth n 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 /=; congr (_ _). - by rewrite thead_behead_preimage// setXT. - 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) (setT `*` ((@tnth _ T)^~ (Ordinal mn') @^-1` A))). - rewrite /=; congr (_ _). - rewrite thead_behead_preimage//= setTX/=. - apply: funext => -[x1 x2]//=. - rewrite /phi/=. - rewrite (_ : Ordinal mn = lift ord0 (Ordinal mn'))//=; last first. - exact: val_inj. - by rewrite tnthS. - rewrite product_measure2E//=; first by rewrite probability_setT mul1e ih. - rewrite -[X in measurable X]setTI. - exact: measurable_tnth. -Qed. - -Lemma integral_ipro_tnth n (f : {mfun T >-> R}) i : +Lemma integral_ipro_tnth (P : probability T R) 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 apply: eq_measure_integral => A mA _/=; rewrite /pushforward ipro_tnth. +- by do 2 apply: measurableT_comp. - by move=> y _/=; rewrite lee_fin normr_ge0. Qed. -Lemma tnth_Lfun n (F : n.-tuple {mfun T >-> R}) i : - (tnth F i :> T -> R) \in Lfun P 1 -> (Tnth F i) \in Lfun (\X_n P) 1. +Lemma tnth_Lfun (P : probability T R) n (F : n.-tuple {mfun T >-> R}) i : + (tnth F i :> T -> R) \in Lfun P 1 -> Tnth F i \in Lfun (\X_n P) 1. Proof. rewrite !inE /Tnth => /andP[]. rewrite !inE /finite_norm/= unlock /Lnorm invr1 poweRe1; last first. @@ -435,117 +495,68 @@ move=> mF iF; apply/andP; rewrite !inE/=; split. exact: measurable_tnth. rewrite /finite_norm unlock /Lnorm/= invr1 poweRe1 ?integral_ge0//. under eq_integral => x _ do rewrite powRr1//. -by rewrite (integral_ipro_tnth (tnth F i)). +by rewrite (integral_ipro_tnth _ (tnth F i)). Qed. -Lemma integral_ipro_Tnth n (F : n.-tuple {mfun T >-> R}) : +End integral_ipro. + +Section integral_ipro_Tnth. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Open Scope ereal_scope. + +Lemma integral_ipro_Tnth n (F : n.-tuple {mfun T >-> R}) (i : 'I_n) : (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. + \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_iproS m (Tnth F (Ordinal i0))); last first. +elim: n F i => [F []//|m ih F i lfunFi/=]. +rewrite -/(\X_m.+1 P). +move: i => [] [i0|i im]. + rewrite [LHS](@integral_iproS _ _ _ _ m); last first. exact/Lfun1_integrable/tnth_Lfun/lfunFi/mem_tnth. under eq_fun => x do rewrite /Tnth (_ : tnth (_ :: _) _ = tnth [tuple of x.1 :: x.2] ord0)// tnth0. rewrite -integral12_prod_meas2 /fubini_F/=; last first. apply/integrable12ltyP => /=. - apply: measurableT_comp => //=. - exact: measurableT_comp. + by 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_iproS m (Tnth F (Ordinal im))); last first. + by case/Lfun1_integrable/integrableP. + by apply: eq_integral => x _; rewrite integral_cst//= probability_setT mule1. +rewrite [LHS](@integral_iproS _ _ _ _ m); last first. exact/Lfun1_integrable/tnth_Lfun/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. +pose j := Ordinal jm. +have liftj : Ordinal im = lift ord0 j by exact: val_inj. rewrite (tuple_eta F). -under eq_integral => x _ do rewrite /Tnth !liftjm !tnthS. +under eq_integral => x _ do rewrite /Tnth !liftj !tnthS. rewrite -integral21_prod_meas2 /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. + do 2 apply: measurableT_comp => //=. + apply: (@measurableT_comp _ _ _ _ _ _ (fun x => tnth x j) _ snd) => //. + exact: measurable_tnth. + rewrite [ltLHS](_ : _ = + \int[\X_m P]_y `|tnth (behead F) j (tnth y j)|%:E); last first. by rewrite integral_cst//= probability_setT mule1. - have : (tnth F (lift ord0 (Ordinal jm)) : T -> R) \in Lfun P 1. + have : (tnth F (lift ord0 j) : T -> R) \in Lfun P 1. by rewrite lfunFi// mem_tnth. rewrite {1}(tuple_eta F) tnthS. by move/tnth_Lfun/Lfun1_integrable/integrableP => [_]/=. -transitivity (\int[\X_m P]_x (tnth (behead F) (Ordinal jm) (tnth x (Ordinal jm)))%:E). +transitivity (\int[\X_m P]_x (tnth (behead F) j (tnth x j))%: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. +by apply: eq_integral => x _; rewrite liftj tnthS. Qed. -End integral_ipro. - -Section move. -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 -> \bar R) (r : R). - -Lemma Lnorm_abse f p : 'N[mu]_p[abse \o f] = 'N[mu]_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. - -End move. - -Section move. -Context d (T : measurableType d) (R : realType). -Variable mu : {finite_measure set T -> \bar R}. -Local Open Scope ereal_scope. - -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_subset p1 (leey _)). -- by rewrite fin_num_measure. -- by rewrite 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. - -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 move. +End integral_ipro_Tnth. 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}) : +Lemma expectation_ipro_sum 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)]). + 'E_(\X_n P)[\sum_(i < n) Tnth X i] = \sum_(i < n) 'E_P[(tnth X i)]. Proof. move=>/= bX. rewrite (_ : \sum_(i < n) Tnth X i = \sum_(Xi <- [seq Tnth X i | i in 'I_n]) Xi)%R; last first. @@ -553,23 +564,21 @@ rewrite (_ : \sum_(i < n) Tnth X i = \sum_(Xi <- [seq Tnth X i | i in 'I_n]) Xi) rewrite expectation_sum/=. rewrite big_map big_enum/=. apply: eq_bigr => i i_n. - rewrite unlock. - exact: integral_ipro_Tnth. + by rewrite unlock; exact: integral_ipro_Tnth. move=> Xi /tnthP[i] ->. pose j := cast_ord (card_ord _) i. rewrite /image_tuple tnth_map. -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 apply/tnth_Lfun/bX/tnthP; exists j. +rewrite (_ : tnth (enum_tuple 'I_n) i = j). + by apply/tnth_Lfun/bX/tnthP; exists j. +apply: val_inj => //=. +rewrite /tnth nth_enum_ord//. +have := ltn_ord i. +move/leq_trans; apply. +by rewrite card_ord leqnn. Qed. -Lemma expectation_pro2 d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) - (P1 : probability T1 R) (P2 : probability T2 R) +Lemma expectation_prod_meas2 d1 (T1 : measurableType d1) + d2 (T2 : measurableType d2) (P1 : probability T1 R) (P2 : probability T2 R) (X : T1 -> R) (Y : T2 -> R) : (X : _ -> _) \in Lfun P1 1 -> (Y : _ -> _) \in Lfun P2 1 -> @@ -646,7 +655,7 @@ move=> x1 x2 ? ? <- <-. by rewrite abseM. Qed. -Lemma expectation_ipro n (X : n.-tuple {RV P >-> R}) : +Lemma expectation_ipro_prod 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. @@ -665,36 +674,35 @@ have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in Lfun (\X_n P) 1. exact: measurable_prod_Tnth. under eq_integral => x _ do rewrite -abse_EFin. apply/abse_integralP => //=. - apply: measurableT_comp => //. - exact: measurable_prod_Tnth. + by apply: measurableT_comp => //; exact: measurable_prod_Tnth. have := IH (behead_tuple X). rewrite unlock /= => ->; last by move => x /mem_behead/lfunX. rewrite abse_prod -ge0_fin_numE ?prode_ge0// prode_fin_num// => i _. rewrite abse_fin_num integral_fune_fin_num//. exact/Lfun1_integrable/lfunX/mem_behead/mem_tnth. rewrite [LHS](@integral_iproS _ _ _ _ _ MF); last first. - rewrite /MF/F; apply/integrableP; split. - exact: measurableT_comp. - rewrite ge0_integral_iproS/=; last 2 first. - - exact: measurableT_comp. - - by []. - rewrite [ltLHS](_ : _ = \int[P \x^ (\X_n P)]_x (`|thead X x.1| * `|(\prod_(i < n) Tnth (behead_tuple X) i) x.2|)%:E); last first. + rewrite /MF/F; apply/integrableP; split; first exact: measurableT_comp. + rewrite ge0_integral_iproS/=; [|exact: measurableT_comp|by []]. + rewrite [ltLHS](_ : _ = \int[P \x^ (\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). + 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_prod_Tnth (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[_]. + rewrite [ltLHS](_ : _ = \int[P]_w `|thead X w|%:E + * \int[\X_n P]_w `|tuple_prod w|%:E); last first. + have := @expectation_prod_meas2 _ _ _ _ _ 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. @@ -768,23 +776,16 @@ rewrite fineK; last first. 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). + 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 => x /mem_behead/lfunX. -rewrite big_ord_recl/=. -congr (_ * _). -apply: eq_bigr => /=i _. + congr (tnth X _ _). + by apply: val_inj => /=; rewrite /bump/= inordK// ltnS. +rewrite IH; last by move => x /mem_behead/lfunX. +rewrite big_ord_recl/=; congr (_ * _). +apply: eq_bigr => /= i _. rewrite unlock /expectation. -apply: eq_integral => x _. -congr EFin. -by rewrite [in RHS](tuple_eta X) tnthS. +by apply: eq_integral => x _; rewrite [in RHS](tuple_eta X) tnthS. Qed. End properties_of_independence. @@ -805,39 +806,36 @@ Context d (T : measurableType d) {R : realType} (P : probability T R). Variable p : R. Hypothesis p01 : (0 <= p <= 1)%R. -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 bounded_fun_bool_to_real (X : bernoulliRV P p) : + bounded_fun (bool_to_real R X). +Proof. +rewrite /bool_to_real/=; exists 1%R; split => // r r1/= s _. +by rewrite (le_trans _ (ltW r1))// ler_norml lern1 (@le_trans _ _ 0%R) ?leq_b1. +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 diracE/= mem_set// mule1// diracE/= memNset//. -rewrite mule0 adde0 -preimage_set1. -by rewrite /distribution /= => <-. +rewrite bernoulliE// diracE/= mem_set// mule1// diracE/= memNset//. +by rewrite mule0 adde0 -preimage_set1 /distribution /= => <-. Qed. 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 diracE/= memNset//. -rewrite mule0// diracE/= mem_set// add0e mule1. -rewrite /distribution /= => <-. -by rewrite -preimage_set1. +rewrite bernoulliE// diracE/= memNset// mule0// diracE/= mem_set// add0e mule1. +by rewrite /distribution /= => <-; 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 GRing.natmul 1))//; last first. - by move=> y //=. +rewrite unlock -(@ge0_integral_distribution _ _ _ _ _ _ X + (EFin \o GRing.natmul 1))//; last by move=> y/=. rewrite /bernoulli/=. rewrite (@eq_measure_integral _ _ _ _ (bernoulli p)); last first. by move=> A mA _ /=; congr (_ _); exact: bernoulliP. -rewrite integral_bernoulli//=. -by rewrite -!EFinM -EFinD mulr0 addr0 mulr1. +by rewrite integral_bernoulli//= -!EFinM -EFinD mulr0 addr0 mulr1. Qed. Lemma integrable_bernoulli (X : bernoulliRV P p) : @@ -855,9 +853,8 @@ 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. +move=> q1; apply: (@Lfun_bounded _ _ _ P) => //. +exact: bounded_fun_bool_to_real. Qed. Lemma bool_RV_sqr (X : {RV P >-> bool}) : @@ -881,7 +878,8 @@ Qed. 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} := +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. @@ -895,7 +893,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. -rewrite expectation_sum_ipro; last first. +rewrite expectation_ipro_sum; last first. 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. @@ -905,52 +903,45 @@ Qed. Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) : (forall t, 0 <= bool_trial_value X t)%R. Proof. -move=> t. -rewrite [leRHS]fct_sumE. -apply/sumr_ge0 => /= i _. -rewrite /Tnth. -by rewrite !tnth_map. +move=> t; rewrite [leRHS]fct_sumE; apply/sumr_ge0 => /= i _. +by rewrite /Tnth !tnth_map. Qed. Lemma bernoulli_trial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : let X := bool_trial_value X_ in - mmt_gen_fun (\X_n P) X t = \prod_(i < n) mmt_gen_fun P (bool_to_real R (tnth X_ i) : {RV P >-> _}) t. + 'M_(\X_n P) X t = \prod_(i < n) 'M_P (bool_to_real R (tnth X_ i)) t. Proof. -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. +pose mmtX (i : 'I_n) : {RV P >-> R : realType} := + expR \o t \o* bool_to_real R (tnth X_ i). +transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ]). congr expectation => /=; apply: funext => x/=. - rewrite fct_sumE. - rewrite big_distrl/= expR_sum. - rewrite [in RHS]fct_prodE. + rewrite fct_sumE big_distrl/= expR_sum [in RHS]fct_prodE. apply: eq_bigr => i _. by rewrite /Tnth !tnth_map /mmtX/= tnth_ord_tuple. -rewrite /mmtX. -rewrite expectation_ipro; last first. -- move=> _ /mapP [/= i _ ->]. +rewrite expectation_ipro_prod; last first. + move=> _ /mapP [/= i _ ->]. apply/Lfun1_integrable/bounded_integrable => //. exists (expR `|t|); split => // M etM x _ /=. rewrite ger0_norm// (le_trans _ (ltW etM))// ler_expR/=. rewrite /bool_to_real/=. - case: (tnth X_ i x) => //=; rewrite ?mul1r ?mul0r//. - by rewrite ler_norm. + by case: (tnth X_ i x) => //=; rewrite ?mul1r ?mul0r// ler_norm. apply: eq_bigr => /= i _. -congr expectation. -by rewrite tnth_map/= tnth_ord_tuple. +by congr expectation; rewrite tnth_map/= tnth_ord_tuple. Qed. Arguments sub_countable [T U]. Arguments card_le_finite [T U]. Lemma bernoulli_mmt_gen_fun (X : bernoulliRV P p) (t : R) : - mmt_gen_fun P (bool_to_real R X) t = (p * expR t + (1-p))%:E. + 'M_P (bool_to_real R X) t = (p * expR t + (1 - p))%:E. Proof. rewrite/mmt_gen_fun. 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. -have mB: measurable B by exact: measurable_sfunP. -have dAB: [disjoint A & B] +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. @@ -979,7 +970,7 @@ Qed. (* wrong lemma *) Lemma binomial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in - mmt_gen_fun (\X_n P) X t = ((p * expR t + (1 - p))`^(n%:R))%:E. + 'M_(\X_n P) X t = ((p * expR t + (1 - p))`^(n%:R))%:E. Proof. move: p01 => /andP[p0 p1] bX/=. rewrite bernoulli_trial_mmt_gen_fun//. @@ -991,7 +982,7 @@ 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 - mmt_gen_fun (\X_n P) X t <= expeR ('E_(\X_n P)[X] * (expR t - 1)%:E). + 'M_(\X_n P) X t <= expeR ('E_(\X_n P)[X] * (expR t - 1)%:E). Proof. move=> t_ge0/=. have /andP[p0 p1] := p01. @@ -1161,11 +1152,6 @@ by rewrite nmulr_rlt0 ?ln_gt0// nmulr_rlt0 ?(lt_trans _ x1). Qed. End xlnx_bounding. -(* TODO : move *) -Lemma norm_expR : normr \o expR = (expR : R -> R). -Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. - - (* [Theorem 2.6, Rajani] / [thm 4.5.(2), MU] *) Theorem sampling_ineq3 n (X : n.-tuple (bernoulliRV P p)) (delta : R) : (0 < delta < 1)%R -> @@ -1190,16 +1176,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_(\X_n P)[normr \o expR \o t \o* X']) / (expR (t * (1 - delta) * fine mu))))%:E). + 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; last first. rewrite norm_expR. - have -> : 'E_(\X_n P)[expR \o t \o* X'] = mmt_gen_fun (\X_n P) X' t by []. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_(\X_n P) X' t by []. by rewrite binomial_mmt_gen_fun. 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. 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'] = mmt_gen_fun (\X_n P) X' t by []. + have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_(\X_n P) X' t by []. rewrite binomial_mmt_gen_fun//. rewrite /mu /X' expectation_bernoulli_trial//. rewrite !lnK ?posrE ?subr_gt0//. @@ -1220,8 +1206,7 @@ rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. - 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. + rewrite expRK// ln_powR. (* 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. @@ -1229,6 +1214,7 @@ rewrite -mulrN -mulrA [in leRHS]mulrC expRM ge0_ler_powR// ?nnegrE. 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 *) @@ -1259,7 +1245,8 @@ Section xlnx_bounding_with_interval. Let R := Rdefinitions.R. Local Open Scope ring_scope. -Lemma xlnx_lbound_i12 (x : R) : x \in `]0, 1[ -> x + x^+2 / 3 <= (1 + x) * ln (1 + x). +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). From 9884905322962ad8c3c5964b56ddc3808c40fae4 Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Fri, 27 Jun 2025 11:24:30 +0900 Subject: [PATCH 16/28] generalize ipro to sigma_finite --- theories/sampling.v | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 39d5511d1..33ad3a406 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -325,9 +325,9 @@ Arguments tuple_of_pair {d T} n. Arguments measurable_tuple_of_pair {d T} n. Arguments measurable_pair_of_tuple {d T} n. -Section iterated_product_finite_measures. +Section iterated_product_sigma_finite_measures. Context d (T : measurableType d) (R : realType) - (P : {finite_measure set T -> \bar R}). + (P : {sigma_finite_measure set T -> \bar R}). Fixpoint ipro n : set (n.-tuple T) -> \bar R := match n with @@ -360,7 +360,7 @@ Qed. HB.instance Definition _ n := isMeasure.Build _ _ _ (@ipro n) (ipro_measure n).1 (ipro_measure n).2.1 (ipro_measure n).2.2. -End iterated_product_finite_measures. +End iterated_product_sigma_finite_measures. Arguments ipro {d T R} P n. Notation "\X_ n P" := (ipro P n). @@ -368,7 +368,7 @@ Notation "\X_ n P" := (ipro P n). Section iterated_product_probability_measures. Context d (T : measurableType d) (R : realType) (P : probability T R). -Lemma ipro_setT n : \X_n P [set: n.-tuple T] = 1%E. +Let ipro_setT n : \X_n P [set: n.-tuple T] = 1%E. Proof. elim: n => [|n ih]/=; first by rewrite diracT. rewrite /product_measure2 /ysection/=. From db9caa8f1e35a59f0a635ea55939d74e28dd0b1b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 28 Jun 2025 11:56:12 +0900 Subject: [PATCH 17/28] cleaning --- theories/sampling.v | 155 ++++++++++++++++++++++++-------------------- 1 file changed, 83 insertions(+), 72 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 33ad3a406..64a60847c 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -74,6 +74,17 @@ Reserved Notation "\X_ n P" (at level 10, n, P at next level, Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. +Local Open Scope ereal_scope. +Lemma abse_prod {R : realDomainType} [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. +Local Close Scope ereal_scope. + (* TODO: put back in probability.v *) Notation "'M_ X t" := (mmt_gen_fun X t). @@ -524,7 +535,7 @@ move: i => [] [i0|i im]. by apply: eq_integral => x _; rewrite integral_cst//= probability_setT mule1. rewrite [LHS](@integral_iproS _ _ _ _ m); last first. exact/Lfun1_integrable/tnth_Lfun/lfunFi/mem_tnth. -have jm : (i < m)%nat by rewrite ltnS in im. +have jm : (i < m)%N by rewrite ltnS in im. pose j := Ordinal jm. have liftj : Ordinal im = lift ord0 j by exact: val_inj. rewrite (tuple_eta F). @@ -646,15 +657,6 @@ by rewrite M2g// (lt_le_trans _ (ler_norm _))// ltrDl. Unshelve. all: by end_near. Qed. -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_ipro_prod 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) ]. @@ -1150,51 +1152,57 @@ 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 sampling_ineq3 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 - (\X_n P) [set i | X' i <= (1 - delta) * fine mu]%R <= (expR (-(fine mu * delta ^+ 2) / 2)%R)%:E. + 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' := bool_trial_value X : {RV \X_n P >-> R : realType}. -set mu := 'E_(\X_n P)[X']. +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)). +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]. + (\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. + by rewrite ln_lt0// subr_gt0 delta1/= ltrBlDl ltrDr. 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). + 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; last first. rewrite norm_expR. - have -> : 'E_(\X_n P)[expR \o t \o* X'] = 'M_(\X_n P) X' t by []. + have -> : 'E_(\X_n P)[expR \o t \o* X] = 'M_(\X_n P) X t by []. by rewrite binomial_mmt_gen_fun. - 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. - apply: (@le_trans _ _ (((expR ((expR t - 1) * fine mu)) / (expR (t * (1 - delta) * fine mu))))%:E). + apply: (@markov _ _ _ (\X_n P) (expR \o t \o* X) id + (expR (t * (1 - delta) * fine mu))%R _ _ _ _) => //. + exact: expR_gt0. + 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_n P) X' t by []. + have -> : 'E_(\X_n P)[expR \o t \o* X] = 'M_(\X_n P) X t by []. rewrite binomial_mmt_gen_fun//. - rewrite /mu /X' expectation_bernoulli_trial//. + rewrite /mu /X expectation_bernoulli_trial//. 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. + exact: 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//. @@ -1233,7 +1241,7 @@ Proof. interval. Qed. Lemma exp2_le8_conversion : reflect (exp 2 <= 8)%R (expR 2 <= 8 :> R). Proof. -rewrite RexpE (_ : 8%R = 8); last +rewrite RexpE (_ : 8%R = 8); last first. by rewrite !mulrS -!RplusE Rplus_0_r !RplusA !IZRposE/=. by apply: (iffP idP) => /RleP. Qed. @@ -1311,52 +1319,50 @@ Hypothesis p01 : (0 <= p <= 1)%R. Local Open Scope ereal_scope. (* [Theorem 2.5, Rajani] *) -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 -> +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)%N -> (0 < delta < 1)%R -> - (\X_n P) [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=> 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//. +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 ?posrE ?addr_gt0//. 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. - rewrite lerB//. - apply: xlnx_lbound_i12. - by rewrite in_itv /=. + rewrite fine_ge0//; apply: expectation_ge0 => t. + exact: bernoulli_trial_ge0. + by rewrite lerB// xlnx_lbound_i12. rewrite le_eqVlt; apply/orP; left; apply/eqP; congr (expR _)%:E. by rewrite opprD addrA subrr add0r mulrC mulrN mulNr mulrA. Qed. (* [Corollary 2.7, Rajani] / [Corollary 4.7, MU] *) -Corollary sampling_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 < n)%N -> (0 < p)%R -> - 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 <= + 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' := bool_trial_value X. -set mu := 'E_(\X_n P)[X']. +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. + 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. rewrite -lerBDr -(lerN2 (- _)%R) opprK opprB. - rewrite -{2}(mul1r (fine mu)) -mulrBl. - rewrite -!lee_fin. + rewrite -{2}(mul1r (fine mu)) -mulrBl -!lee_fin. over. -rewrite /=. -rewrite set_orb measureU; last 3 first. +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 => //. @@ -1367,7 +1373,7 @@ rewrite set_orb measureU; last 3 first. rewrite mulr2n EFinD leeD//=. - by apply: sampling_ineq2; rewrite //d0 d1. - have d01 : (0 < delta < 1)%R by rewrite d0. - rewrite (le_trans (sampling_ineq3 p01 X 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 ?sqr_ge0// fine_ge0//. @@ -1375,24 +1381,29 @@ rewrite mulr2n EFinD leeD//=. Qed. (* [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)%R in - (0 < p)%R -> - (0 < delta <= 1)%R -> (0 < theta < p)%R -> (0 < n)%N -> +Theorem sampling n (X_ : n.-tuple (bernoulliRV P p)) (theta delta : R) : + let X x := ((bool_trial_value X_ x) / n%:R)%R in + (0 < delta <= 1)%R -> (0 < theta < p)%R -> (3 / theta ^+ 2 * ln (2 / delta) <= n%:R)%R -> - (\X_n P) [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' p0 /andP[delta0 delta1] /andP[theta0 thetap] n0 tdn. +move=> X /andP[delta0 delta1] /andP[theta0 thetap] tdn. have /andP[_ p1] := p01. set epsilon := (theta / p)%R. +have p0 : (0 < p)%R by rewrite (lt_trans _ thetap). +have n0 : (0 < n)%N. + rewrite -(@ltr_nat R) (lt_le_trans _ tdn)// mulr_gt0//. + by rewrite divr_gt0// exprn_gt0. + by rewrite ln_gt0// ltr_pdivlMr ?mul1r// (le_lt_trans delta1)// ltr1n. 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 <= +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 | `| bool_trial_value X 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. @@ -1404,9 +1415,9 @@ 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 p01 X). - exact: (@sampling_ineq4 _ X epsilon). -have step2 : (\X_n P) [set i | `| X' i - p | >= theta]%R <= + rewrite -(mulrC _ p) -(expectation_bernoulli_trial p01 X_). + 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. rewrite lee_fin ler_wMn2r// ler_expR mulNr lerNl mulNr opprK. @@ -1415,14 +1426,15 @@ have step2 : (\X_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 >= (\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. +suff : delta%:E >= (\X_n P) [set i | (`|X i - p| >= 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]. + have ? : measurable [set i | (`|X i - p| < theta)%R]. under eq_set => x do rewrite -lte_fin. - rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. + rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X//. by apply: measurable_lte => //; apply: measurableT_comp => //; apply: measurableT_comp => //; apply: measurable_funD => //; apply: measurable_funM. @@ -1431,12 +1443,11 @@ suff : delta%:E >= (\X_n P) [set i | (`|X' i - p| >=(*NB: this >= in the pdf *) move=> /le_trans; apply. rewrite le_measure ?inE//. under eq_set => x do rewrite -lee_fin. - rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X'//. + rewrite -(@setIidr _ setT [set _ | _]) ?subsetT /X//. by apply: measurable_lee => //; 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)%R); last by rewrite posrE divr_gt0. From 4ede82a4239b37bc34e9c4de3789c7b9de56a141 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 28 Jun 2025 17:15:03 +0900 Subject: [PATCH 18/28] rm dup code --- theories/sampling.v | 73 +++++---------------------------------------- 1 file changed, 7 insertions(+), 66 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 64a60847c..18b4f3276 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -74,20 +74,6 @@ Reserved Notation "\X_ n P" (at level 10, n, P at next level, Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. -Local Open Scope ereal_scope. -Lemma abse_prod {R : realDomainType} [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. -Local Close Scope ereal_scope. - -(* TODO: put back in probability.v *) -Notation "'M_ X t" := (mmt_gen_fun X t). - Lemma preimage_set1 T {U : eqType} (X : T -> U) r : X @^-1` [set r] = [set i | X i == r]. Proof. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. @@ -142,34 +128,6 @@ Lemma integral_prod_meas1E {d1} {T1 : measurableType d1} (\int[m1 \x^ m2]_x f x = \int[(m1 \x m2)%E]_z f z)%E. Proof. by move=> intf; rewrite -fubini1// integral12_prod_meas2. Qed. -Section PR_to_hoelder. -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 -> \bar R) (r : R). - -Lemma Lnorm_abse f p : 'N[mu]_p[abse \o f] = 'N[mu]_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 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 PR_to_hoelder. - Section PR_to_hoelder. Context d (T : measurableType d) (R : realType). Variable mu : {finite_measure set T -> \bar R}. @@ -637,26 +595,6 @@ 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] -> - [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_ipro_prod 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) ]. @@ -718,10 +656,12 @@ under eq_fun. 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. + 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 /= -(_ : '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. @@ -736,7 +676,7 @@ have ? : measurable_fun [set: n.-tuple T] 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. +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. @@ -775,7 +715,8 @@ rewrite /= integralZr//; last exact/Lfun1_integrable/lfunX/mem_tnth. rewrite fineK; last first. 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 [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). From 9452b238b5ac7cab5f167303ba63612003d57010 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 7 Jul 2025 12:08:57 +0900 Subject: [PATCH 19/28] rebase --- theories/sampling.v | 71 +++++++++++++++------------------------------ 1 file changed, 24 insertions(+), 47 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 18b4f3276..755600162 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -78,33 +78,6 @@ Lemma preimage_set1 T {U : eqType} (X : T -> U) r : X @^-1` [set r] = [set i | X i == r]. Proof. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. -(* PR in progress *) -Lemma integral21_prod_meas2 {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. - -(* PR in progress *) -Lemma integral12_prod_meas2 {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. - (* PR in progress *) Lemma integrable_prod_measP {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) @@ -126,7 +99,7 @@ Lemma integral_prod_meas1E {d1} {T1 : measurableType d1} (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^ m2]_x f x = \int[(m1 \x m2)%E]_z f z)%E. -Proof. by move=> intf; rewrite -fubini1// integral12_prod_meas2. Qed. +Proof. by move=> intf; rewrite -integral12_prod_meas1// integral12_prod_meas2. Qed. Section PR_to_hoelder. Context d (T : measurableType d) (R : realType). @@ -228,10 +201,10 @@ Local Open Scope ereal_scope. Definition pair_of_tuple n (w : n.+1.-tuple T) := (thead w, [the _.-tuple _ of behead w]). -Lemma measurable_pair_of_tuple n : - measurable_fun [set: _.-tuple _] (@pair_of_tuple n). +Lemma measurable_pair_of_tuple n (D : set (n.+1.-tuple T)) : + measurable_fun D (@pair_of_tuple n). Proof. -by apply/measurable_fun_pair => /=; +by apply/measurable_funTS/measurable_fun_pair => /=; [exact: measurable_tnth|exact: measurable_behead]. Qed. @@ -374,7 +347,8 @@ Proof. move=> mf f0. rewrite -(@ge0_integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ setT (fun x : n.+1.-tuple T => (f x)%:E)). -- by apply: eq_measure_integral => A mA _ /=; rewrite image_pair_of_tuple. +- apply: eq_measure_integral => /=; first exact: measurable_tuple_of_pair. + by move=> _ A mA _ /=; rewrite image_pair_of_tuple. - exact: measurableT. - exact: measurableT_comp. - by move=> x/= _; rewrite lee_fin. @@ -408,8 +382,8 @@ Proof. move=> /integrableP[mf intf]. rewrite -(@integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ setT (fun x : n.+1.-tuple T => (f x)%:E)). -- apply: eq_measure_integral => A mA _ /=. - by rewrite image_pair_of_tuple. +- apply: eq_measure_integral => /=; first exact: measurable_tuple_of_pair. + by move=> _ A mA _ /=; rewrite image_pair_of_tuple. - exact: mf. - rewrite /=. apply/integrable_prod_measP => /=. @@ -421,12 +395,14 @@ rewrite -(@integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ \o (pair_of_tuple n)) x); last first. by apply: eq_integral => x _ /=; rewrite tuple_of_pairK. rewrite le_eqVlt; apply/orP; left; apply/eqP. - rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (measurable_pair_of_tuple n) + rewrite -[RHS](@integral_pushforward _ _ _ _ R _ (measurable_pair_of_tuple n setT) _ setT (fun x => (abse \o (EFin \o (f \o (tuple_of_pair n)))) x))//. - + apply: eq_measure_integral => // A mA _. - apply: product_measure_unique => // B C mB mC. - rewrite /= /pushforward/= -product_measure2E//; congr (_ _). - by rewrite image_preimage// range_pair_of_tuple. + + apply: eq_measure_integral => /=; first exact: measurable_pair_of_tuple. + move=> _ A mA _/=; rewrite /pushforward /=. + rewrite image_pair_of_tuple -comp_preimage (_ : _ \o _ = id); last first. + by apply/funext=> x/=; rewrite pair_of_tupleK. + rewrite preimage_id; apply: product_measure_unique => // B C mB mC. + by rewrite /= /pushforward/= -product_measure2E. + apply/measurable_EFinP => //=; apply: measurableT_comp => //=. by apply: measurableT_comp => //=; [exact/measurable_EFinP| exact: measurable_tuple_of_pair]. @@ -447,7 +423,8 @@ Proof. rewrite -(preimage_setT ((@tnth n _)^~ i)). rewrite -(@ge0_integral_pushforward _ _ _ _ _ _ (measurable_tnth i) (\X_n P) _ (EFin \o normr \o f) measurableT). -- by apply: eq_measure_integral => A mA _/=; rewrite /pushforward ipro_tnth. +- apply: eq_measure_integral => /=; first exact: measurable_tnth. + by move=> _ A mA _/=; rewrite /pushforward ipro_tnth. - by do 2 apply: measurableT_comp. - by move=> y _/=; rewrite lee_fin normr_ge0. Qed. @@ -577,16 +554,16 @@ rewrite -integral12_prod_meas2/=; last first. by apply: integral_ge0 => //. rewrite lte_mul_pinfty//. - exact: integral_ge0. - - exact/integral_fune_fin_num/Lfun1_integrable/Lfun_norm. + - exact/integrable_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. rewrite integralZl//; last exact/Lfun1_integrable. - rewrite -[X in _ * X]fineK ?integral_fune_fin_num//; last exact/Lfun1_integrable. + rewrite -[X in _ * X]fineK ?integrable_fin_num//; last exact/Lfun1_integrable. over. rewrite /=integralZr//; last exact/Lfun1_integrable. -by rewrite fineK// integral_fune_fin_num; last exact/Lfun1_integrable. +by rewrite fineK// integrable_fin_num; last exact/Lfun1_integrable. Qed. End properties_of_expectation. @@ -618,7 +595,7 @@ have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in Lfun (\X_n P) 1. have := IH (behead_tuple X). rewrite unlock /= => ->; last by move => x /mem_behead/lfunX. rewrite abse_prod -ge0_fin_numE ?prode_ge0// prode_fin_num// => i _. - rewrite abse_fin_num integral_fune_fin_num//. + rewrite abse_fin_num integrable_fin_num//. exact/Lfun1_integrable/lfunX/mem_behead/mem_tnth. rewrite [LHS](@integral_iproS _ _ _ _ _ MF); last first. rewrite /MF/F; apply/integrableP; split; first exact: measurableT_comp. @@ -734,13 +711,13 @@ Qed. End properties_of_independence. 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 }. + (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}. + {X of @RV_isBernoulli _ _ _ P p X & MeasurableFun d X}. Arguments bernoulliRV {d T R}. Section properties_of_BernoulliRV. From 3b0d4bcc3a24e5c5f55aa7071a8b23dab3b6cbfe Mon Sep 17 00:00:00 2001 From: Takafumi Saikawa Date: Mon, 7 Jul 2025 15:47:38 +0900 Subject: [PATCH 20/28] remove preimage_set1 --- theories/sampling.v | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 755600162..8a0ecc193 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -74,10 +74,6 @@ Reserved Notation "\X_ n P" (at level 10, n, P at next level, Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. -Lemma preimage_set1 T {U : eqType} (X : T -> U) r : - X @^-1` [set r] = [set i | X i == r]. -Proof. by apply/seteqP; split => [x /eqP H//|x /eqP]. Qed. - (* PR in progress *) Lemma integrable_prod_measP {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) @@ -733,18 +729,18 @@ rewrite /bool_to_real/=; exists 1%R; split => // r r1/= s _. by rewrite (le_trans _ (ltW r1))// ler_norml lern1 (@le_trans _ _ 0%R) ?leq_b1. Qed. -Lemma bernoulli_RV1 (X : bernoulliRV P p) : P [set i | X i == 1%R] = p%:E. +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// diracE/= mem_set// mule1// diracE/= memNset//. -by rewrite mule0 adde0 -preimage_set1 /distribution /= => <-. +by rewrite mule0 adde0 /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// diracE/= memNset// mule0// diracE/= mem_set// add0e mule1. -by rewrite /distribution /= => <-; rewrite -preimage_set1. +by rewrite /distribution /= => <-. Qed. Lemma bernoulli_expectation (X : bernoulliRV P p) : @@ -879,10 +875,7 @@ under eq_integral. over. rewrite integral_cst//. rewrite /A /B /preimage /=. -under eq_set do rewrite (propext (rwP eqP)). -rewrite bernoulli_RV1. -under eq_set do rewrite (propext (rwP eqP)). -rewrite bernoulli_RV2. +rewrite bernoulli_RV1 bernoulli_RV2. rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. by rewrite expR0 mulr1. Qed. From 65a0eff6bf839addad79cccc98e17228498f464b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 7 Jul 2025 19:25:18 +0900 Subject: [PATCH 21/28] ipro -> power_measure --- classical/functions.v | 9 -- theories/sampling.v | 249 ++++++++++++++++++------------------------ 2 files changed, 107 insertions(+), 151 deletions(-) diff --git a/classical/functions.v b/classical/functions.v index 4c0c0cf42..020908965 100644 --- a/classical/functions.v +++ b/classical/functions.v @@ -2657,11 +2657,6 @@ Lemma fct_prodE (I : Type) (T : pointedType) (M : ringType) r (P : {pred I}) \prod_(i <- r | P i) f i = fun x => \prod_(i <- r | P i) f i x. Proof. by apply/funext => ?; 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. @@ -2684,10 +2679,6 @@ Lemma prodrfctE (T : pointedType) (K : ringType) (s : seq (T -> K)) : \prod_(f <- s) f = (fun x => \prod_(f <- s) f x). Proof. exact: fct_prodE. 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 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. diff --git a/theories/sampling.v b/theories/sampling.v index 8a0ecc193..1c4049be1 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -35,8 +35,8 @@ Unset Printing Implicit Defensive. (* \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_sum_power_measure: The expectation of the sum of random *) +(* variables on the power 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 *) @@ -70,10 +70,6 @@ Local Open Scope ring_scope. Reserved Notation "\X_ n P" (at level 10, n, P at next level, format "\X_ n P"). -(* NB: also in Jairo's PR about lne *) -Lemma norm_expR {R : realType} : normr \o expR = (expR : R -> R). -Proof. by apply/funext => x /=; rewrite ger0_norm ?expR_ge0. Qed. - (* PR in progress *) Lemma integrable_prod_measP {d1} {T1 : measurableType d1} d2 {T2 : measurableType d2} {R : realType} (m1 : {sigma_finite_measure set T1 -> \bar R}) @@ -165,9 +161,7 @@ HB.instance Definition _ n (X : n.-tuple {mfun T >-> R}) (i : 'I_n) := Lemma measurable_sum_Tnth n (X : n.-tuple {mfun T >-> R}) : measurable_fun [set: n.-tuple T] (\sum_(i < n) Tnth X i). 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. +rewrite fct_sumE. apply: measurable_sum => i/=; apply/measurableT_comp => //. exact: measurable_tnth. Qed. @@ -178,9 +172,7 @@ HB.instance Definition _ n (s : n.-tuple {mfun T >-> R}) := Lemma measurable_prod_Tnth m n (s : m.-tuple {mfun T >-> R}) (f : 'I_n -> 'I_m) : measurable_fun [set: m.-tuple T] (\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. +rewrite fct_prodE. by apply: measurable_prod => /= i _; apply/measurableT_comp. Qed. @@ -263,31 +255,32 @@ Arguments tuple_of_pair {d T} n. Arguments measurable_tuple_of_pair {d T} n. Arguments measurable_pair_of_tuple {d T} n. -Section iterated_product_sigma_finite_measures. +Section power_measure_sigma_finite_measure. Context d (T : measurableType d) (R : realType) (P : {sigma_finite_measure set T -> \bar R}). -Fixpoint ipro n : set (n.-tuple T) -> \bar R := +Fixpoint power_measure n : set (n.-tuple T) -> \bar R := match n with | 0%N => \d_([::] : 0.-tuple T) - | m.+1 => fun A => (P \x^ @ipro m)%E (pair_of_tuple m @` A) + | m.+1 => fun A => (P \x^ @power_measure m)%E (pair_of_tuple m @` A) end. -Let ipro_measure n : @ipro n set0 = 0 /\ (forall A, 0 <= @ipro n A)%E - /\ semi_sigma_additive (@ipro n). +Let power_measureP n : @power_measure n set0 = 0 + /\ (forall A, 0 <= @power_measure n A)%E + /\ semi_sigma_additive (@power_measure n). Proof. elim: n => //= [|n ih]. by repeat split => //; exact: measure_semi_sigma_additive. -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. +pose build_pow_meas := isMeasure.Build _ _ _ (@power_measure n) ih.1 ih.2.1 ih.2.2. +pose pow_meas : measure _ R := HB.pack (@power_measure n) build_pow_meas. +pose Ppow_meas : measure _ R := (P \x^ pow_meas)%E. split. rewrite image_set0 /product_measure2 /=. under eq_fun => x do rewrite ysection0 measure0 (_ : 0 = cst 0 x)//. - by rewrite (_ : @ipro n = Mpro)// integral_cst// mul0e. + by rewrite (_ : @power_measure n = pow_meas)// integral_cst// mul0e. split. - by move => A; rewrite (_ : @ipro n = Mpro). -rewrite (_ : @ipro n = Mpro)// (_ : (P \x^ Mpro)%E = ppro)//. + by move => A; rewrite (_ : @power_measure n = pow_meas). +rewrite (_ : @power_measure n = pow_meas)// (_ : (P \x^ pow_meas)%E = Ppow_meas)//. move=> F mF dF mUF. rewrite image_bigcup; apply: measure_semi_sigma_additive. - by move=> i ; apply: measurable_image_pair_of_tuple. @@ -295,18 +288,18 @@ rewrite image_bigcup; apply: measure_semi_sigma_additive. - by apply: bigcup_measurable => j _; apply: measurable_image_pair_of_tuple. Qed. -HB.instance Definition _ n := isMeasure.Build _ _ _ (@ipro n) - (ipro_measure n).1 (ipro_measure n).2.1 (ipro_measure n).2.2. +HB.instance Definition _ n := isMeasure.Build _ _ _ (@power_measure n) + (power_measureP n).1 (power_measureP n).2.1 (power_measureP n).2.2. -End iterated_product_sigma_finite_measures. -Arguments ipro {d T R} P n. +End power_measure_sigma_finite_measure. +Arguments power_measure {d T R} P n. -Notation "\X_ n P" := (ipro P n). +Notation "\X_ n P" := (power_measure P n). -Section iterated_product_probability_measures. +Section power_measure_probability_measure. Context d (T : measurableType d) (R : realType) (P : probability T R). -Let ipro_setT n : \X_n P [set: n.-tuple T] = 1%E. +Let power_measureT n : \X_n P [set: n.-tuple T] = 1%E. Proof. elim: n => [|n ih]/=; first by rewrite diracT. rewrite /product_measure2 /ysection/=. @@ -326,15 +319,15 @@ by rewrite integral_cst// mul1e. Qed. HB.instance Definition _ n := - Measure_isProbability.Build _ _ _ (\X_n P) (@ipro_setT n). + Measure_isProbability.Build _ _ _ (\X_n P) (@power_measureT n). -End iterated_product_probability_measures. +End power_measure_probability_measure. -Section integral_ipro. +Section integral_power_measure. Context d (T : measurableType d) (R : realType). Local Open Scope ereal_scope. -Lemma ge0_integral_iproS (P : {finite_measure set T -> \bar R}) +Lemma ge0_integral_power_measureS (P : {finite_measure set T -> \bar R}) n (f : n.+1.-tuple T -> R) : measurable_fun [set: n.+1.-tuple T] f -> (forall x, 0 <= f x)%R -> @@ -350,7 +343,7 @@ rewrite -(@ge0_integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ - by move=> x/= _; rewrite lee_fin. Qed. -Lemma ipro_tnth n A i (P : probability T R) : d.-measurable A -> +Lemma power_measure_tnth n A i (P : probability T R) : d.-measurable A -> (\X_n P) ((@tnth n T)^~ i @^-1` A) = P A. Proof. elim: n A i => [A [] []//|n ih A [] [i0|m mn mA]]. @@ -370,7 +363,7 @@ elim: n A i => [A [] []//|n ih A [] [i0|m mn mA]]. by rewrite -[X in measurable X]setTI; exact: measurable_tnth. Qed. -Lemma integral_iproS (P : probability T R) +Lemma integral_power_measureS (P : probability T R) 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[P \x^ \X_n P]_w (f (w.1 :: w.2))%:E. @@ -413,14 +406,14 @@ rewrite -(@integral_pushforward _ _ _ _ R _ (measurable_tuple_of_pair n) _ - exact: measurableT. Qed. -Lemma integral_ipro_tnth (P : probability T R) n (f : {mfun T >-> R}) i : +Lemma integral_power_measure_tnth (P : probability T R) 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 => /=; first exact: measurable_tnth. - by move=> _ A mA _/=; rewrite /pushforward ipro_tnth. + by move=> _ A mA _/=; rewrite /pushforward power_measure_tnth. - by do 2 apply: measurableT_comp. - by move=> y _/=; rewrite lee_fin normr_ge0. Qed. @@ -437,23 +430,23 @@ move=> mF iF; apply/andP; rewrite !inE/=; split. exact: measurable_tnth. rewrite /finite_norm unlock /Lnorm/= invr1 poweRe1 ?integral_ge0//. under eq_integral => x _ do rewrite powRr1//. -by rewrite (integral_ipro_tnth _ (tnth F i)). +by rewrite (integral_power_measure_tnth _ (tnth F i)). Qed. -End integral_ipro. +End integral_power_measure. -Section integral_ipro_Tnth. +Section integral_power_measure_Tnth. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Lemma integral_ipro_Tnth n (F : n.-tuple {mfun T >-> R}) (i : 'I_n) : +Lemma integral_power_measure_Tnth n (F : n.-tuple {mfun T >-> R}) (i : 'I_n) : (forall Fi : {mfun T >-> R}, Fi \in F -> (Fi : T -> R) \in Lfun P 1) -> \int[\X_n P]_x (Tnth F i x)%:E = \int[P]_x (tnth F i x)%:E. Proof. elim: n F i => [F []//|m ih F i lfunFi/=]. rewrite -/(\X_m.+1 P). move: i => [] [i0|i im]. - rewrite [LHS](@integral_iproS _ _ _ _ m); last first. + rewrite [LHS](@integral_power_measureS _ _ _ _ m); last first. exact/Lfun1_integrable/tnth_Lfun/lfunFi/mem_tnth. under eq_fun => x do rewrite /Tnth (_ : tnth (_ :: _) _ = tnth [tuple of x.1 :: x.2] ord0)// tnth0. @@ -464,7 +457,7 @@ move: i => [] [i0|i im]. have /lfunFi : tnth F (Ordinal i0) \in F by apply/tnthP; exists (Ordinal i0). by case/Lfun1_integrable/integrableP. by apply: eq_integral => x _; rewrite integral_cst//= probability_setT mule1. -rewrite [LHS](@integral_iproS _ _ _ _ m); last first. +rewrite [LHS](@integral_power_measureS _ _ _ _ m); last first. exact/Lfun1_integrable/tnth_Lfun/lfunFi/mem_tnth. have jm : (i < m)%N by rewrite ltnS in im. pose j := Ordinal jm. @@ -490,13 +483,13 @@ rewrite [LHS]ih; last by move=> Fi FiF; apply: lfunFi; rewrite mem_behead. by apply: eq_integral => x _; rewrite liftj tnthS. Qed. -End integral_ipro_Tnth. +End integral_power_measure_Tnth. Section properties_of_expectation. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Lemma expectation_ipro_sum n (X : n.-tuple {RV P >-> R}) : +Lemma expectation_power_measure_sum 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. @@ -506,7 +499,7 @@ rewrite (_ : \sum_(i < n) Tnth X i = \sum_(Xi <- [seq Tnth X i | i in 'I_n]) Xi) rewrite expectation_sum/=. rewrite big_map big_enum/=. apply: eq_bigr => i i_n. - by rewrite unlock; exact: integral_ipro_Tnth. + by rewrite unlock; exact: integral_power_measure_Tnth. move=> Xi /tnthP[i] ->. pose j := cast_ord (card_ord _) i. rewrite /image_tuple tnth_map. @@ -568,7 +561,7 @@ Section properties_of_independence. Context d (T : measurableType d) (R : realType) (P : probability T R). Local Open Scope ereal_scope. -Lemma expectation_ipro_prod n (X : n.-tuple {RV P >-> R}) : +Lemma expectation_power_measure_prod 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. @@ -593,13 +586,13 @@ have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in Lfun (\X_n P) 1. rewrite abse_prod -ge0_fin_numE ?prode_ge0// prode_fin_num// => i _. rewrite abse_fin_num integrable_fin_num//. exact/Lfun1_integrable/lfunX/mem_behead/mem_tnth. -rewrite [LHS](@integral_iproS _ _ _ _ _ MF); last first. +rewrite [LHS](@integral_power_measureS _ _ _ _ _ MF); last first. rewrite /MF/F; apply/integrableP; split; first exact: measurableT_comp. - rewrite ge0_integral_iproS/=; [|exact: measurableT_comp|by []]. + rewrite ge0_integral_power_measureS/=; [|exact: measurableT_comp|by []]. rewrite [ltLHS](_ : _ = \int[P \x^ (\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/=. + rewrite !fct_prodE/= big_ord_recl normrM /Tnth (tuple_eta X) !tnth0/=. congr ((_ * `| _ |)%:E). by apply: eq_bigr => i _/=; rewrite !tnthS -tuple_eta. pose tuple_prod := (\prod_(i < n) Tnth (behead_tuple X) i)%R. @@ -618,13 +611,9 @@ rewrite [LHS](@integral_iproS _ _ _ _ _ MF); last first. by move: h1 => /Lfun1_integrable/integrableP[_]. by move: h2 => /Lfun1_integrable/integrableP[_]. under eq_fun. - move=> /=x. - rewrite /F/MF big_ord_recl/= /Tnth/= fctE tnth0. - rewrite fct_prodE. - under eq_bigr. - move=> i _. - rewrite tnthS. - over. + move=> /= x. + rewrite /F /MF big_ord_recl/= /Tnth/= fctE tnth0 fct_prodE. + under eq_bigr do rewrite tnthS. over. 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. @@ -635,35 +624,28 @@ have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < + 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. + by rewrite unlock fct_prodE. rewrite IH. rewrite ltey_eq prode_fin_num// => i _. rewrite expectation_fin_num//. exact/lfunX/mem_behead/mem_tnth. 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 /=. + (fun x => \prod_(i < n) tnth X (lift ord0 i) (tnth x i))%R. + apply: measurable_prod => //= i _. + by apply: measurableT_comp => //; exact: measurable_tnth. 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. + apply: eq_integral => x _ /=. + rewrite fct_prodE/=; congr (`| _ |%:E). + by apply: eq_bigr => i _; rewrite {1}(tuple_eta X) tnthS. rewrite -integral12_prod_meas2 /fubini_F/=; last first. apply/integrable21ltyP => //=. apply: measurableT_comp => //=; apply: measurable_funM => //=. exact: measurableT_comp. - apply: measurable_prod => //= i i_n. - apply: measurableT_comp => //. + apply: measurable_prod => //= i _; apply: measurableT_comp => //. exact: (measurableT_comp (measurable_tnth i) measurable_snd). under eq_integral => y _. under eq_integral => x _ do rewrite normrM EFinM. @@ -678,24 +660,22 @@ rewrite -integral12_prod_meas2 /fubini_F/=; last first. under eq_integral => x _. under eq_integral => y _ do rewrite EFinM. rewrite integralZl/=; last 2 first. - - apply: measurableT. - - by apply/integrableP; split => //; first by apply: measurableT_comp => //. + - exact: measurableT. + - by apply/integrableP; split => //; first exact: measurableT_comp. rewrite -[X in _ * X]fineK; last first. rewrite fin_num_abs. apply/abse_integralP => //. - exact/measurable_EFinP. + exact/measurable_EFinP. over. rewrite /= integralZr//; last exact/Lfun1_integrable/lfunX/mem_tnth. rewrite fineK; last first. - rewrite fin_num_abs. apply/abse_integralP => //. - exact/measurable_EFinP. + by 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 _. rewrite fct_prodE; congr (_%:E). apply: eq_bigr => i _. - rewrite tnth_behead. - congr (tnth X _ _). + rewrite tnth_behead; congr (tnth X _ _). by apply: val_inj => /=; rewrite /bump/= inordK// ltnS. rewrite IH; last by move => x /mem_behead/lfunX. rewrite big_ord_recl/=; congr (_ * _). @@ -809,17 +789,17 @@ 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_ipro_sum; last first. +rewrite expectation_power_measure_sum; last first. 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. Qed. -Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) : - (forall t, 0 <= bool_trial_value X t)%R. +Lemma bernoulli_trial_ge0 n (X : n.-tuple (bernoulliRV P p)) t : + (0 <= bool_trial_value X t)%R. Proof. -move=> t; rewrite [leRHS]fct_sumE; apply/sumr_ge0 => /= i _. +rewrite /bool_trial_value/= fct_sumE; apply/sumr_ge0 => /= i _. by rewrite /Tnth !tnth_map. Qed. @@ -834,7 +814,7 @@ transitivity ('E_(\X_n P)[ \prod_(i < n) Tnth (mktuple mmtX) i ]). rewrite fct_sumE big_distrl/= expR_sum [in RHS]fct_prodE. apply: eq_bigr => i _. by rewrite /Tnth !tnth_map /mmtX/= tnth_ord_tuple. -rewrite expectation_ipro_prod; last first. +rewrite expectation_power_measure_prod; last first. move=> _ /mapP [/= i _ ->]. apply/Lfun1_integrable/bounded_integrable => //. exists (expR `|t|); split => // M etM x _ /=. @@ -859,9 +839,8 @@ 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//. +have TAB : setT = A `|` B by rewrite -preimage_setU -setT_bool preimage_setT. +rewrite unlock TAB integral_setU_EFin -?TAB//. under eq_integral. move=> x /=. rewrite /A inE /bool_to_real /= => ->. @@ -952,9 +931,8 @@ apply: (le_trans (chernoff _ _ t0)). apply: (@le_trans _ _ ((expeR (mu * (expR t - 1)%:E)) * (expR (- (t * ((1 + delta) * fine mu))))%:E)). rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - rewrite (le_trans (mmt_gen_fun_expectation p01 _ (ltW t0)))//. -rewrite -(@fineK _ mu)//; last first. - by rewrite /mu expectation_bernoulli_trial. + by rewrite (le_trans (mmt_gen_fun_expectation p01 _ (ltW t0))). +rewrite -(@fineK _ mu)//; last by rewrite /mu expectation_bernoulli_trial. rewrite [expeR _]/= mulrC expRM -mulNr mulrA expRM. exact: end_thm24. Qed. @@ -964,6 +942,7 @@ 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. @@ -973,13 +952,15 @@ 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))) /=. +rewrite (derive_val (svalP (idf x0)))/=. clear idf. -rewrite exp_derive deriveM// derive_cst derive_id . +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//. @@ -989,61 +970,47 @@ 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. +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_lt_oc _ f 0 1). -- move=> t /[!in_itv] /= /andP [] + _. - by case/idf=> ? /@ex_derive. -- move=> t /[!in_itv] /= /andP [] t0 t1. - rewrite derive1E. - 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. +rewrite in_itv=> /andP[/= x0 x1]. +rewrite -/(f x) -f1E; apply: (@gtr0_derive1_lt_oc _ f 0 1). +- by move=> t /[!in_itv] /= /andP[+ _] => /idf[? /@ex_derive]. +- move=> t /[!in_itv] /= /andP[t0 t1]. + by rewrite derive1E Df_gt0// lt_eqF. +- apply: derivable_within_continuous => t /[!in_itv] /= /andP[+ _]. + by case/idf => ? /@ex_derive. +- by rewrite in_itv/= x0/= ltW. - by rewrite in_itv /= ltr01 lexx. -- assumption. +- exact: x1. 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_lt_cc _ f 1 x). -- 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). - rewrite derive1E. - 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. +have x0 := lt_trans ltr01 x1. +rewrite -/(f x) -f1E; apply: (@gtr0_derive1_lt_cc _ f 1 x). +- move=> t /[!in_itv] /= /andP[t1 _]. + by have /idf[? /@ex_derive] := lt_trans ltr01 t1. +- move=> t /[!in_itv] /= /andP[t1 tx]. + have t0 := lt_trans ltr01 t1. + by rewrite derive1E Df_gt0// gt_eqF. +- apply: derivable_within_continuous => t /[!in_itv] /= /andP[t1 _]. + by have /idf[? /@ex_derive] := lt_le_trans ltr01 t1. +- by rewrite in_itv/= lexx/= ltW. - by rewrite in_itv /= lexx andbT ltW. -- assumption. +- exact: x1. 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. +have -> : c = c' + 2 by rewrite /c' subrK. 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. +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. @@ -1176,8 +1143,8 @@ 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=> //. + apply: is_deriveM => //. + apply: is_derive1_comp => //. exact: is_derive1_ln. rewrite /df0. rewrite deriveD// derive_cst derive_id. @@ -1187,21 +1154,19 @@ have idf (y : R^o) : 0 < 1 + y -> is_derive y (1:R) f (df 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. + by rewrite in_itv /= => /andP[y0 t1]; rewrite ltr_wpDr. 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. + move=> /[dup] 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 2 1. + pose iy := Itv01 (ltW y0) (ltW y1). + have y1E : 1 + y = @convex.conv _ R^o iy 2 1. rewrite convRE /= /onem mulr1 (mulr_natr _ 2) mulr2n. by rewrite addrACA subrr addr0 addrC. - rewrite y1E; apply: (le_trans _ (concave_ln _ _ _))=> //. - rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 addr0 /=. + rewrite y1E; apply: le_trans (concave_ln _ _ _) => //. + rewrite -y1E addrAC subrr add0r convRE ln1 mulr0 addr0/=. rewrite mulrC ler_pM// ?(@ltW _ _ 0)// mulrC. rewrite ler_pdivrMr//. rewrite -[leLHS]expRK -[leRHS]expRK ler_ln ?posrE ?expR_gt0//. @@ -1215,7 +1180,7 @@ apply: (@ger0_derive1_le_cc R f 0 1). - 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. +- by have:= x01; rewrite in_itv=> /andP[/ltW]. Qed. End xlnx_bounding_with_interval. From 43eb2a9a88db6645d10ee812c99549e4b6a25933 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 8 Jul 2025 16:32:40 +0900 Subject: [PATCH 22/28] nitpicking --- theories/sampling.v | 83 ++++++++++++++++++++------------------------- 1 file changed, 36 insertions(+), 47 deletions(-) diff --git a/theories/sampling.v b/theories/sampling.v index 1c4049be1..3ca7a1570 100644 --- a/theories/sampling.v +++ b/theories/sampling.v @@ -565,7 +565,7 @@ Lemma expectation_power_measure_prod 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] lfunX/=. +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)//. @@ -573,7 +573,7 @@ pose F : n.+1.-tuple T -> R := (\prod_(i < n.+1) Tnth X i)%R. have mF : measurable_fun setT F by apply: measurable_prod_Tnth. pose build_mF := isMeasurableFun.Build _ _ _ _ F mF. pose MF : {mfun _ >-> _} := HB.pack F build_mF. -have h1 : (thead X : _ -> _) \in Lfun P 1 by exact/lfunX/mem_tnth. +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 => //. @@ -582,10 +582,10 @@ have h2 : (\prod_(i < n) Tnth (behead_tuple X) i)%R \in Lfun (\X_n P) 1. apply/abse_integralP => //=. by apply: measurableT_comp => //; exact: measurable_prod_Tnth. have := IH (behead_tuple X). - rewrite unlock /= => ->; last by move => x /mem_behead/lfunX. + rewrite unlock /= => ->; last by move => x /mem_behead/LfunX. rewrite abse_prod -ge0_fin_numE ?prode_ge0// prode_fin_num// => i _. rewrite abse_fin_num integrable_fin_num//. - exact/Lfun1_integrable/lfunX/mem_behead/mem_tnth. + exact/Lfun1_integrable/LfunX/mem_behead/mem_tnth. rewrite [LHS](@integral_power_measureS _ _ _ _ _ MF); last first. rewrite /MF/F; apply/integrableP; split; first exact: measurableT_comp. rewrite ge0_integral_power_measureS/=; [|exact: measurableT_comp|by []]. @@ -615,7 +615,7 @@ under eq_fun. rewrite /F /MF big_ord_recl/= /Tnth/= fctE tnth0 fct_prodE. under eq_bigr do rewrite tnthS. over. -have /Lfun1_integrable/integrableP/=[mXi iXi] := lfunX _ (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](_ : _ = @@ -627,9 +627,8 @@ have ? : \int[\X_n P]_x0 (\prod_(i < n) tnth X (lift ord0 i) (tnth x0 i))%:E < + by rewrite unlock fct_prodE. rewrite IH. rewrite ltey_eq prode_fin_num// => i _. - rewrite expectation_fin_num//. - exact/lfunX/mem_behead/mem_tnth. - by move=> Xi XiX; rewrite lfunX//= mem_behead. + by rewrite expectation_fin_num//; exact/LfunX/mem_behead/mem_tnth. + by move=> Xi XiX; rewrite LfunX//= mem_behead. have ? : measurable_fun [set: n.-tuple T] (fun x => \prod_(i < n) tnth X (lift ord0 i) (tnth x i))%R. apply: measurable_prod => //= i _. @@ -649,7 +648,7 @@ rewrite -integral12_prod_meas2 /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/lfunX/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//=. @@ -666,7 +665,7 @@ under eq_integral => x _. rewrite fin_num_abs. apply/abse_integralP => //. exact/measurable_EFinP. over. -rewrite /= integralZr//; last exact/Lfun1_integrable/lfunX/mem_tnth. +rewrite /= integralZr//; last exact/Lfun1_integrable/LfunX/mem_tnth. rewrite fineK; last first. by rewrite fin_num_abs; apply/abse_integralP => //; exact/measurable_EFinP. rewrite [X in _ * X](_ : _ = @@ -677,7 +676,7 @@ rewrite [X in _ * X](_ : _ = apply: eq_bigr => i _. rewrite tnth_behead; congr (tnth X _ _). by apply: val_inj => /=; rewrite /bump/= inordK// ltnS. -rewrite IH; last by move => x /mem_behead/lfunX. +rewrite IH; last by move => x /mem_behead/LfunX. rewrite big_ord_recl/=; congr (_ * _). apply: eq_bigr => /= i _. rewrite unlock /expectation. @@ -693,7 +692,7 @@ HB.mixin Record RV_isBernoulli d (T : measurableType d) (R : realType) #[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 & MeasurableFun d X}. + {X of @RV_isBernoulli _ _ _ P p X & }. Arguments bernoulliRV {d T R}. Section properties_of_BernoulliRV. @@ -825,25 +824,22 @@ apply: eq_bigr => /= i _. by congr expectation; rewrite tnth_map/= tnth_ord_tuple. Qed. -Arguments sub_countable [T U]. -Arguments card_le_finite [T U]. - Lemma bernoulli_mmt_gen_fun (X : bernoulliRV P p) (t : R) : 'M_P (bool_to_real R X) t = (p * expR t + (1 - p))%:E. Proof. -rewrite/mmt_gen_fun. -pose mmtX : {RV P >-> R : realType} := expR \o t \o* (bool_to_real R X). +rewrite /mmt_gen_fun. +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. 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 dAB : [disjoint A & B]. + by apply/disj_setPRL; rewrite /A /B preimage_true preimage_false. have TAB : setT = A `|` B by rewrite -preimage_setU -setT_bool preimage_setT. -rewrite unlock TAB integral_setU_EFin -?TAB//. +rewrite unlock TAB integral_setU_EFin//; last by rewrite -TAB. under eq_integral. move=> x /=. - rewrite /A inE /bool_to_real /= => ->. + rewrite /A inE/= /bool_to_real /= => ->. rewrite mul1r. over. rewrite integral_cst//. @@ -853,21 +849,18 @@ under eq_integral. rewrite mul0r. over. rewrite integral_cst//. -rewrite /A /B /preimage /=. -rewrite bernoulli_RV1 bernoulli_RV2. -rewrite -EFinD; congr (_ + _)%:E; rewrite mulrC//. -by rewrite expR0 mulr1. +rewrite /A /B /preimage /= bernoulli_RV1 bernoulli_RV2. +by rewrite expR0 mul1e muleC -EFinD. Qed. -(* wrong lemma *) Lemma binomial_mmt_gen_fun n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in 'M_(\X_n P) 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//. +under eq_bigr => i _ do rewrite bernoulli_mmt_gen_fun. +rewrite prodEFin prodr_const card_ord powR_mulrn//. by rewrite addr_ge0// ?subr_ge0// mulr_ge0// expR_ge0. Qed. @@ -876,15 +869,11 @@ Lemma mmt_gen_fun_expectation n (X_ : n.-tuple (bernoulliRV P p)) (t : R) : let X := bool_trial_value X_ : {RV \X_n P >-> R : realType} in 'M_(\X_n P) 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//. -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. +move=> t0 /=; have /andP[p0 p1] := p01. +rewrite binomial_mmt_gen_fun// expectation_bernoulli_trial//. +rewrite addrCA -[X in (_ * _ - X)%R](mulr1 p) -mulrBr/= lee_fin. +rewrite -mulrA (mulrC (n%:R)) expRM ge0_ler_powR ?nnegrE// ?expR_ge1Dx//. +by rewrite addr_ge0// mulr_ge0// subr_ge0 -expR0 ler_expR. Qed. End properties_of_BernoulliRV. @@ -896,7 +885,7 @@ 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]*) +(* [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 @@ -918,21 +907,21 @@ Qed. 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 - (\X_n P) [set i | X i >= (1 + delta) * fine mu]%R <= - ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine mu))%:E. + let m := 'E_(\X_n P)[X] in + (\X_n P) [set i | X i >= (1 + delta) * fine m]%R <= + ((expR delta / ((1 + delta) `^ (1 + delta))) `^ (fine m))%:E. Proof. rewrite /= => delta0. set X := bool_trial_value X_. -set mu := 'E_(\X_n P)[X]. +set m := '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 _ _ ((expeR (mu * (expR t - 1)%:E)) * - (expR (- (t * ((1 + delta) * fine mu))))%:E)). +apply: (@le_trans _ _ ((expeR (m * (expR t - 1)%:E)) * + (expR (- (t * ((1 + delta) * fine m))))%:E)). rewrite lee_pmul2r ?lte_fin ?expR_gt0//. - by rewrite (le_trans (mmt_gen_fun_expectation p01 _ (ltW t0))). -rewrite -(@fineK _ mu)//; last by rewrite /mu expectation_bernoulli_trial. + by rewrite (le_trans (mmt_gen_fun_expectation p01 _ (ltW _))). +rewrite -(@fineK _ m)//; last by rewrite /m expectation_bernoulli_trial. rewrite [expeR _]/= mulrC expRM -mulNr mulrA expRM. exact: end_thm24. Qed. @@ -1046,7 +1035,7 @@ 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)). + ((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] = From 8baaf862afc27dc46850d46ee96083ec98d17388 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 9 Jul 2025 08:36:25 +0200 Subject: [PATCH 23/28] Adding interval dependency to OPAM package --- coq-mathcomp-analysis-stdlib.opam | 1 + 1 file changed, 1 insertion(+) diff --git a/coq-mathcomp-analysis-stdlib.opam b/coq-mathcomp-analysis-stdlib.opam index ef8ac571e..274363ae9 100644 --- a/coq-mathcomp-analysis-stdlib.opam +++ b/coq-mathcomp-analysis-stdlib.opam @@ -17,6 +17,7 @@ install: [make "-C" "analysis_stdlib" "install"] depends: [ "coq-mathcomp-analysis" { = version} "coq-mathcomp-reals-stdlib" + "coq-interval" {>= "4.11.2"} ] tags: [ From 089fb26267b73d89dc1da91cbcfaad1beb6e076d Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 9 Jul 2025 08:51:02 +0200 Subject: [PATCH 24/28] [CI] Add interval dependency to mathcomp-analysis-stdlib --- .github/workflows/nix-action-8.20.yml | 8 +- .github/workflows/nix-action-9.0.yml | 4 +- .github/workflows/nix-action-master.yml | 78 +++++++++++++++++++ .nix/config.nix | 8 +- .nix/coq-nix-toolbox.nix | 2 +- .../mathcomp-analysis-stdlib/default.nix | 29 +++++++ 6 files changed, 122 insertions(+), 7 deletions(-) create mode 100644 .nix/coq-overlays/mathcomp-analysis-stdlib/default.nix diff --git a/.github/workflows/nix-action-8.20.yml b/.github/workflows/nix-action-8.20.yml index 7525dfc60..8c6b509fb 100644 --- a/.github/workflows/nix-action-8.20.yml +++ b/.github/workflows/nix-action-8.20.yml @@ -116,6 +116,10 @@ jobs: 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 != 'fetched' + 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 != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -357,9 +361,9 @@ jobs: run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: hierarchy-builder' + name: 'Building/fetching previous CI target: interval' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "hierarchy-builder" + job "interval" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr diff --git a/.github/workflows/nix-action-9.0.yml b/.github/workflows/nix-action-9.0.yml index c8d838127..ec9bc3682 100644 --- a/.github/workflows/nix-action-9.0.yml +++ b/.github/workflows/nix-action-9.0.yml @@ -290,9 +290,9 @@ jobs: run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr job "stdlib" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: hierarchy-builder' + name: 'Building/fetching previous CI target: interval' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr - job "hierarchy-builder" + job "interval" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr diff --git a/.github/workflows/nix-action-master.yml b/.github/workflows/nix-action-master.yml index 5c94b84c9..364a55f22 100644 --- a/.github/workflows/nix-action-master.yml +++ b/.github/workflows/nix-action-master.yml @@ -244,6 +244,84 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp" + mathcomp-analysis: + needs: + - coq + - mathcomp-reals + - mathcomp-bigenough + - hierarchy-builder + 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@v31 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v16 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepGetDerivation + name: Getting derivation for current job (mathcomp-analysis) + run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle + \"master\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2> err > out + || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: getting + derivation failed\"; exit 1; fi\n" + - id: stepCheck + name: Checking presence of CI target for current job + run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs + actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ + ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ + \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ + status=fetched\" >> $GITHUB_OUTPUT\nfi\n" + - if: steps.stepCheck.outputs.status != 'fetched' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "coq" + - if: steps.stepCheck.outputs.status != 'fetched' + name: 'Building/fetching previous CI target: mathcomp-reals' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "mathcomp-reals" + - if: steps.stepCheck.outputs.status != 'fetched' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "mathcomp-field" + - if: steps.stepCheck.outputs.status != 'fetched' + name: 'Building/fetching previous CI target: mathcomp-bigenough' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "mathcomp-bigenough" + - if: steps.stepCheck.outputs.status != 'fetched' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "hierarchy-builder" + - if: steps.stepCheck.outputs.status != 'fetched' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "mathcomp-analysis" mathcomp-analysis-single: needs: - coq diff --git a/.nix/config.nix b/.nix/config.nix index 1c2452fe0..836c0fc6e 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -24,6 +24,10 @@ in ## when calling `nix-shell` and `nix-build` without the `--argstr job` argument shell-attribute = "mathcomp-analysis-single"; + ## Set this when the package has no rocqPackages version yet + ## (either in nixpkgs or in .nix/rocq-overlays) + no-rocq-yet = true; + ## Maybe the shortname of the library is different from ## the name of the nixpkgs attribute, if so, set it here: # pname = "{{shortname}}"; @@ -63,8 +67,7 @@ in stdlib.override.version = "master"; rocq-elpi.override.version = "master"; rocq-elpi.override.elpi-version = "2.0.7"; - mathcomp-analysis.job = false; # current bug in coq-nix-toolbox - mathcomp-analysis-stdlib.job = false; + hierarchy-builder.override.version = "master"; }; coqPackages = common-bundle // { coq.override.version = "master"; stdlib.override.version = "master"; @@ -75,6 +78,7 @@ in mathcomp-bigenough.override.version = "master"; mathcomp-finmap.override.version = "master"; ssprove.job = false; + mathcomp-analysis-stdlib.job = false; # because of the interval dependency }; }; ## Cachix caches to use in CI diff --git a/.nix/coq-nix-toolbox.nix b/.nix/coq-nix-toolbox.nix index 17666c57c..5efeb2013 100644 --- a/.nix/coq-nix-toolbox.nix +++ b/.nix/coq-nix-toolbox.nix @@ -1 +1 @@ -"52aaa743836510268bf94deb898de0f8bd0501be" +"81869eb0d481e1902143b8c5201cfc488acdab22" diff --git a/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix b/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix new file mode 100644 index 000000000..ad94bdb2c --- /dev/null +++ b/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix @@ -0,0 +1,29 @@ +{ + lib, + mkCoqDerivation, + mathcomp-analysis, + mathcomp-reals-stdlib, + stdlib, + interval, + version ? null, +}: + +mkCoqDerivation { + + pname = "mathcomp-analysis-stdlib"; + repo = "analysis"; + owner = "math-comp"; + + release."1.12.0".sha256 = "sha256-PF10NlZ+aqP3PX7+UsZwgJT9PEaDwzvrS/ZGzjP64Wo="; + + defaultVersion = mathcomp-analysis.version; + + propagatedBuildInputs = [ mathcomp-analysis mathcomp-reals-stdlib stdlib interval ]; + + meta = { + description = "Compatibility between Analysis library and Stdlib"; + maintainers = [ lib.maintainers.cohencyril ]; + license = lib.licenses.cecill-c; + }; + +} From 57d7978a5afbc24ea733eda7ac1bfd5531f48f7c Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Wed, 9 Jul 2025 11:24:19 +0200 Subject: [PATCH 25/28] moving sampling.v to analysis_stdlib/ --- _CoqProject | 2 +- analysis_stdlib/Make | 1 + {theories => analysis_stdlib}/sampling.v | 0 theories/Make | 1 - 4 files changed, 2 insertions(+), 2 deletions(-) rename {theories => analysis_stdlib}/sampling.v (100%) diff --git a/_CoqProject b/_CoqProject index 45e35a9d8..d610b1c09 100644 --- a/_CoqProject +++ b/_CoqProject @@ -118,7 +118,7 @@ theories/charge.v theories/kernel.v theories/pi_irrational.v theories/gauss_integral.v -theories/sampling.v theories/showcase/summability.v +analysis_stdlib/sampling.v analysis_stdlib/Rstruct_topology.v analysis_stdlib/showcase/uniform_bigO.v diff --git a/analysis_stdlib/Make b/analysis_stdlib/Make index c34e45fe9..4c32a21da 100644 --- a/analysis_stdlib/Make +++ b/analysis_stdlib/Make @@ -7,5 +7,6 @@ -arg -w -arg -redundant-canonical-projection -arg -w -arg -projection-no-head-constant +sampling.v Rstruct_topology.v showcase/uniform_bigO.v diff --git a/theories/sampling.v b/analysis_stdlib/sampling.v similarity index 100% rename from theories/sampling.v rename to analysis_stdlib/sampling.v diff --git a/theories/Make b/theories/Make index 826718833..d80af9e6f 100644 --- a/theories/Make +++ b/theories/Make @@ -83,6 +83,5 @@ charge.v kernel.v pi_irrational.v gauss_integral.v -sampling.v all_analysis.v showcase/summability.v From ea5d7314626ad85bad42e8becbbc21702b7e9864 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 9 Jul 2025 13:04:53 +0200 Subject: [PATCH 26/28] [CI] New attempt --- .github/workflows/nix-action-8.20.yml | 22 +- .github/workflows/nix-action-9.0.yml | 22 +- .../mathcomp-analysis-single/default.nix | 6 +- .../mathcomp-analysis-stdlib/default.nix | 241 +++++++++++++++++- 4 files changed, 251 insertions(+), 40 deletions(-) diff --git a/.github/workflows/nix-action-8.20.yml b/.github/workflows/nix-action-8.20.yml index 8c6b509fb..661ca2719 100644 --- a/.github/workflows/nix-action-8.20.yml +++ b/.github/workflows/nix-action-8.20.yml @@ -287,6 +287,10 @@ jobs: 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 != 'fetched' + 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 != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr @@ -294,8 +298,6 @@ jobs: mathcomp-analysis-stdlib: needs: - coq - - mathcomp-analysis - - mathcomp-reals-stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -349,21 +351,17 @@ jobs: run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-analysis' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "mathcomp-analysis" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-reals-stdlib' + 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-reals-stdlib" + job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: stdlib' + name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "stdlib" + job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: interval' + name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr - job "interval" + job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr diff --git a/.github/workflows/nix-action-9.0.yml b/.github/workflows/nix-action-9.0.yml index ec9bc3682..5c5757882 100644 --- a/.github/workflows/nix-action-9.0.yml +++ b/.github/workflows/nix-action-9.0.yml @@ -216,6 +216,10 @@ jobs: name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr job "hierarchy-builder" + - if: steps.stepCheck.outputs.status != 'fetched' + name: 'Building/fetching previous CI target: interval' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr + job "interval" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr @@ -223,8 +227,6 @@ jobs: mathcomp-analysis-stdlib: needs: - coq - - mathcomp-analysis - - mathcomp-reals-stdlib runs-on: ubuntu-latest steps: - name: Determine which commit to initially checkout @@ -278,21 +280,17 @@ jobs: run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr job "coq" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-analysis' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr - job "mathcomp-analysis" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-reals-stdlib' + name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr - job "mathcomp-reals-stdlib" + job "mathcomp-field" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: stdlib' + name: 'Building/fetching previous CI target: mathcomp-bigenough' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr - job "stdlib" + job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: interval' + name: 'Building/fetching previous CI target: hierarchy-builder' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr - job "interval" + job "hierarchy-builder" - if: steps.stepCheck.outputs.status != 'fetched' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "9.0" --argstr diff --git a/.nix/coq-overlays/mathcomp-analysis-single/default.nix b/.nix/coq-overlays/mathcomp-analysis-single/default.nix index 5969982d2..94b21f8bf 100644 --- a/.nix/coq-overlays/mathcomp-analysis-single/default.nix +++ b/.nix/coq-overlays/mathcomp-analysis-single/default.nix @@ -1,2 +1,4 @@ -{ mathcomp-analysis, version ? null }: -mathcomp-analysis.override {single = true; inherit version;} +{ mathcomp-analysis, interval, version ? null }: +(mathcomp-analysis.overrideAttrs (o: + { propagatedBuildInputs = o.propagatedBuildInputs ++ [ interval ]; } +)).override {single = true; inherit version;} diff --git a/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix b/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix index ad94bdb2c..2a12d0ac8 100644 --- a/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix +++ b/.nix/coq-overlays/mathcomp-analysis-stdlib/default.nix @@ -1,29 +1,242 @@ { lib, mkCoqDerivation, - mathcomp-analysis, - mathcomp-reals-stdlib, + mathcomp, + mathcomp-finmap, + mathcomp-bigenough, + hierarchy-builder, stdlib, interval, + single ? false, + coqPackages, + coq, version ? null, -}: +}@args: -mkCoqDerivation { - - pname = "mathcomp-analysis-stdlib"; +let repo = "analysis"; owner = "math-comp"; release."1.12.0".sha256 = "sha256-PF10NlZ+aqP3PX7+UsZwgJT9PEaDwzvrS/ZGzjP64Wo="; + release."1.11.0".sha256 = "sha256-1apbzBvaLNw/8ARLUhGGy89CyXW+/6O4ckdxKPraiVc="; + 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 = mathcomp-analysis.version; - - propagatedBuildInputs = [ mathcomp-analysis mathcomp-reals-stdlib stdlib interval ]; + defaultVersion = + let + case = coq: mc: out: { + cases = [ + coq + mc + ]; + inherit out; + }; + in + with lib.versions; + lib.switch + [ coq.coq-version mathcomp.version ] + [ + (case (range "8.20" "9.1") (range "2.1.0" "2.4.0") "1.12.0") + (case (range "8.19" "8.20") (range "2.1.0" "2.3.0") "1.9.0") + (case (range "8.17" "8.20") (range "2.0.0" "2.2.0") "1.1.0") + (case (range "8.17" "8.19") (range "1.17.0" "1.19.0") "0.7.0") + (case (range "8.17" "8.18") (range "1.15.0" "1.18.0") "0.6.7") + (case (range "8.17" "8.18") (range "1.15.0" "1.18.0") "0.6.6") + (case (range "8.14" "8.18") (range "1.15.0" "1.17.0") "0.6.5") + (case (range "8.14" "8.18") (range "1.13.0" "1.16.0") "0.6.1") + (case (range "8.14" "8.18") (range "1.13" "1.15") "0.5.2") + (case (range "8.13" "8.15") (range "1.13" "1.14") "0.5.1") + (case (range "8.13" "8.15") (range "1.12" "1.14") "0.3.13") + (case (range "8.11" "8.14") (range "1.12" "1.13") "0.3.10") + (case (range "8.10" "8.12") "1.11.0" "0.3.3") + (case (range "8.10" "8.11") "1.11.0" "0.3.1") + (case (range "8.8" "8.11") (range "1.8" "1.10") "0.2.3") + ] + null; - meta = { - description = "Compatibility between Analysis library and Stdlib"; - maintainers = [ lib.maintainers.cohencyril ]; - license = lib.licenses.cecill-c; + # 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.ssreflect + 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.optional (lib.elem package [ + "reals-stdlib" + "analysis-stdlib" + "single" + ]) stdlib; + + 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-derivation4 = 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 ]; + } + ); + patched-derivation5 = patched-derivation4.overrideAttrs ( + o: + lib.optionalAttrs (o.version != null && (o.version == "dev" || lib.versions.isGe "1.13" o.version) && lib.elem package [ + "analysis-stdlib" + "single" + ]) + { + propagatedBuildInputs = o.propagatedBuildInputs ++ [ interval ]; + } + ); + in + patched-derivation5; +in +mathcomp_ (if single then "single" else "analysis") From 2e4192e17703df28d97babac2f6c4ea713c73ef1 Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Wed, 9 Jul 2025 14:03:26 +0200 Subject: [PATCH 27/28] [CI] Further fix --- .github/workflows/nix-action-master.yml | 96 ------------------------- .nix/config.nix | 1 + 2 files changed, 1 insertion(+), 96 deletions(-) diff --git a/.github/workflows/nix-action-master.yml b/.github/workflows/nix-action-master.yml index 364a55f22..ba01120ed 100644 --- a/.github/workflows/nix-action-master.yml +++ b/.github/workflows/nix-action-master.yml @@ -322,102 +322,6 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-analysis" - mathcomp-analysis-single: - needs: - - coq - - mathcomp-finmap - - mathcomp-bigenough - - mathcomp-bigenough - - stdlib - - hierarchy-builder - 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@v31 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v16 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepGetDerivation - name: Getting derivation for current job (mathcomp-analysis-single) - run: "NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle - \"master\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run 2> err - > out || (touch fail; true)\ncat out err\nif [ -e fail ]; then echo \"Error: - getting derivation failed\"; exit 1; fi\n" - - id: stepCheck - name: Checking presence of CI target for current job - run: "if $(cat out err | grep -q \"built:\") ; then\n echo \"CI target needs - actual building\"\n if $(cat out err | grep -q \"derivations will be built:\"\ - ) ; then\n echo \"waiting a bit for derivations that should be in cache\"\ - \n sleep 30\n fi\nelse\n echo \"CI target already built\"\n echo \"\ - status=fetched\" >> $GITHUB_OUTPUT\nfi\n" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: coq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "coq" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-ssreflect' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-ssreflect" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-algebra' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-algebra" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-finmap' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-finmap" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-bigenough' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-bigenough" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-field' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-field" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: mathcomp-bigenough' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-bigenough" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: stdlib' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "stdlib" - - if: steps.stepCheck.outputs.status != 'fetched' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "hierarchy-builder" - - if: steps.stepCheck.outputs.status != 'fetched' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "mathcomp-analysis-single" mathcomp-bigenough: needs: - coq diff --git a/.nix/config.nix b/.nix/config.nix index 836c0fc6e..191db4675 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -79,6 +79,7 @@ in mathcomp-finmap.override.version = "master"; ssprove.job = false; mathcomp-analysis-stdlib.job = false; # because of the interval dependency + mathcomp-analysis-single.job = false; # same }; }; ## Cachix caches to use in CI From 2dacfd1d905ce4e5af53acea6fdbabb7551e423a Mon Sep 17 00:00:00 2001 From: Alessandro Bruni Date: Thu, 14 Aug 2025 20:30:38 +0200 Subject: [PATCH 28/28] typo --- analysis_stdlib/sampling.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/analysis_stdlib/sampling.v b/analysis_stdlib/sampling.v index 3ca7a1570..81f272cbd 100644 --- a/analysis_stdlib/sampling.v +++ b/analysis_stdlib/sampling.v @@ -21,7 +21,7 @@ Unset Printing Implicit Defensive. (* # A Sampling Theorem *) (* *) (* This file contains a formalization of a sampling theorem. The proof is *) -(* decompose in two sections: sampling_theorem_part1 and *) +(* decomposed in two sections: sampling_theorem_part1 and *) (* sampling_theorem_part2. *) (* *) (* References: *)