(****************************************************************************** Markov's inequality.  Based on Wikipedia proof Copyright 2008 Robert Kam  This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.  This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.  You should have received a copy of the GNU Lesser General Public License along with this program.  If not, see <http://www.gnu.org/licenses/>. ******************************************************************************)
(* sigalg = sigma algebra preimg = preimage cntabl = countable msur = measure function msurable = measurable simple = simple function lebint = Lebesgue integral lebint_s = Lebesgue integral for simple function borl = Borel set unoin = union *)
(****************************************************************************** Note: chicli_pottier_simpson, classic, Extensionality_Ensembles, NNPP are used frequently Also lemmas from Rtopology which use classic as well as R_total_order ******************************************************************************)
Require Export Powerset.
Require Export Rtopology.
Require Export Raxioms.
Require Export Rfunctions.
Require Export Image.
Require Export RIneq.
Require Export PartSum.
intros EM. pose(select:=fun b:bool=>if b then P else ~P). assert{b:bool|
select b}as([|],HP). apply constructive_definite_description. rewrite<-
unique_existence;split. destruct EM. exists true;trivial. exists false;trivial.
intros[|][|]H1 H2;simpl in *;reflexivity||contradiction. left;trivial. right;
trivial. Qed.
Definition cntabl(U:Type)(C:Ensemble(Ensemble U)):=
exists f:nat->Ensemble U,forall c,C c->exists i:nat,f i=c.
(**)
intros sIH n. induction n. intros n' Hn'. apply sIH. intros. elimtype False;
intuition. intuition. Qed.
(**)
intros k. apply aaron_stump_cse545 with(Q:=fun z=>Q z->exists m,Q m/\forall n
,Q n->m<=n)(n:=k). 2:auto. intros n H H1. elim(classic(forall i,i<n->~Q i)).
intro H2. exists n. split. auto. intros j H3. apply NNPP. red;intro H4. apply(
H2 j). intuition. auto.
(**)
intro H2. assert(H3:exists i:nat,i<n/\Q i). apply NNPP. red;intro H3. apply H2.
intros i H4. red;intro H5. apply H3. exists i. auto. elim H3. intros ii H4.
elim(H ii). intros m H5. exists m. auto. tauto. tauto. Qed.
(**)
intros H. elim H. intros f H1. assert(H2:forall c,C c->{i|f i=c/\forall j,f
j=c->i<=j}). intros c H2. apply constructive_definite_description. elim(H1 c).
intros k H3. elim(first_sat(fun i=>f i=c)k). intros m H4. exists m. red. split.
auto. intuition. auto. auto.
(**)
exists(fun c c'=>proj1_sig(H2 c c')). split. intros. elim(proj2_sig(H2 c c')).
elim(proj2_sig(H2 c c'')). intuition. intros c cc c' cc' H3. elim(proj2_sig(H2
c c')). elim(proj2_sig(H2 cc cc')). intros H4 H5 H6 H7. rewrite<-H4. rewrite<-
H6. auto. Qed.
(**)
intros g g' g''. red. elim(classic(Inhabited _ C)). 2:intro H;exists(fun _:
nat=>Empty_set U);intros;elimtype False;apply H;exists c;auto. intro H. elim H.
intros d d'. assert(Q:forall i,{c|C c/\(forall z z',g z z'=i->c=z)/\((forall z
z',g z z'<>i)->c=d)}). intro. elim(chicli_pottier_simpson(exists z,C z/\forall
z',g z z'=i)(classic(exists z,C z/\forall z',g z z'=i))).
(**)
intro H1. assert(H2:exists!z,C z/\forall z',g z z'=i). elim H1. intros z z'.
exists z. split. auto. intros Z Z'. elim z';elim Z'. intros Z'' Z''' z'' z'''.
apply(g'' z Z z'' Z''). rewrite(Z''' Z''). auto. elim(
constructive_definite_description _ _ H2). intros z z'. elim z'. intros z''
z'''. exists z. split. auto. split. intros Z Z' Z''. apply(g'' z Z z'' Z').
rewrite Z'';auto. intro H3. elimtype False. apply(H3 z z''). auto.
(**)
intro H1. exists d. split. auto. split. intros z z' z''. elimtype False. apply
H1. exists z. split. auto. intro z'''. rewrite<-z''. apply g'. auto.
(**)
exists(fun i=>proj1_sig(Q i)). intros c c'. exists(g c c'). elim(proj2_sig(Q(g
c c'))). intros H1 H2. elim H2;intros H3 H4. eapply H3. intuition. Qed.
Definition unoin(U:Type)(C:Ensemble(Ensemble U)):=
fun x:U=>exists c,C c/\c x.
(*----------------------------------------------------------------------------- This and the following other two Definitions are the three parts of the definition of what it means to be a sigma-algebra. -----------------------------------------------------------------------------*)
Definition sigalg_0(U:Type)(F:Ensemble(Ensemble U)):=
Inhabited _ F.
Definition sigalg_1(U:Type)(F:Ensemble(Ensemble U)):=
forall A:Ensemble U,F A->F(Complement _ A).
Definition sigalg_2(U:Type)(F:Ensemble(Ensemble U)):=
forall C:Ensemble(Ensemble U),Included _ C F->cntabl _ C
->F(unoin _ C).
(**)
intros U F F' F'' F''' A B A' B'. set(f:=fun i:nat=>if(eq_nat_dec i 0)then A
else B). assert(H:unoin _(fun A=>exists i,f i=A)=Union _ A B). apply(
Extensionality_Ensembles U). split. red. intros x H. elim H. intros c H1. elim
H1. intros H2 H3. elim H2. intros i H4. rewrite<-H4 in H3. red in H3. elim(
eq_nat_dec i 0). intro a. rewrite a in H3. intuition. intro b. assert(H5:(if
eq_nat_dec i 0 then A else B)=B). elim(eq_nat_dec i 0). intuition. auto.
rewrite H5 in H3. intuition.
(**)
red. intros x H. elim H. intros. exists A. split. exists 0. auto. auto. intros.
exists B. split. exists 1. auto. auto. rewrite<-H. apply F'''. red. intros c c'
. elim c'. intros i i'. elim i'. elim(eq_nat_dec i 0). intro a. rewrite a. auto
. intro b. assert(H1:f i=B). unfold f. elim(eq_nat_dec i 0). intuition. auto.
rewrite H1. auto. red. exists f. auto. Qed.
(**)
intros. elim F'. intros A A'. cut(Empty_set U=Complement _(Union _ A(Complement
_ A))). intro H. rewrite H. apply F''. apply(sigalg_P0 _ F F' F'' F'''). auto.
apply F''. auto.
(**)
apply Extensionality_Ensembles. split. intuition. red. intros x x'. elimtype
False. elim(classic(A x)). intuition. intuition. Qed.
(**)
intros U F F' F'' F''' A B A' B'. cut(Intersection _ A B=Complement _(Union _(
Complement _ A)(Complement _ B))). intro H. rewrite H. apply F''. apply(
sigalg_P0 _ F F' F'' F'''). apply F''. auto. apply F''. auto.
(**)
apply Extensionality_Ensembles. split. red. unfold Complement;unfold In;unfold
not. intros x x' x''. elim(Intersection_inv _ _ _ _ x'). elim(Union_inv _ _ _ _
x''). auto. auto. split. apply NNPP. auto with sets. apply NNPP. auto with sets
. Qed.
(**)
intros. cut(Full_set U=Complement _(Empty_set U)). intro H. rewrite H. apply
F''. apply(sigalg_P1 _ F F' F'' F'''). apply Extensionality_Ensembles. split.
red. unfold Complement;unfold In. intuition. red. intros. apply Full_intro. Qed
.
Inductive borl(D:Ensemble R):Prop:=
|borl_0:open_set D->borl D
|borl_1:borl(Complement _ D)->borl D
|borl_2:forall C:Ensemble(Ensemble R),(forall c,C c->borl c)
->cntabl _ C->D=_D(unoin _ C)->borl D.
Definition preimg(U:Type)(f:U->R)(D:Ensemble R):=
fun x:U=>D(f x).
Definition msurable(U:Type)(F:Ensemble(Ensemble U))
(F':sigalg_0 _ F)(F'':sigalg_1 _ F)(F''':sigalg_2 _ F)
(f:U->R):=forall(D:Ensemble R),borl D->F(preimg _ f D).
(**)
intros. apply(Extensionality_Ensembles U). split. red;unfold In. intros x x'.
elim x'. unfold P. intuition. red;unfold In. intros x x'. unfold P. elim(
archimed(f x-a)). intros H H1;clear H1. induction(up(f x-a)). simpl in H.
elimtype False. apply(Rlt_not_ge(f x-a)0). auto. apply(Rplus_ge_reg_l a).
replace(a+(f x-a))%R with(f x). 2:ring. replace(a+0)%R with a. 2:ring. auto.
(**)
exists(nat_of_P p). split. intuition. unfold IZR in H. rewrite <- INR_IPR in H. apply Rge_le. apply Rgt_ge.
apply(Rplus_gt_reg_l(-a)%R). replace(-a+(a+INR(nat_of_P p)))%R with (INR(
nat_of_P p)). 2:ring. replace(-a+f x)%R with(f x-a)%R. 2:ring. auto.
(**)
unfold IZR in H; rewrite <- INR_IPR in H. elimtype False. apply(Rlt_not_ge(f x-a)0). apply Rgt_trans with(-
INR(nat_of_P p))%R. intuition. auto. apply(Rplus_ge_reg_l a). replace(a+(f x-a)
)%R with(f x). 2:ring. replace(a+0)%R with a. 2:ring. auto. Qed.
(**)
intros U F F' F'' F''' f f' f'' a a'. rewrite<-(msurable_P0 _ a f). set(P:=fun
i=>fun x=>(a<=f x<=a+INR i)%R). set(C:=fun A=>exists i,P i=A). assert(H:unoin _
C=fun x=>exists i,P i x%R). apply(Extensionality_Ensembles U). split. red.
intros x H. elim H. intros c H1. elim H1. intros H2 H3. elim H2. intros i H4.
red. exists i. rewrite<-H4 in H3. auto. red. intros x H. elim H. intros i H1.
red;red. exists(P i). split. exists i. auto. auto.
(**)
unfold P in H. rewrite<-H. apply F'''. intros c c'. elim c'. intros i i'.
rewrite<-i'. apply f'' with(D:=fun x=>(a<=x<=a+INR i)%R). apply borl_1. apply
borl_0. apply compact_P2. apply compact_P3. red. exists P. intuition. Qed.
Definition msur_0
(U:Type)(F:Ensemble(Ensemble U))(F':sigalg_0 _ F)(F'':sigalg_1 _ F)(F''':
sigalg_2 _ F)(u:forall A,F A->R):=
u(Empty_set _)(sigalg_P1 U F F' F'' F''')=0%R.
(*----------------------------------------------------------------------------- Countable additivity.  C is the countable collection, g is again the injective proof-irrelevant serial number mapping, and us is a list of the measures of the sets in the collection (sprinkled with zeroes throughout). ------------------------------------------------------------------------------- One note that might be interesting is that even though the hypotheses about 'us' 'force' the measure function u to be compatible when dealing with sets that are actually in C (as opposed to sets in the sigma-algebra F which are not known for sure if they are in C), one cannot generally prove (I think) that the measure function u is compatible from the hypotheses given here.  This was kind of a stumbling block and why I eventually had to add the 'msur_3' axiom below. -----------------------------------------------------------------------------*)
Definition msur_1
(U:Type)(F:Ensemble(Ensemble U))(F':sigalg_0 _ F)(F'':sigalg_1 _ F)(F''':
sigalg_2 _ F)(u:forall A,F A->R):=
forall C:Ensemble(Ensemble U),
forall C1:Included _ C F,
forall C2:forall c cc,C c->C cc->c<>cc->Disjoint _ c cc,
forall g:forall c,C c->nat,
forall g1:forall c c' c'',g c c'=g c c'',
forall g2:forall c cc c' cc',g c c'=g cc cc'->c=cc,
forall us:nat->R,
(forall c c',us(g c c')=u c(C1 _ c'))->
(forall n:nat,(forall c c',n<>g c c')->us n=0%R)->
forall l,infinit_sum us l->l
=u(unoin _ C)(F''' C C1(cntabl_P1 _ _ g g1 g2)).
(*----------------------------------------------------------------------------- probability spaces have measure 1 -----------------------------------------------------------------------------*)
Definition msur_2
(U:Type)(F:Ensemble(Ensemble U))(F':sigalg_0 _ F)(F'':sigalg_1 _ F)(F''':
sigalg_2 _ F)(u:forall A,F A->R):=
u (Full_set U) (sigalg_P3 U F F' F'' F''')=1%R.
Definition msur_3
(U:Type)(F:Ensemble(Ensemble U))(F':sigalg_0 _ F)(F'':sigalg_1 _ F)(F''':
sigalg_2 _ F)(u:forall A,F A->R):=
forall A A' A'',u A A'=u A A''.
Definition simple_0(U:Type)(n:nat)(v:nat->R)(w:nat->Ensemble U)
:=forall i j:nat,i<>j->Disjoint _(w i)(w j).
Definition simple_1(U:Type)(n:nat)(v:nat->R)(w:nat->Ensemble U)
:=forall x:U,exists i:nat,i<n/\w i x.
(*----------------------------------------------------------------------------- the list of range values for a simple function doesnt HAVE to be injective, but i thought itd be nice -----------------------------------------------------------------------------*)
Definition simple_2(U:Type)(n:nat)(v:nat->R)(w:nat->Ensemble U)
:=forall i j:nat,v i=v j->i=j.
Definition simple_3(U:Type)(n:nat)(v:nat->R)(w:nat->Ensemble U)
:=forall i:nat,(v i>=0)%R.
(*----------------------------------------------------------------------------- constructive 'get_index_of'-type function -----------------------------------------------------------------------------*)
Definition simple_P0
(U:Type)(n:nat)(v:nat->R)(w:nat->Ensemble U):simple_0 _ n v w->simple_1 _ n v w
->simple_2 _ n v w->simple_3 _ n v w->
forall x:U,{i:nat|i<n/\w i x/\forall i',w i' x->i'=i}.
(**)
intros S0 S1 S2 S3 x. assert(H:exists!i:nat,i<n/\w i x/\forall i',w i'
x->i'=i). elim(S1 x). intros i H. elim H. intros H1 H2. exists i. split. split.
auto. split. auto. intros i' H3. apply NNPP. unfold not;intro H4. elim(S0 i i')
. intro H5. apply(H5 x). intuition. auto. intuition. apply
constructive_definite_description. auto. Defined.
(**)
intros U F F' F'' F''' n v w S0 S1 S2 S3 M i. assert(H:w i=preimg _(fun x:U=>v(
proj1_sig(simple_P0 _ _ _ _ S0 S1 S2 S3 x)))(fun r:R=>v i<=r<=v i)%R). apply
Extensionality_Ensembles. split. red. red. red. intros x H1. elim(simple_P0 _ n
v w S0 S1 S2 S3 x). simpl. intros j H2. elim H2. intros H3 H4. elim H4.
intros H5 H6. elim(H6 i). intuition. auto.
(**)
red. unfold preimg;unfold In. intros x H1. rewrite(S2 i (proj1_sig(simple_P0 _
n v w S0 S1 S2 S3 x))). 2:intuition. elim(simple_P0 _ n v w S0 S1 S2 S3 x).
simpl. intuition. rewrite H. apply M. apply borl_1. apply borl_0. apply
compact_P2. apply compact_P3. Qed.
(**)
intros. red. intros i j H. split. intro x. red. intro H1. elim H1. intros y H2
H3. elim(eq_nat_dec i 0). intro a. rewrite a in H2. simpl in H2. elim(
eq_nat_dec j 0). intuition. intro bb. rewrite(if_r _ _ _(eq_nat_dec j 0)(
Complement _ A)(if eq_nat_dec j 1 then A else Empty_set _)bb)in H3. elim(
eq_nat_dec j 1). intro aaa. rewrite aaa in H3. simpl in H3. auto. intro bbb.
rewrite(if_r _ _ _(eq_nat_dec j 1)A(Empty_set _)bbb)in H3. elim H3.
(**)
intro b. rewrite(if_r _ _ _(eq_nat_dec i 0)(Complement _ A)(if eq_nat_dec i 1
then A else Empty_set _)b)in H2. elim(eq_nat_dec i 1). intro aa. rewrite aa in
H2. simpl in H2. elim(eq_nat_dec j 0). intro aaa. rewrite aaa in H3. simpl in
H3. auto. intro bbb. rewrite(if_r _ _ _(eq_nat_dec j 0)(Complement _ A)(if
eq_nat_dec j 1 then A else Empty_set _)bbb)in H3. elim(eq_nat_dec j 1).
intuition. intro bbbb. rewrite(if_r _ _ _(eq_nat_dec j 1)A(Empty_set _)bbbb) in
H3. elim H3. intro bb. rewrite(if_r _ _ _(eq_nat_dec i 1)A(Empty_set _)bb)in H2
. elim H2. Qed.
(**)
intros. red. intro x. elim(classic(A x)). intro. exists 1. auto. intro. exists
0. auto. Qed.
(**)
intros. red. intuition. Qed.
(**)
intros. red. intuition. Qed.

Lemma simple_P8:
forall(U:Type)(F:Ensemble(Ensemble U))(F':sigalg_0 _ F)(F'':sigalg_1 _ F)(F''':
sigalg_2 _ F),
forall A:Ensemble U,F A->
let n:=2 in
let v:=fun i:nat=>INR i in
let w:=fun i:nat=>if eq_nat_dec i 0 then Complement _ A else if
eq_nat_dec i 1 then A else Empty_set _ in
msurable _ _ F' F'' F''' (fun x:U=>v(proj1_sig(simple_P0 _ n v w
(simple_P4 _ _)(simple_P5 _ _)(simple_P6 _ _)(simple_P7 _ _) x))).