(* Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
Set Implicit Arguments.
(* stuff that needs to go somewhere else *)
intuition.
apply (ratAdd_leRat_compat_l r3) in H1.
assert (ratSubtract r1 r3 + r3 == r1).
rewrite ratAdd_comm.
eapply ratSubtract_ratAdd_inverse_2; intuition.
rewrite <- H2.
rewrite H1.
rewrite ratAdd_comm.
eapply eqRat_impl_leRat.
apply ratSubtract_ratAdd_inverse_2; intuition.
Qed.
intuition.
eapply (eqRat_ratAdd_same_r (evalDist c a)).
symmetry.
rewrite ratAdd_comm.
rewrite ratSubtract_ratAdd_inverse_2.
rewrite <- (evalDist_lossless H).
rewrite (sumList_filter_partition (eqb a)).
rewrite ratAdd_comm.
eapply ratAdd_eqRat_compat; intuition.
destruct (eq_Rat_dec (evalDist c a) 0).
rewrite e.
eapply sumList_0; intuition.
apply filter_In in H0.
intuition.
rewrite eqb_leibniz in H2; subst.
trivial.
rewrite (@sumList_exactly_one _ a); intuition.
eapply filter_NoDup.
eapply getSupport_NoDup.
eapply filter_In; intuition.
eapply getSupport_In_evalDist; intuition.
eapply eqb_refl.
apply filter_In in H0; intuition.
rewrite eqb_leibniz in H3; subst.
intuition.
eapply evalDist_le_1.
Qed.
intuition.
simpl.
unfold indicator.
case_eq (P a); intuition.
rewrite ratMult_1_l.
eapply ratMult_0.
right.
eapply getSupport_not_In_evalDist.
intuition.
eapply H;
eauto.
rewrite ratMult_0_l.
eapply ratMult_0_l.
Qed.
intuition.
destruct (in_dec (EqDec_dec _) a (getSupport c)).
rewrite evalDist_seq_step.
rewrite (@sumList_exactly_one _ a).
dist_compute.
eapply getSupport_NoDup.
trivial.
intuition.
dist_compute.
rewrite evalDist_seq_step.
assert (evalDist c a == 0).
eapply getSupport_not_In_evalDist; trivial.
rewrite H.
symmetry.
eapply sumList_0.
intuition.
dist_compute.
Qed.
induction ls; intuition; simpl in *.
rewrite H.
destruct (f2 a); eauto.
f_equal;
eauto.
Qed.
(* definitions related to the program logic *)
Definition marginal_l(A B : Set){eqd : EqDec A}(c : Comp (A * B))(a : A) :=
Pr[x <-$ c; ret eqb (fst x) a].
Definition marginal_r(A B : Set){eqd : EqDec B}(c : Comp (A * B))(b : B) :=
Pr[x <-$ c; ret eqb (snd x) b].
intuition.
eapply getSupport_In_evalDist.
intuition.
rewrite H in H1.
clear H.
unfold marginal_l in *.
simpl in *.
eapply sumList_0 in H1; eauto.
eapply ratMult_0 in H1.
intuition.
eapply getSupport_In_evalDist;
eauto.
dist_compute.
Qed.
intuition.
eapply getSupport_In_evalDist.
intuition.
rewrite H in H1.
clear H.
unfold marginal_r in *.
simpl in *.
eapply sumList_0 in H1; eauto.
eapply ratMult_0 in H1.
intuition.
eapply getSupport_In_evalDist;
eauto.
dist_compute.
Qed.
Definition comp_spec (R1 R2 : Set)
{eqd1 : EqDec R1}{eqd2 : EqDec R2}
(post : R1 -> R2 -> Prop)(c1 : Comp R1)(c2 : Comp R2) :=
exists c : Comp (R1 * R2),
(forall r1, evalDist c1 r1 == marginal_l c r1) /\
(forall r2, evalDist c2 r2 == marginal_r c r2) /\
(forall p, In p (getSupport c) -> post (fst p) (snd p)).
induction ls; intuition.
exists (fun a => b).
intuition.
simpl in *.
intuition.
edestruct (H a); intuition.
edestruct (H0); intuition.
exists (fun a0 => if (eqd a a0) then x else (x0 a0)).
intuition.
inversion H3; clear H3; subst.
destruct (eqd a0 a0); intuition.
destruct (eqd a a0); intuition.
subst.
trivial.
Qed.
intuition.
destruct H; intuition.
assert (forall p, In p (getSupport x) -> comp_spec P (f1 (fst p)) (f2 (snd p))).
intuition.
eapply H0.
eapply in_support_marginal_l; eauto.
eapply in_support_marginal_r; eauto.
eauto.
clear H0.
pose proof H2.
apply (list_choice) in H2.
destruct H2.
exists (Bind x x0).
intuition.
rewrite evalDist_seq_step.
eapply eqRat_trans.
eapply sumList_body_eq.
intros.
eapply ratMult_eqRat_compat.
eauto.
eapply eqRat_refl.
unfold marginal_l.
eapply eqRat_trans.
eapply sumList_body_eq.
intros.
eapply ratMult_eqRat_compat.
eapply evalDist_seq_step.
eapply eqRat_refl.
eapply eqRat_trans.
eapply sumList_body_eq.
intros.
symmetry.
eapply sumList_factor_constant_r.
rewrite sumList_comm.
dist_inline_first.
rewrite evalDist_seq_step.
eapply sumList_body_eq.
intros.
rewrite (@sumList_exactly_one _ (fst a)).
assert (Pr  [ret eqb (fst a) (fst a) ]  == 1).
dist_compute.
rewrite H5.
rewrite ratMult_1_r.
eapply ratMult_eqRat_compat; intuition.
specialize (H2 a).
intuition.
rewrite H2.
unfold marginal_l.
intuition.
eapply getSupport_NoDup.
eapply in_support_marginal_l; eauto.
intuition.
dist_compute.
rewrite evalDist_seq_step.
eapply eqRat_trans.
eapply sumList_body_eq.
intros.
eapply ratMult_eqRat_compat.
eauto.
eapply eqRat_refl.
unfold marginal_r.
eapply eqRat_trans.
eapply sumList_body_eq.
intros.
eapply ratMult_eqRat_compat.
eapply evalDist_seq_step.
eapply eqRat_refl.
eapply eqRat_trans.
eapply sumList_body_eq.
intros.
symmetry.
eapply sumList_factor_constant_r.
rewrite sumList_comm.
dist_inline_first.
rewrite evalDist_seq_step.
eapply sumList_body_eq.
intros.
rewrite (@sumList_exactly_one _ (snd a)).
assert (Pr  [ret eqb (snd a) (snd a) ] == 1).
dist_compute.
rewrite H5.
rewrite ratMult_1_r.
eapply ratMult_eqRat_compat; intuition.
specialize (H2 a); intuition.
rewrite H6.
unfold marginal_r; intuition.
eapply getSupport_NoDup.
eapply in_support_marginal_r; eauto.
intuition.
dist_compute.
simp_in_support.
specialize (H2 x1); intuition.
unfold eq_dec; intuition.
eapply (EqDec_dec _).
eapply (ret (c, d)).
Qed.
Ltac despec :=
match goal with
| [H : comp_spec _ _ _  |- _] => destruct H
end.
intuition.
despec; intuition.
exists x; intuition.
rewrite H1.
unfold marginal_l.
dist_skip.
eapply evalDist_ret_eq.
case_eq (eqb (fst x0) r1); intuition.
rewrite eqb_leibniz in H4.
subst.
eapply eqb_refl.
case_eq ( (@eqb A eqda1 (@fst A B x0) r1)); intuition.
rewrite eqb_leibniz in H5.
subst.
rewrite eqb_refl in H4.
intuition.
rewrite H.
unfold marginal_r.
dist_skip.
eapply evalDist_ret_eq.
case_eq (eqb (snd x0) r2); intuition.
rewrite eqb_leibniz in H4.
subst.
eapply eqb_refl.
case_eq ( (@eqb B eqdb1 (@snd A B x0) r2)); intuition.
rewrite eqb_leibniz in H5.
subst.
rewrite eqb_refl in H4.
intuition.
Qed.
intuition.
despec; intuition.
exists (p <-$ x; ret (snd p, fst p)).
intuition.
eapply eqRat_trans; eauto.
unfold marginal_r, marginal_l.
dist_inline_first.
dist_skip.
dist_compute.
eapply eqRat_trans; eauto.
unfold marginal_r, marginal_l.
dist_inline_first.
dist_skip.
dist_compute.
repeat simp_in_support.
simpl.
eauto.
Qed.

(* completeness theorems *)
Theorem eq_impl_comp_spec :
forall (A B : Set){eqda : EqDec A}{eqdb : EqDec B}(c1 : Comp A)(c2 : Comp B) x y,
well_formed_comp c1 ->
well_formed_comp c2 ->
evalDist c1 x == evalDist c2 y ->
comp_spec (fun a b => a = x <-> b = y) c1 c2.