(* Copyright 2012-2015 by Adam Petcher.				* * Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
(* Rules used to prove facts based on the distribution semantics *)
Set Implicit Arguments.
Local Open Scope rat_scope.
Local Open Scope comp_scope.
Local Open Scope list_scope.
intuition.
unfold evalDist.
eapply eqRat_refl.
Qed.
intros.
specialize (getSupport_correct c1).
specialize (getSupport_correct c2).
intros.
inversion H0; clear H0.
inversion H1; clear H1.
intuition.
apply H3.
intuition.
eapply H4; eauto.
eapply eqRat_trans.
eapply H.
eauto.
eapply H4.
intuition.
eapply H3; eauto.
eapply eqRat_trans.
eapply eqRat_symm.
eapply H.
eauto.
Qed.
intuition.
eapply NoDup_Permutation; intuition.
apply in_map_iff in H3.
destruct H3.
intuition.
subst.
eapply H0.
trivial.
eapply in_map_iff.
econstructor.
split.
2:{
eapply H0.
assert (x = f (f_inv x)).
symmetry.
eapply H.
trivial.
rewrite H4 in H3.
eapply H3.
}
eapply H.
trivial.
Qed.
induction ls; intuition.
simpl in *.
intuition.
eapply H1.
rewrite <- (H a).
rewrite <- (H a0).
f_equal.
trivial.
eapply IHls; eauto.
Qed.
induction ls; intuition; simpl in *.
econstructor.
inversion H0; clear H0; subst.
econstructor; eauto.
intuition.
apply in_map_iff in H0.
destruct H0.
intuition.
assert (x = a).
rewrite <- (H x); intuition.
rewrite <- (H a); intuition.
f_equal.
trivial.
subst.
intuition.
Qed.
intuition.
specialize (getSupport_correct c); intuition.
inversion H.
eauto.
Qed.
induction ls; simpl in *; intuition.
inversion H; clear H; subst.
destruct (P a).
econstructor; eauto.
intuition.
eapply filter_In in H.
intuition.
eapply IHls; eauto.
Qed.
intuition.
eapply NoDup_Permutation.
eapply map_NoDup.
intuition.
eapply getSupport_NoDup.
eapply getSupport_NoDup.
intuition.
apply in_map_iff in H3.
destruct H3.
intuition.
subst.
eapply getSupport_In_evalDist.
intuition.
eapply getSupport_In_evalDist.
eauto.
eapply eqRat_trans.
eapply H1.
trivial.
trivial.
eapply in_map_iff.
econstructor.
split.
eapply H.
trivial.
eapply getSupport_In_evalDist.
intuition.
eapply getSupport_In_evalDist.
eapply H3.
rewrite H2.
trivial.
trivial.
Qed.
intuition.
eapply NoDup_Permutation.
eapply filter_NoDup.
eapply support_NoDup.
eapply filter_NoDup.
eapply support_NoDup.
intuition.
eapply filter_In in H0.
eapply filter_In.
intuition.
eapply getSupport_In_evalDist.
apply getSupport_In_evalDist in H1.
intuition.
apply H1.
eapply eqRat_trans.
eapply H.
trivial.
trivial.
intuition.
eapply filter_In in H0.
eapply filter_In.
intuition.
eapply getSupport_In_evalDist.
apply getSupport_In_evalDist in H1.
intuition.
apply H1.
eapply eqRat_trans.
eapply eqRat_symm.
eapply H.
trivial.
trivial.
Qed.
intuition.
rewrite <- map_id.
eapply Permutation_sym.
eapply evalDist_getSupport_perm; intuition.
symmetry.
eauto.
Qed.
intuition.
unfold sumList.
eapply fold_add_f_inverse;
intuition.
Qed.
intuition.
simpl.
eapply eqRat_trans.
eapply fold_add_rat_perm.
eapply Permutation_sym.
eapply evalDist_getSupport_perm; eauto.
intuition.
symmetry.
eauto.
intuition.
rewrite <- (H a0) at 1.
eapply H2.
eauto.
trivial.
eapply eqRat_refl.
intuition.
eapply ratMult_eqRat_compat.
rewrite <- H at 1.
eauto.
trivial.
rewrite <- H at 1.
eapply H3.
eauto.
trivial.
eapply eqRat_trans.
2:{
eapply fold_add_f_inverse; eauto.
eapply eqRat_refl.
}
simpl.
eapply eqRat_refl.
Qed.
intuition.
eapply (distro_iso_eq (fun b => b)(fun b => b)); intuition.
eapply getSupport_In_evalDist.
intuition.
eapply getSupport_In_evalDist.
eauto.
rewrite H.
trivial.
eapply H0.
eapply getSupport_In_evalDist.
intuition.
eapply getSupport_In_evalDist.
eauto.
rewrite <- H.
trivial.
Qed.
intuition.
simpl.
rewrite sumList_body_eq.
2:{
intuition.
rewrite H0 at 1.
eapply eqRat_refl.
trivial.
}
rewrite sumList_factor_constant_r.
rewrite evalDist_lossless.
eapply ratMult_1_l.
trivial.
Qed.
induction ls; simpl in *; intuition.
destruct (P a); simpl.
eapply IHls.
rewrite fold_add_body_eq.
eapply IHls.
symmetry.
eapply ratAdd_0_r.
intuition.
Qed.
intuition.
simpl.
unfold sumList.
simpl.
destruct (EqDec_dec eqd b b).
rewrite <- ratAdd_0_l.
rewrite ratMult_1_l.
intuition.
congruence.
Qed.
unfold dist_sem_eq.
intuition.
assert (EqDec B).
eapply bind_EqDec; eauto.
simpl.
eapply eqRat_trans.
eapply sumList_body_eq.
intuition.
symmetry.
eapply sumList_factor_constant_r.
simpl.
rewrite sumList_comm.
eapply sumList_body_eq.
intuition.
rewrite <- sumList_factor_constant_l.
eapply eqRat_trans.
eapply (sumList_filter_partition (fun b => if (in_dec (EqDec_dec _) b (getSupport (c2 a0))) then true else false)).
eapply eqRat_trans.
eapply ratAdd_eqRat_compat.
eapply eqRat_refl.
eapply sumList_0.
intuition.
eapply filter_In in H1.
intuition.
destruct (in_dec (EqDec_dec H) a1 (getSupport (c2 a0))).
simpl in H3.
discriminate.
assert (evalDist (c2 a0) a1 == 0).
eapply getSupport_not_In_evalDist.
trivial.
rewrite H1.
rewrite ratMult_0_r.
eapply ratMult_0_l.
rewrite <- ratAdd_0_r.
eapply eqRat_trans.
eapply sumList_permutation.
2:{
eapply sumList_body_eq.
intuition.
eapply ratMult_assoc.
}
eapply NoDup_Permutation.
eapply filter_NoDup.
eapply getUnique_NoDup.
eapply getSupport_NoDup.
intuition.
apply filter_In in H1.
intuition.
destruct (in_dec (EqDec_dec H) x (getSupport (c2 a0))).
trivial.
discriminate.
eapply filter_In.
intuition.
eapply in_getUnique.
eapply in_flatten.
econstructor.
split.
eapply in_map_iff.
econstructor.
split.
eapply eq_refl.
eauto.
eauto.
destruct (in_dec (EqDec_dec H) x (getSupport (c2 a0)) ).
trivial.
intuition.
Qed.
intuition.
unfold dist_sem_eq.
intuition.
simpl.
eapply eqRat_trans.
eapply sumList_body_eq.
intuition.
symmetry.
eapply sumList_factor_constant_l.
symmetry.
eapply eqRat_trans.
eapply sumList_body_eq.
intuition.
symmetry.
eapply sumList_factor_constant_l.
rewrite sumList_summation.
eapply sumList_body_eq.
intuition.
eapply sumList_body_eq.
intuition.
repeat rewrite <- ratMult_assoc.
eapply ratMult_eqRat_compat; intuition.
eapply ratMult_comm.
Qed.
intuition.
simpl.
eapply ratMult_eqRat_compat; intuition.
eapply ratMult_eqRat_compat.
unfold indicator.
rewrite H0.
intuition.
eapply ratInverse_eqRat_compat.
intuition.
eapply getSupport_In_evalDist.
eapply filter_In.
eauto.
eapply sumList_0 in H3; eauto.
trivial.
Qed.
Definition intersect(A : Set)(eqd : eq_dec A)(ls1 ls2 : list A) :=
filter (fun x => if (in_dec eqd x ls1) then true else false) ls2.
unfold intersect in *.
intuition.
apply filter_In in H.
intuition.
destruct (in_dec eqd a ls1).
trivial.
discriminate.
apply filter_In in H.
intuition.
eapply filter_In.
intuition.
destruct (in_dec eqd a ls1); intuition.
Qed.
intuition.
eapply NoDup_Permutation.
apply filter_NoDup; trivial.
apply filter_NoDup; trivial.
unfold intersect in *.
intuition.
apply filter_In.
apply filter_In in H1.
intuition.
destruct (in_dec eqd x ls1); intuition.
discriminate.
destruct (in_dec eqd x ls2); intuition.
apply filter_In.
apply filter_In in H1.
intuition.
destruct (in_dec eqd x ls2); intuition.
discriminate.
destruct (in_dec eqd x ls1); intuition.
Qed.
intuition.
simpl in *.
rewrite (sumList_filter_partition (@snd A bool)).
rewrite (sumList_filter_partition (@snd A bool) (getSupport c2)).
rewrite ratDistance_add_same_r_gen.
eapply leRat_trans.
eapply ratDistance_le_max_triv.
eapply maxRat_leRat_same.
eapply leRat_trans.
2:{
eapply sumList_filter_le.
}
eapply sumList_le; intuition.
apply filter_In in H1.
intuition.
eapply ratMult_leRat_compat; intuition.
destruct a0.
simpl in *.
subst.
destruct (EqDec_dec bool_EqDec true true); try congruence.
destruct (EqDec_dec eqda a0 a); intuition.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
symmetry.
eapply H.
}
eapply leRat_trans.
2:{
eapply sumList_filter_le.
}
eapply sumList_le; intuition.
apply filter_In in H1.
intuition.
eapply ratMult_leRat_compat; intuition.
destruct a0.
simpl in *.
subst.
destruct (EqDec_dec bool_EqDec true true); try congruence.
destruct (EqDec_dec eqda a0 a); intuition.
assert (eq_dec (A * bool)).
unfold eq_dec.
eapply (EqDec_dec (pair_EqDec _ _)).
assert (NoDup (filter (fun a0 : A * bool => negb (snd a0)) (intersect H1 (getSupport c1) (getSupport c2)))).
eapply filter_NoDup.
eapply filter_NoDup; eapply getSupport_NoDup.
eapply eqRat_trans.
symmetry.
eapply sumList_subset'.
trivial.
eapply H2.
eapply filter_NoDup.
eapply getSupport_NoDup.
intuition.
apply filter_In in H3.
intuition.
eapply filter_In.
split.
eapply in_intersect.
eapply Permutation_in.
eapply intersect_comm.
eapply getSupport_NoDup.
2:{
eauto.
}
eapply getSupport_NoDup.
trivial.
intuition.
apply filter_In in H3.
intuition.
destruct a0.
simpl in *.
destruct (EqDec_dec eqda a0 a); subst.
rewrite ratMult_1_r.
destruct b; simpl in *; try discriminate.
rewrite H0.
eapply getSupport_not_In_evalDist.
intuition.
eapply H4.
eapply filter_In.
intuition.
eapply in_intersect.
intuition.
apply ratMult_0_r.
symmetry.
eapply eqRat_trans.
symmetry.
eapply sumList_subset'.
trivial.
eapply H2.
eapply filter_NoDup.
eapply getSupport_NoDup.
intuition.
apply filter_In in H3.
intuition.
eapply filter_In.
split.
eapply in_intersect.
eauto.
trivial.
intuition.
apply filter_In in H3.
intuition.
destruct a0.
simpl in *.
destruct (EqDec_dec eqda a0 a); subst.
rewrite ratMult_1_r.
destruct b; simpl in *; try discriminate.
rewrite <- H0.
eapply getSupport_not_In_evalDist.
intuition.
eapply H4.
eapply filter_In.
intuition.
eapply in_intersect.
intuition.
apply ratMult_0_r.
eapply sumList_body_eq.
intuition.
apply filter_In in H3.
intuition.
destruct a0; simpl in *.
destruct b; simpl in *; try discriminate.
rewrite H0.
intuition.
Qed.
intuition.
destruct (in_dec (EqDec_dec eqd) a (getSupport c)).
simpl.
eapply eqRat_trans.
eapply sumList_exactly_one.
eapply getSupport_NoDup.
eauto.
intuition.
destruct (EqDec_dec eqd b a).
subst.
intuition.
eapply ratMult_0_r.
destruct (EqDec_dec eqd a a).
eapply ratMult_1_r.
congruence.
simpl.
eapply eqRat_trans.
eapply sumList_0.
intuition.
destruct (EqDec_dec eqd a0 a).
subst.
intuition.
eapply ratMult_0_r.
symmetry.
eapply getSupport_not_In_evalDist.
trivial.
Qed.
intuition.
specialize (@fundamental_lemma_h B eqdb (a <-$ c1; ret (proj a, badness a)) (a <-$ c2; ret (proj a, badness a)) ); intuition.
assert ( | evalDist (x <-$ (a0 <-$ c1; ret (proj a0, badness a0)); ret fst x) x -
evalDist (x <-$ (a0 <-$ c2; ret (proj a0, badness a0)); ret fst x) x | ==
| evalDist (a <-$ c1; ret proj a) x - evalDist (a <-$ c2; ret proj a) x |).
eapply ratDistance_eqRat_compat.
eapply eqRat_trans.
eapply evalDist_assoc_eq.
cbv beta.
eapply eqRat_trans.
eapply evalDist_seq_eq.
intuition.
eapply eqRat_refl.
intuition.
eapply eqRat_trans.
eapply evalDist_left_ident_eq.
eapply eqRat_refl.
cbv beta.
unfold fst.
intuition.
eapply eqRat_trans.
eapply evalDist_assoc_eq.
cbv beta.
eapply evalDist_seq_eq; intuition.
eapply evalDist_left_ident_eq.
rewrite <- H2.
rewrite H1.
eapply leRat_trans.
eapply eqRat_impl_leRat.
eapply eqRat_trans.
eapply evalDist_assoc_eq.
cbv beta.
eapply evalDist_seq_eq; intuition.
eapply eqRat_refl.
eapply eqRat_trans.
eapply evalDist_left_ident_eq.
cbv beta.
eapply eqRat_refl.
cbv beta.
unfold snd.
intuition.
eapply eqRat_trans.
eapply evalDist_assoc_eq.
eapply eqRat_trans.
eapply evalDist_seq_eq; intuition.
eapply eqRat_refl.
eapply eqRat_trans.
eapply evalDist_left_ident_eq.
cbv beta.
eapply eqRat_refl.
rewrite H.
symmetry.
eapply eqRat_trans.
eapply evalDist_assoc_eq.
eapply eqRat_trans.
eapply evalDist_seq_eq; intuition.
eapply eqRat_refl.
eapply eqRat_trans.
eapply evalDist_left_ident_eq.
eapply eqRat_refl.
cbv beta.
simpl.
intuition.
intuition.
Qed.
intuition.
eapply det_eq_impl_dist_sem_eq; trivial.
destruct H0.
eapply well_formed_Repeat; trivial.
unfold eq_dec.
intuition.
eapply (EqDec_dec _).
eauto.
econstructor; intuition.
destruct (P b).
econstructor.
destruct H0.
econstructor.
unfold eq_dec.
intuition.
eapply (EqDec_dec _).
trivial.
eauto.
unfold DetSem.evalDet_equiv.
intuition.
inversion H1; clear H1; subst.
inversion H2; clear H2; subst.
simpl in *.
eapply evalDet_steps_bind_done_inv in H6.
destruct H6.
destruct H1.
intuition.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eauto.
destruct (P x).
inversion H3; clear H3; subst.
simpl in *.
inversion H7; clear H7; subst.
econstructor.
eauto.
simpl.
2:eassumption.
constructor.
inversion H2; clear H2; subst.
simpl in *.
apply evalDet_steps_bind_eof_inv in H6.
intuition.
econstructor.
eapply evalDet_bind_eof.
trivial.
destruct H1.
destruct H1.
intuition.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eauto.
destruct (P x).
inversion H3; clear H3; subst.
simpl in *.
inversion H7.
trivial.
inversion H1; clear H1; subst.
eapply evalDet_steps_bind_done_inv in H2.
destruct H2.
destruct H1.
intuition.
econstructor.
econstructor.
eauto.
simpl.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eauto.
destruct (P x).
inversion H3; clear H3; subst.
simpl in *.
inversion H7; clear H7; subst.
econstructor.
eauto.
simpl.
2:eassumption.
constructor.
apply evalDet_steps_bind_eof_inv in H2.
intuition.
econstructor.
econstructor.
eauto.
simpl.
eapply evalDet_bind_eof.
trivial.
destruct H1.
destruct H1.
intuition.
econstructor.
econstructor.
eauto.
simpl.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eauto.
destruct (P x).
inversion H3; clear H3; subst.
simpl in *.
inversion H7.
trivial.
Qed.
intuition.
simpl in *.
rewrite (sumList_partition e).
eapply ratAdd_eqRat_compat.
rewrite (sumList_body_eq _ _ (fun b => ((evalDist c b) * (if (e b) then 1 else 0)) * v1)).
rewrite sumList_factor_constant_r.
eapply ratMult_eqRat_compat; intuition.
rewrite <- H0.
eapply sumList_body_eq; intuition.
destruct (EqDec_dec bool_EqDec (e a0) true).
rewrite e0.
intuition.
destruct (e a0); try congruence.
intuition.
intuition.
case_eq (e a0); intuition.
repeat rewrite ratMult_1_r.
eapply ratMult_eqRat_compat; intuition.
repeat rewrite ratMult_0_r.
rewrite ratMult_0_l.
intuition.
rewrite (sumList_body_eq _ _ (fun b => ((evalDist c b) * (if (e b) then 0 else 1)) * v2)).
rewrite sumList_factor_constant_r.
eapply ratMult_eqRat_compat; intuition.
rewrite <- H0.
rewrite <- (@evalDist_lossless _ c).
rewrite (sumList_partition e _ (evalDist c)).
rewrite ratAdd_comm.
rewrite ratSubtract_ratAdd_assoc.
rewrite ratSubtract_0.
rewrite <- ratAdd_0_r.
intuition.
eapply eqRat_impl_leRat.
eapply sumList_body_eq; intuition.
destruct (EqDec_dec bool_EqDec (e a0) true).
rewrite e0.
intuition.
destruct (e a0); try congruence.
intuition.
eapply eqRat_impl_leRat.
eapply sumList_body_eq; intuition.
destruct (EqDec_dec bool_EqDec (e a0) true).
rewrite e0.
intuition.
destruct (e a0); try congruence.
intuition.
trivial.
intuition.
case_eq (e a0); intuition.
repeat rewrite ratMult_0_r.
rewrite ratMult_0_l.
intuition.
repeat rewrite ratMult_1_r.
eapply ratMult_eqRat_compat; intuition.
Qed.
intuition.
simpl.
eapply leRat_trans.
eapply eqRat_impl_leRat.
rewrite sumList_body_eq.
2:{
intros.
eapply ratMult_eqRat_compat.
eapply H0.
eapply eqRat_refl.
}
eapply eqRat_refl.
assert (Permutation (getSupport c1) (getSupport c2)).
eapply NoDup_Permutation; intuition; eauto using getSupport_NoDup.
eapply getSupport_In_evalDist.
rewrite <- H0.
eapply getSupport_In_evalDist.
trivial.
eapply getSupport_In_evalDist.
rewrite H0.
eapply getSupport_In_evalDist.
trivial.
erewrite sumList_permutation; eauto.
rewrite sumList_distance_prod.
eapply leRat_trans.
eapply sumList_le; intuition.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply H1.
eapply getSupport_In_evalDist.
rewrite H0.
eapply getSupport_In_evalDist.
trivial.
rewrite sumList_factor_constant_r.
rewrite evalDist_lossless.
rewrite ratMult_1_l.
intuition.
trivial.
Qed.
intuition.
simpl.
eapply leRat_trans.
eapply sumList_le; intuition.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply H0.
trivial.
rewrite sumList_factor_constant_r.
rewrite evalDist_lossless.
rewrite ratMult_1_l.
intuition.
trivial.
Qed.
intuition.
subst.
simpl.
destruct (eqd a2 a2); subst; intuition.
Qed.
intuition.
simpl.
destruct (eqd a1 a2); subst; intuition.
Qed.
intuition.
simpl.
subst.
destruct (eqd1 a2 x); destruct (eqd2 a2 x); subst; intuition.
Qed.
intuition.
simpl.
eapply sumList_body_eq; intuition.
Qed.
intuition.
specialize (evalDist_getSupport_perm_id c (ret a)); intuition.
assert (forall a0 : A, evalDist c a0 == evalDist (ret a) a0).
intuition.
case_eq (eqb a a0); intuition.
rewrite eqb_leibniz in H2.
subst.
simpl.
destruct (EqDec_dec eqd a0 a0); intuition.
simpl.
assert (evalDist c a0 == 0).
eapply evalDist_1_0; intuition.
eapply H0.
subst.
rewrite eqb_refl in H2.
discriminate.
rewrite H3.
destruct ( EqDec_dec eqd a a0); subst; intuition.
rewrite eqb_refl in H2.
discriminate.
intuition.
simpl in *.
eapply Permutation_length_1_inv.
eapply Permutation_sym.
trivial.
Qed.
intuition.
destruct b.
trivial.
rewrite evalDist_complement.
rewrite evalDist_complement.
eapply ratSubtract_eqRat_compat; intuition.
trivial.
trivial.
Qed.
Class RatRel (R : Rat -> Rat -> Prop) :=
{
refl : forall r1 r2, r1 == r2 -> R r1 r2;
trans : Transitive R;
add_proper : Proper (R ==> R ==> R) ratAdd;
mult_proper : Proper (R ==> R ==> R) ratMult
}.
Instance RatRel_trans :
forall (R : Rat -> Rat -> Prop),
RatRel R -> Transitive R.
intuition.
destruct H.
intuition.
Qed.
Instance RatRel_flip :
forall R,
RatRel R ->
RatRel (Basics.flip R).
intuition.
econstructor; intuition.
unfold Basics.flip.
eapply refl.
eapply eqRat_symm.
intuition.
unfold Proper, respectful, Basics.flip in *; intuition.
eapply add_proper; trivial.
unfold Proper, respectful, Basics.flip in *; intuition.
eapply mult_proper; trivial.
Qed.
(* The class includes equality and inequality. *)
Instance eqRat_RatRel : RatRel eqRat.
econstructor;
eauto with typeclass_instances.
Qed.
Instance leRat_RatRel : RatRel leRat.
econstructor;
eauto with typeclass_instances.
eapply eqRat_impl_leRat.
Qed.
(* This one comes up some times: *)
Instance eqRat_RatRel_1 :
RatRel (fun r r1 : Rat => r1 == r).
eapply RatRel_flip.
intuition.
Qed.
intuition.
eapply refl.
eapply evalDist_left_ident_eq.
Qed.
intuition.
eapply refl.
eapply evalDist_assoc_eq.
Qed.
intuition.
eapply refl.
eapply evalDist_commute_eq.
Qed.
induction ls; intuition; simpl in *.
unfold sumList; simpl.
eapply refl.
intuition.
eapply trans.
eapply refl.
eapply sumList_cons.
eapply trans.
2:{
eapply refl.
symmetry.
eapply sumList_cons.
}
eapply add_proper.
intuition.
eapply IHls; intuition.
Qed.
intuition.
simpl.
eapply rel_sumList_compat; intuition.
eapply mult_proper.
eapply refl.
intuition.
intuition.
Qed.
intuition.
simpl in *.
eapply trans.
eapply refl.
rewrite (sumList_filter_partition e).
eapply eqRat_refl.
eapply add_proper.
eapply trans.
eapply (rel_sumList_compat); intuition.
eapply mult_proper.
eapply refl.
eapply eqRat_refl.
eapply H2.
eapply filter_In.
eauto.
eapply refl.
rewrite sumList_factor_constant_r.
eapply ratMult_eqRat_compat; intuition.
rewrite (sumList_filter_partition e) in H1.
rewrite <- H1.
rewrite ratAdd_0_r.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq; intuition.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat.
intuition.
destruct ( EqDec_dec bool_EqDec (e a0) true); intuition.
exfalso.
eapply n.
eapply filter_In.
eauto.
symmetry.
eapply sumList_0; intuition.
destruct (EqDec_dec bool_EqDec (e a0) true).
apply filter_In in H4.
intuition.
rewrite e0 in H6.
simpl in *.
congruence.
eapply ratMult_0_r.
eapply trans.
eapply (rel_sumList_compat); intuition.
eapply mult_proper.
eapply refl.
eapply eqRat_refl.
eapply H3.
eapply filter_In in H4.
intuition.
destruct (e a0); intuition.
eapply refl.
rewrite sumList_factor_constant_r.
eapply ratMult_eqRat_compat; intuition.
rewrite <- H1.
rewrite <- (@evalDist_lossless _ c); trivial.
symmetry.
rewrite (sumList_partition e _ (evalDist c)).
rewrite ratAdd_comm.
rewrite ratSubtract_ratAdd_assoc.
rewrite ratSubtract_0.
rewrite <- ratAdd_0_r.
rewrite (sumList_filter_partition e).
symmetry.
rewrite ratAdd_0_l.
eapply ratAdd_eqRat_compat.
symmetry.
eapply sumList_0; intuition.
apply filter_In in H4.
intuition.
rewrite H6.
eapply ratMult_0_r.
eapply sumList_body_eq; intuition.
apply filter_In in H4.
intuition.
destruct (e a0); simpl in *; try discriminate.
symmetry.
eapply ratMult_1_r.
eapply sumList_le; intuition.
destruct (EqDec_dec bool_EqDec (e a0) true).
rewrite e0.
intuition.
destruct (e a0); intuition.
eapply sumList_le; intuition.
destruct ( EqDec_dec bool_EqDec (e a0) true).
destruct (e a0); try discriminate.
intuition.
destruct (e a0); intuition.
Qed.
induction ls; intuition; simpl in *.
unfold sumList; simpl.
eapply refl.
symmetry.
eapply ratMult_0_l.
eapply trans.
eapply refl.
eapply sumList_cons.
eapply trans.
2:{
eapply refl.
symmetry.
eapply eqRat_trans.
eapply ratMult_eqRat_compat.
eapply sumList_cons.
eapply eqRat_refl.
eapply ratMult_distrib_r.
}
eapply add_proper.
eapply refl.
intuition.
eapply IHls; intuition.
Qed.
intuition.
simpl.
eapply trans.
eapply rel_sumList_compat;
intuition.
eapply mult_proper.
eapply refl.
eapply eqRat_refl.
eapply H1.
trivial.
specialize (rel_sumList_factor_r (evalDist c) (getSupport c) v H); intuition.
eapply trans.
eapply H2.
eapply refl.
rewrite evalDist_lossless.
eapply ratMult_1_l.
trivial.
Qed.
induction ls; intuition; simpl in *.
unfold sumList; simpl.
eapply refl.
eapply ratMult_0_l.
eapply trans.
eapply refl.
eapply eqRat_trans.
eapply ratMult_eqRat_compat.
eapply sumList_cons.
eapply eqRat_refl.
eapply ratMult_distrib_r.
eapply trans.
2:{
eapply refl.
symmetry.
eapply sumList_cons.
}
simpl.
eapply add_proper.
eapply refl.
intuition.
eapply IHls; intuition.
Qed.
intuition.
simpl.
eapply trans.
2:{
eapply rel_sumList_compat;
intuition.
eapply mult_proper.
eapply refl.
eapply eqRat_refl.
eapply H1.
trivial.
}
specialize (rel_sumList_factor_r_r (evalDist c) (getSupport c) v H); intuition.
eapply trans.
2:{
eapply H2.
}
eapply refl.
rewrite evalDist_lossless.
symmetry.
eapply ratMult_1_l.
trivial.
Qed.
intuition.
eapply trans.
eapply refl.
eapply (distro_iso_eq); intros.
eapply H0.
trivial.
eapply H1.
eauto.
eapply H2.
eauto.
eapply H3.
trivial.
eapply eqRat_refl.
eapply rel_seq;
intuition.
Qed.
intuition.
eapply (evalDist_iso (fun b => b)(fun b => b)); intuition.
eapply getSupport_In_evalDist.
intuition.
eapply getSupport_In_evalDist.
eauto.
rewrite H0.
trivial.
eapply H1.
eapply getSupport_In_evalDist.
intuition.
eapply getSupport_In_evalDist.
eauto.
rewrite <- H0.
trivial.
Qed.
Opaque getSupport.
induction c; intuition; simpl in *.
eapply H; eauto.
Transparent getSupport.
repeat simp_in_support.
destruct x.
simpl in *.
specialize (IHc (S * S0) (fun x => P (snd x)) _
(fun (x : S * S0) (y : A) =>
p <-$ (o (fst x) y) S0 eqds o0 (snd x);
ret (fst (fst p), (snd (fst p), snd p))) (s, s0))%type.
eapply IHc; intros.
3:{
eapply H3.
}
repeat simp_in_support.
simpl.
destruct c1.
destruct x.
eapply H.
eapply H0.
eapply H4.
eapply H5.
trivial.
repeat simp_in_support.
trivial.
repeat simp_in_support.
destruct x.
eapply H.
eapply H0.
eapply IHc.
eapply H0.
eapply H1.
eauto.
eauto.
Qed.
intuition.
eapply (@oc_comp_invariant _ _ _ _ _ (fun x => f x = true)); intuition.
eapply H.
eapply H2.
eapply H3.
eapply H0.
eapply H1.
Qed.
intuition.
simpl.
rewrite sumList_le.
2:{
intuition.
rewrite H at 1.
eapply leRat_refl.
trivial.
}
rewrite sumList_factor_constant_r.
eapply leRat_trans.
eapply ratMult_leRat_compat.
eapply evalDist_sum_le_1.
eapply leRat_refl.
rewrite ratMult_1_l.
intuition.
Qed.
induction 1; intuition; simpl in *; intuition.
eapply well_formed_Bind; intuition.
eapply IHwell_formed_oc; intuition.
eapply well_formed_Bind; intuition.
eapply well_formed_Ret.
eapply well_formed_Ret.
eapply well_formed_Bind; intuition.
eapply well_formed_Ret.
eapply well_formed_Bind; intuition.
destruct b.
eauto.
Qed.
intuition.
case_eq (P a); intuition.
simpl.
symmetry.
rewrite <- sumList_factor_constant_l.
symmetry.
rewrite (@sumList_subset' A (EqDec_dec _ ) _ (getSupport c)).
eapply sumList_body_eq; intuition.
unfold indicator.
simpl.
rewrite H2.
case_eq (P a0); intuition.
repeat rewrite ratMult_1_l.
rewrite <- ratMult_assoc.
eapply ratMult_eqRat_compat; intuition.
eapply ratMult_eqRat_compat; intuition.
eapply ratInverse_eqRat_compat.
eapply sumList_nz.
econstructor; intuition.
eapply filter_In; intuition; eauto.
eapply getSupport_In_evalDist;
eauto.
symmetry.
assert ((getUnique
(flatten
(map
(fun b0 : A =>
getUnique
(flatten
(map (fun b1 : B => (b0, b1) :: nil)
(getSupport (f b0))))
(bind_eq_dec (f b0) (fun b1 : B => ret (b0, b1))))
(getSupport c)))
(bind_eq_dec c (fun a1 : A => b0 <-$ f a1; ret (a1, b0)))) =
(flatten
(map
(fun b0 : A =>
(map (fun b1 : B => (b0, b1))
(getSupport (f b0))))
(getSupport c)))).
rewrite DetSem.getUnique_NoDup_eq.
f_equal.
eapply map_ext; intuition.
rewrite flatten_map_eq.
rewrite DetSem.getUnique_NoDup_eq.
intuition.
eapply map_NoDup; intuition.
assert (snd (a1, a2) = a2).
trivial.
eauto.
eapply getSupport_NoDup.
eapply flatten_NoDup;
intuition.
eapply map_NoDup'; intuition.
eapply getSupport_NoDup.
repeat rewrite flatten_map_eq in *.
edestruct (@well_formed_val_exists _ (f a1)).
intuition.
eapply (getUnique_eq_inv (a1, x)) in H8.
apply in_map_iff in H8.
destruct H8.
intuition.
pairInv.
intuition.
eapply in_map_iff.
econstructor.
intuition.
apply in_map_iff in H5.
destruct H5.
intuition.
subst.
eapply getUnique_NoDup.
eapply in_map_iff in H5.
destruct H5.
intuition.
eapply in_map_iff in H6.
destruct H6.
intuition.
subst.
repeat rewrite flatten_map_eq in *.
eapply app_NoDup; intuition.
eapply getUnique_NoDup.
eapply getUnique_NoDup.
apply in_getUnique_if in H5.
apply in_getUnique_if in H6.
apply in_map_iff in H5.
apply in_map_iff in H6.
destruct H5.
destruct H6.
intuition.
subst.
pairInv.
intuition.
apply in_getUnique_if in H5.
apply in_getUnique_if in H6.
apply in_map_iff in H5.
apply in_map_iff in H6.
destruct H5.
destruct H6.
intuition.
subst.
pairInv.
intuition.
rewrite H5.
clear H5.
rewrite sumList_filter_twice.
eapply sumList_body_eq; intuition.
apply filter_In in H5; intuition.
eapply eqRat_trans.
eapply sumList_body_eq; intuition.
rewrite (@sumList_exactly_one _ a1) at 1.
eapply eqRat_refl.
eapply getSupport_NoDup.
intuition.
intuition.
eapply eqRat_trans.
eapply ratMult_eqRat_compat.
eapply eqRat_refl.
eapply sumList_0; intuition.
destruct (EqDec_dec (pair_EqDec eqda eqdb) (b0, a3) (a1, a2)).
pairInv.
intuition.
eapply ratMult_0_r.
eapply ratMult_0_r.
eapply eqRat_trans.
eapply sumList_body_eq; intuition.
eapply ratMult_eqRat_compat.
eapply eqRat_refl.
eapply (@sumList_exactly_one _ a2); intuition.
eapply getSupport_NoDup.
destruct (EqDec_dec (pair_EqDec eqda eqdb) (a1, b0) (a1, a2)).
pairInv.
intuition.
eapply ratMult_0_r.
rewrite sumList_factor_constant_l.
symmetry.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
symmetry.
eapply eqRat_trans.
eapply sumList_body_eq; intuition.
destruct (EqDec_dec (pair_EqDec eqda eqdb) (a1, a2) (a1, a2)).
eapply ratMult_1_r.
congruence.
eapply evalDist_lossless.
intuition.
repeat rewrite ratMult_0_l.
symmetry.
rewrite ratMult_1_l.
eapply eqRat_trans.
eapply ratMult_eqRat_compat.
eapply eqRat_refl.
eapply ratMult_eqRat_compat.
eapply eqRat_refl.
eapply sumList_0; intuition.
destruct (EqDec_dec (pair_EqDec eqda eqdb) (a0, a1) (a, b)).
pairInv.
congruence.
eapply ratMult_0_r.
repeat rewrite ratMult_0_r.
intuition.
eapply filter_NoDup.
eapply getSupport_NoDup.
eapply getSupport_NoDup.
intuition.
apply filter_In in H3; intuition.
intuition.
unfold indicator.
case_eq (P a0); intuition.
exfalso.
eapply H4.
eapply filter_In; intuition.
repeat rewrite ratMult_0_l.
intuition.
destruct H0.
eapply evalDist_irr_l; intuition.
eapply well_formed_Repeat.
unfold eq_dec; intuition.
eapply (EqDec_dec _).
trivial.
eauto.
eapply evalDist_irr_l; intuition.
simpl in *.
apply filter_In in H3.
intuition.
simpl in *.
apply filter_In in H3.
intuition.
destruct (EqDec_dec (pair_EqDec eqda eqdb) (x0, x1) (a, b)).
pairInv.
congruence.
unfold indicator.
simpl.
rewrite H2.
repeat rewrite ratMult_0_l.
intuition.
Qed.
intuition.
simpl.
rewrite H.
rewrite ratMult_0_r.
intuition.
Qed.
intuition.
simpl.
unfold indicator.
rewrite H.
repeat rewrite ratMult_0_l.
intuition.
Qed.
intuition.
simpl.
case_eq (P x); intuition.
unfold indicator.
rewrite H.
rewrite ratMult_1_l.
rewrite <- sumList_factor_constant_l.
symmetry.
rewrite (sumList_filter_partition (fun p : A * B => P (snd p))).
symmetry.
rewrite ratAdd_0_r.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq; intuition.
apply filter_In in H0; intuition.
rewrite H2.
destruct (EqDec_dec eqd (snd a) x).
rewrite ratMult_1_l.
repeat rewrite ratMult_1_r.
eapply ratMult_eqRat_compat; intuition.
rewrite flatten_map_eq.
eapply ratInverse_eqRat_compat.
intuition.
destruct a.
simpl in *.
subst.
eapply sumList_nz; eauto.
exists (a, x).
intuition.
eapply filter_In; intuition.
eapply getSupport_In_evalDist; eauto.
rewrite sumList_comm.
symmetry.
rewrite (sumList_filter_partition (fun p : A * B => P (snd p))).
symmetry.
rewrite ratAdd_0_r.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq; intuition.
apply filter_In in H0; intuition.
rewrite sumList_factor_constant_l.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
symmetry.
destruct a0.
simpl in *.
rewrite (@sumList_exactly_one _ b).
destruct (EqDec_dec eqd b b); intuition.
eapply filter_NoDup.
eapply getUnique_NoDup.
eapply filter_In; intuition.
eapply in_getUnique.
eapply in_map_iff.
econstructor. split; eauto.
simpl.
trivial.
intuition.
destruct (EqDec_dec eqd b b0); subst; intuition.
symmetry.
eapply sumList_0.
intuition.
eapply sumList_0; intuition.
apply filter_In in H3; intuition.
apply filter_In in H0; intuition.
destruct a0.
simpl in *.
destruct (EqDec_dec eqd b a1); subst.
destruct (P a1); simpl in *; discriminate.
eapply ratMult_0_r.
repeat rewrite ratMult_0_r.
intuition.
symmetry.
eapply sumList_0; intuition.
eapply filter_In in H0; intuition.
destruct (EqDec_dec eqd (snd a) x); subst.
destruct (P (snd a)); simpl in *; discriminate.
repeat rewrite ratMult_0_r.
intuition.
unfold indicator.
rewrite H.
repeat rewrite ratMult_0_l.
eapply sumList_0; intuition.
apply filter_In in H0.
intuition.
rewrite H2.
rewrite ratMult_1_l.
destruct a.
simpl in *.
destruct (EqDec_dec eqd b x); subst; try congruence.
rewrite ratMult_0_r.
intuition.
Qed.
intuition.
simpl.
case_eq (P x); intuition.
unfold indicator.
rewrite H.
rewrite ratMult_1_l.
rewrite <- sumList_factor_constant_l.
symmetry.
rewrite (sumList_filter_partition (fun p : A * B => P (fst p))).
symmetry.
rewrite ratAdd_0_r.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq; intuition.
apply filter_In in H0; intuition.
rewrite H2.
destruct (EqDec_dec eqd (fst a) x).
rewrite ratMult_1_l.
repeat rewrite ratMult_1_r.
eapply ratMult_eqRat_compat; intuition.
rewrite flatten_map_eq.
eapply ratInverse_eqRat_compat.
intuition.
destruct a.
simpl in *.
subst.
eapply sumList_nz; eauto.
exists (x, b).
intuition.
eapply filter_In; intuition.
eapply getSupport_In_evalDist; eauto.
rewrite sumList_comm.
symmetry.
rewrite (sumList_filter_partition (fun p : A * B => P (fst p))).
symmetry.
rewrite ratAdd_0_r.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq; intuition.
apply filter_In in H0; intuition.
rewrite sumList_factor_constant_l.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
symmetry.
destruct a0.
simpl in *.
rewrite (@sumList_exactly_one _ a0).
destruct (EqDec_dec eqd a0 a0); intuition.
eapply filter_NoDup.
eapply getUnique_NoDup.
eapply filter_In; intuition.
eapply in_getUnique.
eapply in_map_iff.
econstructor. split; eauto.
simpl.
trivial.
intuition.
destruct (EqDec_dec eqd a0 b0); subst; intuition.
symmetry.
eapply sumList_0.
intuition.
eapply sumList_0; intuition.
apply filter_In in H3; intuition.
apply filter_In in H0; intuition.
destruct a0.
simpl in *.
destruct (EqDec_dec eqd a0 a1); subst.
destruct (P a1); simpl in *; discriminate.
eapply ratMult_0_r.
repeat rewrite ratMult_0_r.
intuition.
symmetry.
eapply sumList_0; intuition.
eapply filter_In in H0; intuition.
destruct (EqDec_dec eqd (fst a) x); subst.
destruct (P (fst a)); simpl in *; discriminate.
repeat rewrite ratMult_0_r.
intuition.
unfold indicator.
rewrite H.
repeat rewrite ratMult_0_l.
eapply sumList_0; intuition.
apply filter_In in H0.
intuition.
rewrite H2.
rewrite ratMult_1_l.
destruct a.
simpl in *.
destruct (EqDec_dec eqd a x); subst; try congruence.
rewrite ratMult_0_r.
intuition.
Qed.

Theorem repeat_fission' :
forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(c : Comp A)(P1 : A -> bool)(P2 : B -> bool)(f : A -> Comp B) x,
well_formed_comp c ->
(exists a, In a (filter P1 (getSupport c))) ->
(forall a, In a (getSupport c) -> well_formed_comp (f a)) ->
(forall a b, In a (getSupport c) -> In b (getSupport (f a)) -> (P1 a = P2 b)) ->
evalDist (a <-$ Repeat c P1; f a) x ==
evalDist
(Repeat (a <-$ c; f a) P2) x.