Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Generalize operations of random variables and add trans_RV_unif and neg_RV_unif #135

Open
wants to merge 44 commits into
base: proba_port
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
44 commits
Select commit Hold shift + click to select a range
2a320f3
start porting proba.v
affeldt-aist Jul 17, 2024
cbe8f39
progress until log_RV
affeldt-aist Jul 17, 2024
3b27a8d
progress
affeldt-aist Jul 17, 2024
a9b3b12
prob.v done
affeldt-aist Jul 17, 2024
57db054
jfdist_cond done
affeldt-aist Jul 17, 2024
3c040ca
fsdist.v
t6s Jul 17, 2024
b16e4b8
convex_equiv
t6s Jul 17, 2024
548d795
graphoid
t6s Jul 17, 2024
afa1dcf
jensen
t6s Jul 17, 2024
c463d81
variation_dist
t6s Jul 17, 2024
a2c4c12
wip robustmean.v
t6s Jul 18, 2024
6629544
robustmean.v
t6s Jul 24, 2024
976086e
kill warnings in robustmean
t6s Jul 24, 2024
8a89cfe
divergence
affeldt-aist Jul 25, 2024
7401225
pinsker
affeldt-aist Jul 25, 2024
1b74b36
necset.v
affeldt-aist Jul 25, 2024
8f768fc
bayes.v
affeldt-aist Jul 29, 2024
f99f249
convex_equiv.v
affeldt-aist Jul 29, 2024
acced33
expected_value_variance.v
affeldt-aist Jul 29, 2024
1a95451
expected_value_variance_ordn.v
affeldt-aist Jul 29, 2024
d54cb02
divergence.v done
affeldt-aist Sep 26, 2024
ed54195
port log_sum.v
affeldt-aist Oct 3, 2024
f9850aa
port partition_inequality.v
affeldt-aist Oct 3, 2024
fe7efc3
prove pending admits
affeldt-aist Oct 3, 2024
d40692a
entropy.v
affeldt-aist Oct 4, 2024
79f0842
channel.v
affeldt-aist Oct 4, 2024
99d6ab9
pproba.v
affeldt-aist Oct 4, 2024
e0d698a
channel_code.v
affeldt-aist Oct 4, 2024
b59add2
shannon-fano
affeldt-aist Oct 4, 2024
cc2e53e
wip
affeldt-aist Oct 4, 2024
543a7ee
wip
affeldt-aist Oct 10, 2024
80b47ab
x_x2_max
t6s Oct 11, 2024
cd06457
mulr_reg{l,r}
t6s Oct 14, 2024
bfd9a4f
port pinsker; add derive_ext
t6s Oct 14, 2024
2091463
wip on bsc
t6s Oct 14, 2024
02c20b7
fix an occurrence {fdist _} overlooked in divergence.v
t6s Oct 14, 2024
8c5b6b6
remove Rstruct from entropy
t6s Oct 14, 2024
70660cd
typ_seq.v
affeldt-aist Nov 15, 2024
9402cff
WIP: generalize operations of random variables and add trans_RV_unif …
gregweng Dec 26, 2024
de6dc86
WIP: add bij_RV_unif by Jacques
gregweng Dec 26, 2024
88e6c81
revert to using fdisbindE
garrigue Dec 26, 2024
fa0c86a
separate bij_comp_RV
garrigue Dec 26, 2024
d991d71
no need to +2
t6s Dec 27, 2024
f4adc3f
no need to +1
t6s Dec 27, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions _CoqProject
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,10 @@ lib/ssrZ.v
lib/ssrR.v
lib/realType_ext.v
lib/Reals_ext.v
lib/realType_logb.v
lib/logb.v
lib/Ranalysis_ext.v
lib/derive_ext.v
lib/ssr_ext.v
lib/f2.v
lib/ssralg_ext.v
Expand Down
10 changes: 10 additions & 0 deletions changelog.txt
Original file line number Diff line number Diff line change
@@ -1,4 +1,14 @@

