(* 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.

Theorem fundamental_lemma_h : forall (A : Set)(eqda : EqDec A)(c1 c2 : Comp (A * bool)),
(evalDist (Bind c1 (fun x => ret snd x)) true == evalDist (Bind c2 (fun x => ret snd x)) true) ->
(forall a, evalDist c1 (a, false) == evalDist c2 (a, false)) ->
forall a,
ratDistance (evalDist (Bind c1 (fun x => ret (fst x))) a) (evalDist (Bind c2 (fun x => ret (fst x))) a) <=
evalDist (Bind c1 (fun x => ret snd x)) true.