Skip to content

Commit

Permalink
minor fixes, updates, rebases
Browse files Browse the repository at this point in the history
  • Loading branch information
affeldt-aist committed Apr 30, 2024
1 parent e57a806 commit 5d96668
Show file tree
Hide file tree
Showing 8 changed files with 95 additions and 131 deletions.
3 changes: 2 additions & 1 deletion coq-mathcomp-analysis.opam
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,8 @@ depends: [
"coq-mathcomp-solvable" { (>= "2.0.0") | (= "dev") }
"coq-mathcomp-field"
"coq-mathcomp-bigenough" { (>= "1.0.0") }
"coq-mathcomp-algebra-tactics" { (>= "1.1.1") }
"coq-mathcomp-algebra-tactics" { (>= "1.2.0") }
"coq-mathcomp-zify" { (>= "1.4.0") }
]

tags: [
Expand Down
18 changes: 8 additions & 10 deletions theories/lang_syntax.v
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Require Import String.
From HB Require Import structures.
From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval.
From mathcomp.classical Require Import mathcomp_extra boolp classical_sets.
From mathcomp.classical Require Import functions cardinality fsbigop.
From mathcomp Require Import mathcomp_extra boolp classical_sets.
From mathcomp Require Import functions cardinality fsbigop.
Require Import signed reals ereal topology normedtype sequences esum measure.
Require Import lebesgue_measure numfun lebesgue_integral kernel prob_lang.
Require Import lang_syntax_util.
Expand Down Expand Up @@ -89,7 +89,7 @@ Proof. done. Qed.
Let mswap_sigma_additive x : semi_sigma_additive (mswap x).
Proof. exact: measure_semi_sigma_additive. Qed.

HB.instance Definition _ x := isMeasure.Build _ R _
HB.instance Definition _ x := isMeasure.Build _ _ R
(mswap x) (mswap0 x) (mswap_ge0 x) (@mswap_sigma_additive x).

Definition mkswap : _ -> {measure set Z -> \bar R} :=
Expand Down Expand Up @@ -185,24 +185,22 @@ Let T0 z : (T' z) set0 = 0. Proof. by []. Qed.
Let T_ge0 z x : 0 <= (T' z) x. Proof. by []. Qed.
Let T_semi_sigma_additive z : semi_sigma_additive (T' z).
Proof. exact: measure_semi_sigma_additive. Qed.
HB.instance Definition _ z := @isMeasure.Build _ R X (T' z) (T0 z) (T_ge0 z)
HB.instance Definition _ z := @isMeasure.Build _ X R (T' z) (T0 z) (T_ge0 z)
(@T_semi_sigma_additive z).

Let sfinT z : sfinite_measure (T' z). Proof. exact: sfinite_kernel_measure. Qed.
HB.instance Definition _ z := @Measure_isSFinite_subdef.Build _ X R
(T' z) (sfinT z).
HB.instance Definition _ z := @isSFinite.Build _ X R (T' z) (sfinT z).

Definition U' z : set Y -> \bar R := u z.
Let U0 z : (U' z) set0 = 0. Proof. by []. Qed.
Let U_ge0 z x : 0 <= (U' z) x. Proof. by []. Qed.
Let U_semi_sigma_additive z : semi_sigma_additive (U' z).
Proof. exact: measure_semi_sigma_additive. Qed.
HB.instance Definition _ z := @isMeasure.Build _ R Y (U' z) (U0 z) (U_ge0 z)
HB.instance Definition _ z := @isMeasure.Build _ Y R (U' z) (U0 z) (U_ge0 z)
(@U_semi_sigma_additive z).

Let sfinU z : sfinite_measure (U' z). Proof. exact: sfinite_kernel_measure. Qed.
HB.instance Definition _ z := @Measure_isSFinite_subdef.Build _ Y R
(U' z) (sfinU z).
HB.instance Definition _ z := @isSFinite.Build _ Y R (U' z) (sfinU z).

Lemma letin'C z A : measurable A ->
letin' t
Expand Down Expand Up @@ -271,7 +269,7 @@ Inductive typ :=
| Pair : typ -> typ -> typ
| Prob : typ -> typ.

Canonical stype_eqType := Equality.Pack (@gen_eqMixin typ).
HB.instance Definition _ := gen_eqMixin typ.

Fixpoint measurable_of_typ (t : typ) : {d & measurableType d} :=
match t with
Expand Down
104 changes: 41 additions & 63 deletions theories/lang_syntax_examples.v
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ Lemma letin'_sample_bernoulli d d' (T : measurableType d)
Proof.
rewrite letin'E/=.
rewrite ge0_integral_measure_sum// 2!big_ord_recl/= big_ord0 adde0/=.
by rewrite !ge0_integral_mscale//= !integral_dirac//= indicT 2!mul1e.
by rewrite !ge0_integral_mscale//= !integral_dirac//= !diracT 2!mul1e.
Qed.

Section letin'_return.
Expand All @@ -81,7 +81,7 @@ Lemma letin'_retk (f : X -> Y) (mf : measurable_fun setT f)
(k : R.-sfker Y * X ~> Z) x U :
measurable U -> letin' (ret mf) k x U = k (f x, x) U.
Proof.
move=> mU; rewrite letin'E retE integral_dirac ?indicT ?mul1e//.
move=> mU; rewrite letin'E retE integral_dirac ?diracT ?mul1e//.
exact: (measurableT_comp (measurable_kernel k _ mU)).
Qed.

Expand Down Expand Up @@ -209,48 +209,48 @@ Definition sample_pair_syntax : exp _ [::] _ :=
Lemma exec_sample_pair0 (A : set (bool * bool)) :
@execP R [::] _ sample_pair_syntax0 tt A =
((1 / 2)%:E *
((1 / 3)%:E * ((true, true) \in A)%:R%:E +
(1 - 1 / 3)%:E * ((true, false) \in A)%:R%:E) +
((1 / 3)%:E * \d_(true, true) A +
(1 - 1 / 3)%:E * \d_(true, false) A) +
(1 - 1 / 2)%:E *
((1 / 3)%:E * ((false, true) \in A)%:R%:E +
(1 - 1 / 3)%:E * ((false, false) \in A)%:R%:E))%E.
((1 / 3)%:E * \d_(false, true) A +
(1 - 1 / 3)%:E * \d_(false, false) A))%E.
Proof.
rewrite !execP_letin !execP_sample !execD_bernoulli execP_return /=.
rewrite execD_pair !exp_var'E (execD_var_erefl "x") (execD_var_erefl "y") /=.
rewrite letin'E integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e.
rewrite !integral_dirac//= !diracT !mul1e.
rewrite !letin'E !integral_measure_add//= !ge0_integral_mscale//= /onem.
by rewrite !integral_dirac//= !indicE !in_setT/= !mul1e !diracE.
by rewrite !integral_dirac//= !diracT !mul1e.
Qed.

Lemma exec_sample_pair0_TandT :
@execP R [::] _ sample_pair_syntax0 tt [set (true, true)] = (1 / 6)%:E.
Proof.
rewrite exec_sample_pair0 mem_set//; do 3 rewrite memNset//=.
rewrite exec_sample_pair0 !diracE mem_set//; do 3 rewrite memNset//=.
by rewrite /= !mule0 mule1 !add0e mule0 adde0; congr (_%:E); lra.
Qed.

Lemma exec_sample_pair0_TandF :
@execP R [::] _ sample_pair_syntax0 tt [set (true, false)] = (1 / 3)%:E.
Proof.
rewrite exec_sample_pair0 memNset// mem_set//; do 2 rewrite memNset//.
rewrite exec_sample_pair0 !diracE memNset// mem_set//; do 2 rewrite memNset//.
by rewrite /= !mule0 mule1 !add0e mule0 adde0; congr (_%:E); lra.
Qed.

Lemma exec_sample_pair0_TandT' :
@execP R [::] _ sample_pair_syntax0 tt [set p | p.1 && p.2] = (1 / 6)%:E.
Proof.
rewrite exec_sample_pair0 mem_set//; do 3 rewrite memNset//=.
rewrite exec_sample_pair0 !diracE mem_set//; do 3 rewrite memNset//=.
by rewrite /= !mule0 mule1 !add0e mule0 adde0; congr (_%:E); lra.
Qed.

Lemma exec_sample_pair_TorT :
(projT1 (execD sample_pair_syntax)) tt [set p | p.1 || p.2] = (2 / 3)%:E.
Proof.
rewrite execD_normalize_pt normalizeE/= exec_sample_pair0.
do 4 rewrite mem_set//=.
rewrite !diracE; do 4 rewrite mem_set//=.
rewrite eqe ifF; last by apply/negbTE/negP => /orP[/eqP|//]; lra.
rewrite exec_sample_pair0; do 3 rewrite mem_set//; rewrite memNset//=.
rewrite exec_sample_pair0 !diracE; do 3 rewrite mem_set//; rewrite memNset//=.
by rewrite !mule1; congr (_%:E); field.
Qed.

Expand All @@ -260,18 +260,17 @@ Definition sample_and_syntax0 : @exp R _ [::] _ :=
return #{"x"} && #{"y"}].

Lemma exec_sample_and0 (A : set bool) :
@execP R [::] _ sample_and_syntax0 tt A =
((1 / 6)%:E * (true \in A)%:R%:E +
(1 - 1 / 6)%:E * (false \in A)%:R%:E)%E.
@execP R [::] _ sample_and_syntax0 tt A = ((1 / 6)%:E * \d_true A +
(1 - 1 / 6)%:E * \d_false A)%E.
Proof.
rewrite !execP_letin !execP_sample !execD_bernoulli execP_return /=.
rewrite (@execD_bin _ _ binop_and) !exp_var'E (execD_var_erefl "x") (execD_var_erefl "y") /=.
rewrite letin'E integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e.
rewrite !integral_dirac//= !diracT !mul1e.
rewrite !letin'E !integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e !diracE.
rewrite !integral_dirac//= !diracT !mul1e.
rewrite muleDr// -addeA; congr (_ + _)%E.
by rewrite !muleA; congr (_%:E); congr (_ * _); field.
by rewrite !muleA; congr (_%:E); congr (_ * _); field.
rewrite -muleDl// !muleA -muleDl//.
by congr (_%:E); congr (_ * _); field.
Qed.
Expand All @@ -283,19 +282,18 @@ Definition sample_bernoulli_and3 : @exp R _ [::] _ :=
return #{"x"} && #{"y"} && #{"z"}].

Lemma exec_sample_bernoulli_and3 t U :
execP sample_bernoulli_and3 t U =
((1 / 8)%:E * (true \in U)%:R%:E +
(1 - 1 / 8)%:E * (false \in U)%:R%:E)%E.
execP sample_bernoulli_and3 t U = ((1 / 8)%:E * \d_true U +
(1 - 1 / 8)%:E * \d_false U)%E.
Proof.
rewrite !execP_letin !execP_sample !execD_bernoulli execP_return /=.
rewrite !(@execD_bin _ _ binop_and) !exp_var'E.
rewrite (execD_var_erefl "x") (execD_var_erefl "y") (execD_var_erefl "z") /=.
rewrite letin'E integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e.
rewrite !integral_dirac//= !diracT !mul1e.
rewrite !letin'E !integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e.
rewrite !integral_dirac//= !diracT !mul1e.
rewrite !letin'E !integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e !diracE.
rewrite !integral_dirac//= !diracT !mul1e.
rewrite !muleDr// -!addeA.
by congr (_ + _)%E; rewrite ?addeA !muleA -?muleDl//;
congr (_ * _)%E; congr (_%:E); field.
Expand All @@ -307,25 +305,6 @@ Definition sample_add_syntax0 : @exp R _ [::] _ :=
let "z" := Sample {exp_bernoulli (1 / 2)%:nng (p1S 1)} in
return #{"x"} && #{"y"} && #{"z"}].

Lemma exec_sample_bernoulli_and3 t U :
execP sample_bernoulli_and3 t U =
((1 / 8)%:E * (true \in U)%:R%:E +
(1 - 1 / 8)%:E * (false \in U)%:R%:E)%E.
Proof.
rewrite !execP_letin !execP_sample !execD_bernoulli execP_return /=.
rewrite !(@execD_bin _ _ binop_and) !exp_var'E.
rewrite (execD_var_erefl "x") (execD_var_erefl "y") (execD_var_erefl "z") /=.
rewrite letin'E integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e.
rewrite !letin'E !integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e.
rewrite !letin'E !integral_measure_add//= !ge0_integral_mscale//= /onem.
rewrite !integral_dirac//= !indicE !in_setT/= !mul1e !diracE.
rewrite !muleDr// -!addeA.
by congr (_ + _)%E; rewrite ?addeA !muleA -?muleDl//;
congr (_ * _)%E; congr (_%:E); field.
Qed.

End sample_pair.

Section bernoulli_examples.
Expand Down Expand Up @@ -357,24 +336,23 @@ rewrite !integral_measure_add //=; last by move=> b _; rewrite integral_ge0.
rewrite !ge0_integral_mscale //=; last 2 first.
by move=> b _; rewrite integral_ge0.
by move=> b _; rewrite integral_ge0.
rewrite !integral_dirac// !indicE !in_setT !mul1e.
rewrite !integral_dirac// !diracT !mul1e.
rewrite iteE/= !ge0_integral_mscale//=.
rewrite ger0_norm//.
rewrite !integral_indic//= !iteE/= /mscale/=.
rewrite setTI diracE !in_setT !mule1.
rewrite setTI !diracT !mule1.
rewrite ger0_norm//.
rewrite -EFinD/= eqe ifF; last first.
by apply/negbTE/negP => /orP[/eqP|//]; rewrite /onem; lra.
rewrite !letin'E/= !iteE/=.
rewrite !ge0_integral_mscale//=.
rewrite ger0_norm//.
rewrite !integral_dirac//= !indicE !in_setT /= !mul1e ger0_norm//.
rewrite !integral_dirac//= !diracT !mul1e ger0_norm//.
rewrite exp_var'E (execD_var_erefl "x")/=.
rewrite /bernoulli/= measure_addE/= /mscale/= !mul1r.
rewrite muleDl//; congr (_ + _)%E;
rewrite -!EFinM;
congr (_%:E);
by rewrite indicE /onem; case: (_ \in _); field.
by rewrite muleDl//; congr (_ + _)%E;
rewrite -!EFinM; congr (_%:E);
rewrite !indicT !indicE /onem /=; case: (_ \in _); field.
Qed.

Definition bernoulli12_score := [Normalize
Expand All @@ -400,25 +378,25 @@ rewrite !integral_measure_add //=; last by move=> b _; rewrite integral_ge0.
rewrite !ge0_integral_mscale //=; last 2 first.
by move=> b _; rewrite integral_ge0.
by move=> b _; rewrite integral_ge0.
rewrite !integral_dirac// !indicE !in_setT !mul1e.
rewrite !integral_dirac// !diracT !mul1e.
rewrite iteE/= !ge0_integral_mscale//=.
rewrite ger0_norm//.
rewrite !integral_indic//= !iteE/= /mscale/=.
rewrite setTI diracE !in_setT !mule1.
rewrite setTI !diracT !mule1.
rewrite ger0_norm//.
rewrite -EFinD/= eqe ifF; last first.
apply/negbTE/negP => /orP[/eqP|//].
by rewrite /onem; lra.
rewrite !letin'E/= !iteE/=.
rewrite !ge0_integral_mscale//=.
rewrite ger0_norm//.
rewrite !integral_dirac//= !indicE !in_setT /= !mul1e ger0_norm//.
rewrite !integral_dirac//= !diracT !mul1e ger0_norm//.
rewrite exp_var'E (execD_var_erefl "x")/=.
rewrite /bernoulli/= measure_addE/= /mscale/= !mul1r.
rewrite muleDl//; congr (_ + _)%E;
rewrite -!EFinM;
congr (_%:E);
by rewrite indicE /onem; case: (_ \in _); field.
by rewrite !indicT !indicE /onem /=; case: (_ \in _); field.
Qed.

(* https://dl.acm.org/doi/pdf/10.1145/2933575.2935313 (Sect. 4) *)
Expand Down Expand Up @@ -447,26 +425,26 @@ under eq_integral.
over.
rewrite !integral_measure_add //=; last by move=> b _; rewrite integral_ge0.
rewrite !ge0_integral_mscale //=; last 2 first.
by move=> b _; rewrite integral_ge0.
by move=> b _; rewrite integral_ge0.
rewrite !integral_dirac// !indicE !in_setT !mul1e.
by move=> b _; exact: integral_ge0.
by move=> b _; exact: integral_ge0.
rewrite !integral_dirac// !diracT !mul1e.
rewrite iteE/= !ge0_integral_mscale//=.
rewrite ger0_norm//.
rewrite !integral_indic//= !iteE/= /mscale/=.
rewrite setTI diracE !in_setT !mule1.
rewrite !integral_cst//= !diracT !(mule1,mul1e).
rewrite !iteE/= /mscale/= !diracT !mule1.
rewrite ger0_norm//.
rewrite -EFinD/= eqe ifF; last first.
apply/negbTE/negP => /orP[/eqP|//].
by rewrite /onem; lra.
rewrite !letin'E/= !iteE/=.
rewrite !ge0_integral_mscale//=.
rewrite ger0_norm//.
rewrite !integral_dirac//= !indicE !in_setT /= !mul1e ger0_norm//.
rewrite !integral_dirac//= !diracT !mul1e ger0_norm//.
rewrite /bernoulli/= measure_addE/= /mscale/= !mul1r.
rewrite muleDl//; congr (_ + _)%E;
rewrite -!EFinM;
congr (_%:E);
by rewrite indicE /onem; case: (_ \in _); field.
by rewrite !indicT !indicE /onem /=; case: (_ \in _); field.
Qed.

End bernoulli_examples.
Expand Down Expand Up @@ -494,7 +472,7 @@ Proof.
apply/eq_sfkernel => x U.
rewrite letin'E/= /sample; unlock.
rewrite integral_measure_add//= ge0_integral_mscale//= ge0_integral_mscale//=.
rewrite integral_dirac//= integral_dirac//= !indicT/= !mul1e.
rewrite !integral_dirac//= !diracT/= !mul1e.
by rewrite /mscale/= iteE//= iteE//= fail'E mule0 adde0 ger0_norm.
Qed.

Expand Down
6 changes: 3 additions & 3 deletions theories/lang_syntax_toy.v
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Require Import String Classical.
From HB Require Import structures.
From mathcomp Require Import all_ssreflect ssralg.
From mathcomp.classical Require Import mathcomp_extra boolp.
From mathcomp Require Import mathcomp_extra boolp.
Require Import signed reals topology normedtype.
Require Import lang_syntax_util.

Expand Down Expand Up @@ -36,7 +36,7 @@ Variables (R : realType).

Inductive typ := Real | Unit.

Canonical typ_eqType := Equality.Pack (@gen_eqMixin typ).
HB.instance Definition _ := gen_eqMixin typ.

Definition iter_pair (l : list Type) : Type :=
foldr (fun x y => (x * y)%type) unit l.
Expand Down Expand Up @@ -169,7 +169,7 @@ Implicit Types str : string.

Inductive typ := Real | Unit | Pair : typ -> typ -> typ.

Canonical typ_eqType := Equality.Pack (@gen_eqMixin typ).
HB.instance Definition _ := gen_eqMixin typ.

Fixpoint mtyp (t : typ) : Type :=
match t with
Expand Down
3 changes: 1 addition & 2 deletions theories/lang_syntax_util.v
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,7 @@ Require Import signed.
(* Shared by lang_syntax_*.v files *)
(******************************************************************************)

Definition string_eqMixin := @EqMixin string String.eqb eqb_spec.
Canonical string_eqType := EqType string string_eqMixin.
HB.instance Definition _ := hasDecEq.Build string eqb_spec.

Ltac inj_ex H := revert H;
match goal with
Expand Down
Loading

0 comments on commit 5d96668

Please sign in to comment.