* added:
- in ssralg_ext.v
+ lemmas mulr_regl, mulr_regr
- in realType_ext.v
+ lemmas x_x2_eq, x_x2_max, x_x2_pos, x_x2_nneg, expR1_gt2
- new file derive_ext.v
+ lemmas differentiable_{ln, Log}
+ lemmas is_derive{D, B, N, M, V, Z, X, _sum}_eq
+ lemmas is_derive1_{lnf, lnf_eq, Logf, Logf_eq, LogfM, LogfM_eq, LogfV, LogfV_eq}
+ lemmas derivable1_mono, derivable1_homo

- lemma `conv_pt_cset_is_convex` changed into a `Let`

Expand Down
109 changes: 55 additions & 54 deletions information_theory/aep.v
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,8 @@
(* Copyright (C) 2020 infotheo authors, license: LGPL-2.1-or-later *)
From mathcomp Require Import all_ssreflect ssralg ssrnum matrix.
From mathcomp Require boolp.
Require Import Reals.
From mathcomp Require Import Rstruct.
Require Import ssrR Reals_ext realType_ext ssr_ext bigop_ext ssralg_ext logb.
From mathcomp Require Import reals exp Rstruct.
Require Import realType_ext ssr_ext bigop_ext ssralg_ext realType_logb.
Require Import fdist proba entropy.

(******************************************************************************)
Expand All @@ -26,62 +25,64 @@ Local Open Scope entropy_scope.
Local Open Scope ring_scope.
Local Open Scope vec_ext_scope.

Import Order.POrderTheory GRing.Theory Num.Theory.

Section mlog_prop.
Variables (A : finType) (P : {fdist A}).
Local Open Scope R_scope.
Context {R : realType}.
Variables (A : finType) (P : R.-fdist A).

Definition aep_sigma2 := `E ((`-- (`log P)) `^2) - (`H P)^2.
Definition aep_sigma2 : R := `E ((`-- (`log P)) `^2) - (`H P)^+2.

Lemma aep_sigma2E : aep_sigma2 = \sum_(a in A) P a * (log (P a))^2 - (`H P)^2.
Lemma aep_sigma2E : aep_sigma2 = \sum_(a in A) P a * (log (P a))^+2 - (`H P)^+2.
Proof.
rewrite /aep_sigma2 /Ex [in LHS]/log_RV /sq_RV /comp_RV.
by under eq_bigr do rewrite mulRC /ambient_dist -mulRR Rmult_opp_opp mulRR.
by under eq_bigr do rewrite mulrC /ambient_dist expr2 mulrNN -expr2.
Qed.

Lemma V_mlog : `V (`-- (`log P)) = aep_sigma2.
Proof.
rewrite aep_sigma2E /Var E_trans_RV_id_rem -entropy_Ex.
transitivity
(\sum_(a in A) ((- log (P a))^2 * P a - 2 * `H P * - log (P a) * P a +
`H P ^ 2 * P a))%R.
(\sum_(a in A) ((- log (P a))^+2 * P a - 2 * `H P * - log (P a) * P a +
`H P ^+ 2 * P a))%R.
apply eq_bigr => a _.
rewrite /scalel_RV /log_RV /neg_RV /trans_add_RV /sq_RV /comp_RV /= /sub_RV.
by rewrite /ambient_dist; field.
rewrite big_split /= big_split /= -big_distrr /= (FDist.f1 P) mulR1.
rewrite (_ : \sum_(a in A) - _ = - (2 * `H P ^ 2))%R; last first.
rewrite -{1}big_morph_oppR; congr (- _)%R.
by rewrite /ambient_dist -!mulrBl -mulrDl.
rewrite big_split /= big_split /= -big_distrr /= (FDist.f1 P) mulr1.
rewrite (_ : \sum_(a in A) - _ = - (2 * `H P ^+ 2))%R; last first.
rewrite -{1}big_morph_oppr; congr (- _)%R.
rewrite [X in X = _](_ : _ =
\sum_(a in A) (2 * `H P) * (- (P a * log (P a))))%R; last first.
by apply eq_bigr => a _; rewrite -!mulRA (mulRC (P a)) mulNR.
rewrite -big_distrr [in LHS]/= -{1}big_morph_oppR.
by rewrite -/(entropy P) -mulRA /= mulR1.
by apply eq_bigr => a _; rewrite (mulrC (P a)) -[in RHS]mulNr mulrA.
rewrite -big_distrr [in LHS]/= -{1}big_morph_oppr.
by rewrite -/(entropy P) expr2 mulrA.
set s := ((\sum_(a in A ) _)%R in LHS).
rewrite (_ : \sum_(a in A) _ = s)%R; last by apply eq_bigr => a _; field.
rewrite RpowE GRing.expr2 -!RmultE mulR1.
field.
rewrite (_ : \sum_(a in A) _ = s)%R; last first.
by apply eq_bigr => a _; rewrite sqrrN mulrC.
by rewrite (mulr_natl _ 2) mulr2n opprD addrA subrK.
Qed.

