Skip to content

Commit 6e62b37

Browse files
exponential distribution (#1635)
Co-authored-by: IshiguroYoshihiro <jb.15r.1213@s.thers.ac.jp>
1 parent 0106af9 commit 6e62b37

File tree

3 files changed

+208
-9
lines changed

3 files changed

+208
-9
lines changed

CHANGELOG_UNRELEASED.md

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,17 @@
5555
- in `normed_module.v`:
5656
+ definition `pseudoMetric_normed`
5757
+ factory `Lmodule_isNormed`
58+
- in `num_normedtype.v`:
59+
+ lemmas `gt0_cvgMrNy`, `gt0_cvgMry`
60+
61+
- in `probability.v`:
62+
+ definition `exponential_pdf`
63+
+ lemmas `exponential_pdf_ge0`, `lt0_exponential_pdf`,
64+
`measurable_exponential_pdf`, `exponential_pdfE`,
65+
`in_continuous_exponential_pdf`, `within_continuous_exponential_pdf`
66+
+ definition `exponential_prob`
67+
+ lemmas `derive1_exponential_pdf`, `exponential_prob_itv0c`,
68+
`integral_exponential_pdf`, `integrable_exponential_pdf`
5869

5970
### Changed
6071

theories/normedtype_theory/num_normedtype.v

Lines changed: 17 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -505,22 +505,31 @@ rewrite pmulrn ceil_le_int// [ceil _]intEsign.
505505
by rewrite le_gtF ?expr0 ?mul1r ?lez_nat ?ceil_ge0//; near: n; apply: Foo.
506506
Unshelve. all: by end_near. Qed.
507507

508-
Lemma gt0_cvgMlNy {R : realFieldType} {F : set_system R} {FF : Filter F} (M : R)
509-
(f : R -> R) :
510-
(0 < M)%R -> (f r) @[r --> F] --> -oo -> (f r * M)%R @[r --> F] --> -oo.
508+
Section gt0_cvg.
509+
Context {R : realFieldType} {F : set_system R} {FF : Filter F}.
510+
Variables (M : R) (f : R -> R).
511+
Hypothesis M0 : 0 < M.
512+
513+
Lemma gt0_cvgMlNy : (f r) @[r --> F] --> -oo -> (f r * M)%R @[r --> F] --> -oo.
511514
Proof.
512-
move=> M0 /cvgrNyPle fy; apply/cvgrNyPle => A.
515+
move=> /cvgrNyPle fy; apply/cvgrNyPle => A.
513516
by apply: filterS (fy (A / M)) => x; rewrite ler_pdivlMr.
514517
Qed.
515518

516-
Lemma gt0_cvgMly {R : realFieldType} {F : set_system R} {FF : Filter F} (M : R)
517-
(f : R -> R) :
518-
(0 < M)%R -> f r @[r --> F] --> +oo -> (f r * M)%R @[r --> F] --> +oo.
519+
Lemma gt0_cvgMrNy : (f r) @[r --> F] --> -oo -> (M * f r)%R @[r --> F] --> -oo.
520+
Proof. by move=> fy; under eq_fun do rewrite mulrC; exact: gt0_cvgMlNy. Qed.
521+
522+
Lemma gt0_cvgMly : f r @[r --> F] --> +oo -> (f r * M)%R @[r --> F] --> +oo.
519523
Proof.
520-
move=> M0 /cvgryPge fy; apply/cvgryPge => A.
524+
move=> /cvgryPge fy; apply/cvgryPge => A.
521525
by apply: filterS (fy (A / M)) => x; rewrite ler_pdivrMr.
522526
Qed.
523527

528+
Lemma gt0_cvgMry : f r @[r --> F] --> +oo -> (M * f r)%R @[r --> F] --> +oo.
529+
Proof. by move=> fy; under eq_fun do rewrite mulrC; exact: gt0_cvgMly. Qed.
530+
531+
End gt0_cvg.
532+
524533
Lemma cvgNy_compNP {T : topologicalType} {R : numFieldType} (f : R -> T)
525534
(l : set_system T) :
526535
f x @[x --> -oo] --> l <-> (f \o -%R) x @[x --> +oo] --> l.
@@ -539,7 +548,6 @@ have f_opp : f =1 (fun x => (f \o -%R) (- x)) by move=> x; rewrite /comp opprK.
539548
by rewrite (eq_cvg +oo _ f_opp) fmap_comp ninfty.
540549
Qed.
541550

542-
543551
Section monotonic_itv_bigcup.
544552
Context {R : realType}.
545553
Implicit Types (F : R -> R) (a : R).

theories/probability.v

Lines changed: 180 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,8 @@ From mathcomp Require Import ftc gauss_integral.
5959
(* standard deviation s *)
6060
(* Using normal_peak and normal_pdf. *)
6161
(* normal_prob m s == normal probability measure *)
62+
(* exponential_pdf r == pdf of the exponential distribution with rate r *)
63+
(* exponential_prob r == exponential probability measure *)
6264
(* ``` *)
6365
(* *)
6466
(******************************************************************************)
@@ -1731,3 +1733,181 @@ apply: ge0_le_integral => //=.
17311733
Qed.
17321734

17331735
End normal_probability.
1736+
1737+
Section exponential_pdf.
1738+
Context {R : realType}.
1739+
Notation mu := lebesgue_measure.
1740+
Variable rate : R.
1741+
Hypothesis rate_gt0 : 0 < rate.
1742+
1743+
Let exponential_pdfT x := rate * expR (- rate * x).
1744+
Definition exponential_pdf := exponential_pdfT \_ `[0%R, +oo[.
1745+
1746+
Lemma exponential_pdf_ge0 x : 0 <= exponential_pdf x.
1747+
Proof.
1748+
by apply: restrict_ge0 => {}x _; apply: mulr_ge0; [exact: ltW|exact: expR_ge0].
1749+
Qed.
1750+
1751+
Lemma lt0_exponential_pdf x : x < 0 -> exponential_pdf x = 0.
1752+
Proof.
1753+
move=> x0; rewrite /exponential_pdf patchE ifF//.
1754+
by apply/negP; rewrite inE/= in_itv/= andbT; apply/negP; rewrite -ltNge.
1755+
Qed.
1756+
1757+
Let continuous_exponential_pdfT : continuous exponential_pdfT.
1758+
Proof.
1759+
move=> x.
1760+
apply: (@continuousM _ R^o (fun=> rate) (fun x => expR (- rate * x))).
1761+
exact: cst_continuous.
1762+
apply: continuous_comp; last exact: continuous_expR.
1763+
by apply: continuousM => //; apply: (@continuousN _ R^o); exact: cst_continuous.
1764+
Qed.
1765+
1766+
Lemma measurable_exponential_pdf : measurable_fun [set: R] exponential_pdf.
1767+
Proof.
1768+
apply/measurable_restrict => //; apply: measurable_funTS.
1769+
exact: continuous_measurable_fun.
1770+
Qed.
1771+
1772+
Lemma exponential_pdfE x : 0 <= x -> exponential_pdf x = exponential_pdfT x.
1773+
Proof.
1774+
by move=> x0; rewrite /exponential_pdf patchE ifT// inE/= in_itv/= x0.
1775+
Qed.
1776+
1777+
Lemma in_continuous_exponential_pdf :
1778+
{in `]0, +oo[%R, continuous exponential_pdf}.
1779+
Proof.
1780+
move=> x; rewrite in_itv/= andbT => x0.
1781+
apply/(@cvgrPdist_lt _ R^o) => e e0; near=> y.
1782+
rewrite 2?(exponential_pdfE (ltW _))//; last by near: y; exact: lt_nbhsr.
1783+
near: y; move: e e0; apply/(@cvgrPdist_lt _ R^o).
1784+
by apply: continuous_comp => //; exact: continuous_exponential_pdfT.
1785+
Unshelve. end_near. Qed.
1786+
1787+
Lemma within_continuous_exponential_pdf :
1788+
{within [set` `[0, +oo[%R], continuous exponential_pdf}.
1789+
Proof.
1790+
apply/continuous_within_itvcyP; split.
1791+
exact: in_continuous_exponential_pdf.
1792+
apply/(@cvgrPdist_le _ R^o) => e e0; near=> t.
1793+
rewrite 2?exponential_pdfE//.
1794+
near: t; move: e e0; apply/cvgrPdist_le.
1795+
by apply: cvg_at_right_filter; exact: continuous_exponential_pdfT.
1796+
Unshelve. end_near. Qed.
1797+
1798+
End exponential_pdf.
1799+
1800+
Definition exponential_prob {R : realType} (rate : R) :=
1801+
fun V => (\int[lebesgue_measure]_(x in V) (exponential_pdf rate x)%:E)%E.
1802+
1803+
Section exponential_prob.
1804+
Context {R : realType}.
1805+
Local Open Scope ring_scope.
1806+
Notation mu := lebesgue_measure.
1807+
Variable rate : R.
1808+
Hypothesis rate_gt0 : 0 < rate.
1809+
1810+
Lemma derive1_exponential_pdf :
1811+
{in `]0, +oo[%R, (fun x => - (expR : R^o -> R^o) (- rate * x))^`()%classic
1812+
=1 exponential_pdf rate}.
1813+
Proof.
1814+
move=> z; rewrite in_itv/= andbT => z0.
1815+
rewrite derive1_comp// derive1N// derive1_id mulN1r derive1_comp// derive1E.
1816+
have/funeqP -> := @derive_expR R.
1817+
by rewrite derive1Ml// derive1_id mulr1 mulrN opprK mulrC exponential_pdfE ?ltW.
1818+
Qed.
1819+
1820+
Let cexpNM : continuous (fun z : R^o => expR (- rate * z)).
1821+
Proof.
1822+
move=> z; apply: continuous_comp; last exact: continuous_expR.
1823+
by apply: continuousM => //; apply: (@continuousN _ R^o); exact: cst_continuous.
1824+
Qed.
1825+
1826+
Lemma exponential_prob_itv0c (x : R) : 0 < x ->
1827+
exponential_prob rate `[0, x] = (1 - (expR (- rate * x))%:E)%E.
1828+
Proof.
1829+
move=> x0.
1830+
rewrite (_: 1 = - (- expR (- rate * 0))%:E)%E; last first.
1831+
by rewrite mulr0 expR0 EFinN oppeK.
1832+
rewrite addeC.
1833+
apply: (@continuous_FTC2 _ _ (fun x => - expR (- rate * x))) => //.
1834+
- apply: (@continuous_subspaceW R^o _ _ [set` `[0, +oo[%R]).
1835+
+ exact: subset_itvl.
1836+
+ exact: within_continuous_exponential_pdf.
1837+
- split.
1838+
+ by move=> z _; exact: ex_derive.
1839+
+ by apply/cvg_at_right_filter; apply: cvgN; exact: cexpNM.
1840+
+ by apply/cvg_at_left_filter; apply: cvgN; exact: cexpNM.
1841+
- move=> z; rewrite in_itv/= => /andP[z0 _].
1842+
by apply: derive1_exponential_pdf; rewrite in_itv/= andbT.
1843+
Qed.
1844+
1845+
Lemma integral_exponential_pdf : (\int[mu]_x (exponential_pdf rate x)%:E = 1)%E.
1846+
Proof.
1847+
have mEex : measurable_fun setT (EFin \o exponential_pdf rate).
1848+
by apply/measurable_EFinP; exact: measurable_exponential_pdf.
1849+
rewrite -(setUv `[0, +oo[%classic) ge0_integral_setU//=; last 4 first.
1850+
exact: measurableC.
1851+
by rewrite setUv.
1852+
by move=> x _; rewrite lee_fin exponential_pdf_ge0.
1853+
exact/disj_setPCl.
1854+
rewrite [X in _ + X]integral0_eq ?adde0; last first.
1855+
by move=> x x0; rewrite /exponential_pdf patchE ifF// memNset.
1856+
rewrite (@ge0_continuous_FTC2y _ _
1857+
(fun x => - (expR (- rate * x))) _ 0)//.
1858+
- by rewrite mulr0 expR0 EFinN oppeK add0e.
1859+
- by move=> x _; apply: exponential_pdf_ge0.
1860+
- exact: within_continuous_exponential_pdf.
1861+
- rewrite -oppr0; apply: (@cvgN _ R^o).
1862+
rewrite (_ : (fun x => expR (- rate * x)) =
1863+
(fun z => expR (- z)) \o (fun z => rate * z)); last first.
1864+
by apply: eq_fun => x; rewrite mulNr.
1865+
apply: (@cvg_comp _ R^o _ _ _ _ (pinfty_nbhs R)); last exact: cvgr_expR.
1866+
exact: gt0_cvgMry.
1867+
- by apply: (@cvgN _ R^o); apply: cvg_at_right_filter; exact: cexpNM.
1868+
- exact: derive1_exponential_pdf.
1869+
Qed.
1870+
1871+
Lemma integrable_exponential_pdf :
1872+
mu.-integrable setT (EFin \o (exponential_pdf rate)).
1873+
Proof.
1874+
have mEex : measurable_fun setT (EFin \o exponential_pdf rate).
1875+
by apply/measurable_EFinP; exact: measurable_exponential_pdf.
1876+
apply/integrableP; split => //.
1877+
under eq_integral do rewrite /= ger0_norm ?exponential_pdf_ge0//.
1878+
by rewrite /= integral_exponential_pdf ltry.
1879+
Qed.
1880+
1881+
Local Notation exponential := (exponential_prob rate).
1882+
1883+
Let exponential0 : exponential set0 = 0%E.
1884+
Proof. by rewrite /exponential integral_set0. Qed.
1885+
1886+
Let exponential_ge0 A : (0 <= exponential A)%E.
1887+
Proof.
1888+
rewrite /exponential integral_ge0//= => x _.
1889+
by rewrite lee_fin exponential_pdf_ge0.
1890+
Qed.
1891+
1892+
Let exponential_sigma_additive : semi_sigma_additive exponential.
1893+
Proof.
1894+
move=> /= F mF tF mUF; rewrite /exponential; apply: cvg_toP.
1895+
apply: ereal_nondecreasing_is_cvgn => m n mn.
1896+
apply: lee_sum_nneg_natr => // k _ _; apply: integral_ge0 => /= x Fkx.
1897+
by rewrite lee_fin; apply: exponential_pdf_ge0.
1898+
rewrite ge0_integral_bigcup//=.
1899+
- apply/measurable_funTS/measurableT_comp => //.
1900+
exact: measurable_exponential_pdf.
1901+
- by move=> x _; rewrite lee_fin exponential_pdf_ge0.
1902+
Qed.
1903+
1904+
HB.instance Definition _ := isMeasure.Build _ _ _
1905+
exponential exponential0 exponential_ge0 exponential_sigma_additive.
1906+
1907+
Let exponential_setT : exponential [set: R] = 1%E.
1908+
Proof. by rewrite /exponential integral_exponential_pdf. Qed.
1909+
1910+
HB.instance Definition _ :=
1911+
@Measure_isProbability.Build _ _ R exponential exponential_setT.
1912+
1913+
End exponential_prob.

0 commit comments

Comments
 (0)