Lemma aep_sigma2_ge0 : 0 <= aep_sigma2.
Proof. rewrite -V_mlog /Var; apply Ex_ge0 => ?; exact: pow_even_ge0. Qed.

Proof. by rewrite -V_mlog /Var; apply: Ex_ge0 => ?; exact: sq_RV_ge0. Qed.
End mlog_prop.

Definition sum_mlog_prod (A : finType) (P : {fdist A}) n : {RV (P `^ n) -> R} :=
(fun t => \sum_(i < n) - log (P t ``_ i))%R.
Definition sum_mlog_prod {R : realType} (A : finType) (P : R.-fdist A) n :
{RV ((P `^ n)%fdist)-> R} :=
(fun t => \sum_(i < n) - log (P (t ``_ i)))%R.

Arguments sum_mlog_prod {A} _ _.
Arguments sum_mlog_prod {R} {A} _ _.

Lemma sum_mlog_prod_sum_map_mlog (A : finType) (P : {fdist A}) n :
Lemma sum_mlog_prod_sum_map_mlog {R : realType} (A : finType) (P : R.-fdist A) n :
sum_mlog_prod P n.+1 \=sum (\row_(i < n.+1) `-- (`log P)).
Proof.
elim : n => [|n IH].
- move: (@sum_n_1 A P (\row_i `-- (`log P))).
- move: (@sum_n_1 _ A P (\row_i `-- (`log P))).
set mlogP := cast_fun_rV10 _.
move => HmlogP.
set mlogprodP := @sum_mlog_prod _ _ 1.
set mlogprodP := @sum_mlog_prod _ _ _ 1.
suff -> : mlogprodP = mlogP by [].
rewrite /mlogprodP /mlogP /sum_mlog_prod /cast_fun_rV10 /= mxE /=.
by rewrite boolp.funeqE => ta; rewrite big_ord_recl big_ord0 addR0.
by rewrite boolp.funeqE => ta; rewrite big_ord_recl big_ord0 addr0.
- rewrite [X in _ \=sum X](_ : _ =
row_mx (\row_(i < 1) (`-- (`log P))) (\row_(i < n.+1) `-- (`log P))); last first.
apply/rowP => b; rewrite !mxE; case: splitP.
Expand All @@ -93,55 +94,55 @@ elim : n => [|n IH].
Qed.

Section aep_k0_constant.
Local Open Scope R_scope.
Variables (A : finType) (P : {fdist A}).
Context {R : realType}.
Variables (A : finType) (P : R.-fdist A).

Definition aep_bound epsilon := (aep_sigma2 P / epsilon ^ 3)%R.
Definition aep_bound epsilon : R := (aep_sigma2 P / epsilon ^+ 3)%R.

Lemma aep_bound_ge0 e (_ : 0 < e) : 0 <= aep_bound e.
Proof. apply divR_ge0; [exact: aep_sigma2_ge0 | exact/pow_lt]. Qed.
Proof. by apply divr_ge0; [exact: aep_sigma2_ge0 | apply/exprn_ge0/ltW]. Qed.

Lemma aep_bound_decreasing e e' : 0 < e' <= e -> aep_bound e <= aep_bound e'.
Proof.
case=> Oe' e'e.
apply leR_wpmul2l; first exact: aep_sigma2_ge0.
apply leR_inv => //; first exact/pow_lt.
apply pow_incr => //; split; [exact/ltRW | exact/e'e ].
case/andP=> Oe' e'e.
apply ler_wpM2l; first exact: aep_sigma2_ge0.
rewrite lef_pV2 ?posrE; [|apply/exprn_gt0..] => //; last first.
by rewrite (lt_le_trans _ e'e).
by rewrite lerXn2r// ?nnegrE ltW// (lt_le_trans _ e'e).
Qed.

End aep_k0_constant.


Section AEP.
Local Open Scope R_scope.
Variables (A : finType) (P : {fdist A}) (n : nat) (epsilon : R).
Context {R : realType}.
Variables (A : finType) (P : R.-fdist A) (n : nat) (epsilon : R).
Hypothesis Hepsilon : 0 < epsilon.

Lemma aep : aep_bound P epsilon <= n.+1%:R ->
Pr (P `^ n.+1) [set t | (0 < P `^ n.+1 t)%mcR &&
(`| (`-- (`log (P `^ n.+1)) `/ n.+1) t - `H P | >= epsilon)%mcR ] <= epsilon.
Pr (P `^ n.+1)%fdist [set t | (0 < (P `^ n.+1)%fdist t) &&
(`| (`-- (`log (P `^ n.+1)%fdist) `/ n.+1) t - `H P | >= epsilon)%mcR ] <= epsilon.
Proof.
move=> Hbound.
apply (@leR_trans (aep_sigma2 P / (n.+1%:R * epsilon ^ 2))); last first.
apply (@le_trans _ _ (aep_sigma2 P / (n.+1%:R * epsilon ^+ 2))); last first.
rewrite /aep_bound in Hbound.
apply (@leR_wpmul2r (epsilon / n.+1%:R)) in Hbound; last first.
apply divR_ge0; [exact/ltRW/Hepsilon | exact/ltR0n].
rewrite [in X in _ <= X]mulRCA mulRV ?INR_eq0' // ?mulR1 in Hbound.
apply/(leR_trans _ Hbound)/Req_le; field.
by split; [by rewrite INR_eq0 | exact/eqP/gtR_eqF].
apply (@ler_wpM2r _ (epsilon / n.+1%:R)) in Hbound; last first.
by rewrite divr_ge0// ltW.
rewrite [in X in _ <= X]mulrCA mulfV ?pnatr_eq0// ?mulr1 in Hbound.
apply/(le_trans _ Hbound).
rewrite [in leRHS]mulrA [in leRHS]exprSr [in leRHS]invfM.
rewrite -3![in leRHS]mulrA (mulrA epsilon^-1) mulVf ?gt_eqF// mul1r.
by rewrite (mulrC (n.+1%:R)) invfM.
have Hsum := sum_mlog_prod_sum_map_mlog P n.
have H1 k i : `E ((\row_(i < k.+1) `-- (`log P)) ``_ i) = `H P.
by rewrite mxE entropy_Ex.
have H2 k i : `V ((\row_(i < k.+1) `-- (`log P)) ``_ i) = aep_sigma2 P.
by rewrite mxE V_mlog.
have {H1 H2} := (wlln (H1 n) (H2 n) Hsum Hepsilon).
move/(leR_trans _); apply.
move/(le_trans _); apply.
apply/subset_Pr/subsetP => ta; rewrite 2!inE => /andP[H1].
rewrite /sum_mlog_prod [`-- (`log _)]lock /= -lock /= /scalel_RV /log_RV /neg_RV.
rewrite fdist_rVE.
rewrite log_prodR_sumR_mlog //.
move=> i; apply/RltP.
move: i; apply/prod_gt0_inv.
rewrite /sum_mlog_prod [`-- (`log _)]lock /= -lock /scalel_RV /log_RV /neg_RV/=.
rewrite fdist_rVE log_prodr_sumr_mlog //.
apply/prod_gt0_inv.
by move=> x; exact: FDist.ge0.
by move: H1; rewrite fdist_rVE.
Qed.
Expand Down
Loading
Loading