(* 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.		*)
(* Equivalance between the oracle machine semantics and the probabilistic semantics. *)
Set Implicit Arguments.
Local Open Scope rat_scope.
Local Open Scope list_scope.
induction c; intuition; simpl in *.
inversion H; clear H; subst.
destruct (e a0 a'); subst.
destruct (eqd a' a').
intuition.
congruence.
destruct (eqd a0 a'); subst.
congruence.
intuition.
destruct (evalDet_step c nil); discriminate.
destruct n; discriminate.
congruence.
Qed.
induction 1; intuition; simpl in *.
discriminate.
case_eq (evalDet_step c1 nil); intuition;
rewrite H3 in H2; try discriminate.
inversion H2; clear H2; subst.
erewrite evalDet_step_done_support_singleton; eauto.
unfold sumList. simpl.
rewrite <- ratAdd_0_l.
rewrite (@evalDet_step_done_evalDist _ (comp_eq_dec c1)); eauto.
destruct (comp_eq_dec c1 b b).
eapply ratMult_1_l.
congruence.
inversion H2; clear H2; subst.
simpl.
rewrite sumList_permutation.
2:{
eapply evalDet_step_more_support_preserved.
eauto.
}
eapply sumList_body_eq.
intuition.
eapply ratMult_eqRat_compat; intuition.
destruct n.
inversion H; clear H; subst.
simpl.
rewrite (vector_0 a).
destruct (Bvector_eq_dec [] [] ).
eapply eqRat_terms; intuition.
congruence.
discriminate.
inversion H1; clear H1; subst.
simpl.
destruct (in_dec (comp_eq_dec c) a (getSupport c)).
symmetry.
eapply eqRat_trans.
eapply (sumList_filter_partition P).
eapply eqRat_trans.
eapply ratAdd_eqRat_compat.
eapply sumList_body_eq.
intuition.
assert (P a0 = true).
eapply filter_In; eauto.
rewrite H2.
simpl.
eapply eqRat_refl.
eapply sumList_body_eq.
intuition.
assert (P a0 = false).
assert (negb (P a0) = true).
apply filter_In in H1.
intuition.
eapply negb_true_iff.
trivial.
rewrite H2.
simpl.
eapply eqRat_refl.
case_eq (P a); intuition.
unfold indicator.
rewrite H1.
rewrite ratMult_1_l.
assert (sumList (filter P (getSupport c))
(fun a0 : A => evalDist c a0 * (if comp_eq_dec c a0 a then 1 else 0)) == evalDist c a).
rewrite (@sumList_exactly_one _ a).
destruct (comp_eq_dec c a a); try congruence.
eapply ratMult_1_r.
eapply filter_NoDup.
eapply getSupport_NoDup.
eapply filter_In; eauto.
intuition.
destruct (comp_eq_dec c b0 a); subst; intuition.
eapply ratMult_0_r.
rewrite H2.
rewrite sumList_factor_constant_r.
rewrite ratMult_1_l.
assert (sumList (filter (fun a0 : A => negb (P a0)) (getSupport c)) (evalDist c) == (ratSubtract 1 (sumList (filter P (getSupport c)) (evalDist c)))).
rewrite <- evalDist_lossless.
rewrite (sumList_filter_partition P (getSupport c)).
rewrite ratSubtract_ratAdd_inverse.
intuition.
trivial.
rewrite H3.
rewrite ratMult_ratSubtract_distrib_r.
rewrite ratMult_1_l.
rewrite <- (ratMult_assoc (sumList (filter P (getSupport c)) (evalDist c))).
rewrite (ratMult_comm (sumList (filter P (getSupport c)) (evalDist c))).
rewrite ratInverse_prod_1.
rewrite ratMult_1_l.
rewrite ratSubtract_ratAdd_inverse_2.
intuition.
eapply leRat_trans.
rewrite <- ratMult_1_l.
eapply leRat_refl.
eapply ratMult_leRat_compat; intuition.
eapply ratInverse_1_swap.
intuition.
eapply sumList_0 in H4.
eapply getSupport_In_evalDist.
eapply filter_In.
eapply H0.
eapply H4.
trivial.
eapply leRat_trans.
eapply sumList_filter_le.
rewrite evalDist_lossless.
intuition.
trivial.
intuition.
eapply sumList_0 in H4.
eapply getSupport_In_evalDist.
eapply filter_In.
eapply H0.
eapply H4.
trivial.
unfold indicator.
rewrite H1.
rewrite ratMult_0_l.
assert (sumList (filter P (getSupport c))
(fun a0 : A => evalDist c a0 * (if comp_eq_dec c a0 a then 1 else 0)) == 0).
eapply sumList_0.
intuition.
destruct (comp_eq_dec c a0 a); subst.
assert (P a = true).
eapply filter_In; eauto.
congruence.
eapply ratMult_0_r.
rewrite H2.
assert (sumList (filter (fun a0 : A => negb (P a0)) (getSupport c))
(fun a0 : A =>
evalDist c a0 *
(0 * ratInverse (sumList (filter P (getSupport c)) (evalDist c)) *
evalDist c a)) == 0).
eapply sumList_0.
intuition.
repeat rewrite ratMult_0_l.
eapply ratMult_0_r.
rewrite H3.
rewrite <- ratAdd_0_l.
symmetry.
eapply ratMult_0_l.
assert (evalDist c a == 0).
eapply getSupport_not_In_evalDist.
trivial.
rewrite H1.
rewrite ratMult_0_r.
symmetry.
eapply sumList_0.
intuition.
case_eq (P a0); intuition.
simpl.
destruct (comp_eq_dec c a0 a); subst.
intuition.
eapply ratMult_0_r.
simpl.
rewrite H1.
repeat rewrite ratMult_0_r.
intuition.
Qed.
induction 1; intuition; subst.
discriminate.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
eapply evalDet_step_done_evalDist; eauto.
assert (s = nil).
eapply evalDet_step_more_nil_inv.
eauto.
subst.
rewrite <- IHevalDet_steps; eauto.
erewrite evalDet_step_nil_dist_preserved; eauto.
intuition.
eapply evalDet_step_well_formed_comp_preserved;
eauto.
Qed.
intuition.
eapply evalDet_steps_done_evalDist_h; eauto.
Qed.
Definition lowDistApprox (A : Set)(c : Comp A)(a : A)(n : nat)(v : Rat) :=
exists vals count,
rel_map (evalDet c) (getAllBlists n) vals /\
pred_count (eq (ca_done a)) vals count  /\
v == (count / expnat 2 n).
induction ls; inversion 1; intuition; subst; simpl in *.
f_equal.
inversion H4; clear H4; subst.
inversion H0; clear H0; subst.
simpl in *.
inversion H6; clear H6; subst.
trivial.
inversion H0; clear H0; subst; simpl in *.
inversion H6.
inversion H; clear H; subst.
eapply IHls.
trivial.
Qed.
intuition.
destruct H.
destruct H.
intuition.
specialize (map_Ret_repeat H0); intuition.
subst.
destruct (eqd a a'); subst.
specialize (pred_count_listRepeat_eq_inv _ H); intuition.
subst.
rewrite H2.
rewrite getAllBlists_length.
eapply num_dem_same_rat1.
trivial.
specialize (@pred_count_listRepeat_ne_inv (length (getAllBlists n)) _ (ca_done a') (ca_done a) x0); intuition.
rewrite H1 in H2.
rewrite H2.
apply rat_num_0.
intuition.
inversion H3.
intuition.
trivial.
Qed.
Inductive lowDistApprox_bind (A B : Set)(c1 : Comp B)(c2 : B -> Comp A)(a : A)(n : nat) : Rat -> Prop :=
| lda_b_intro :
forall v,
sumList_rel (fun (b : B) r => forall r1 r2, lowDistApprox c1 b n r1 -> lowDistApprox (c2 b) a n r2 -> r == r1 * r2) (getSupport c1) v ->
lowDistApprox_bind c1 c2  a n v.
(* We will use a tree to represent an approximation at a certain level.  These tree-based approximations are equivalent to the standard approximations above, but they make it easier to prove some properties. *)
Inductive DistApproxTree(A : Set) :=
| dat_leaf : option A -> DistApproxTree A
| dat_internal : DistApproxTree A -> DistApproxTree A -> DistApproxTree A.
(* dat_correct is an inductive predicate that lets us conclude that some tree produces a correct approximation for some computation. *)
Inductive dat_correct_h(A : Set)(c : Comp A)(s : Blist) : nat -> DistApproxTree A -> Prop :=
| dat_correct_h_leaf_Some :
forall a n,
evalDet c s (ca_done a) ->
dat_correct_h c s n (dat_leaf (Some a))
| dat_correct_h_leaf_None :
(forall a, ~ evalDet c s (ca_done a)) ->
dat_correct_h c s 0 (dat_leaf None)
| dat_correct_h_internal :
forall t1 t2 n,
(forall a, ~ evalDet c s (ca_done a)) ->
dat_correct_h c (s ++ (true :: nil)) n t1 ->
dat_correct_h c (s ++ (false :: nil)) n t2 ->
dat_correct_h c s (S n) (dat_internal t1 t2).
Definition dat_correct(A : Set)(c : Comp A)(n : nat) :=
dat_correct_h c nil n.
induction 1; intuition.
inversion H0; clear H0; subst.
assert (ca_done a = ca_done a0).
eapply evalDet_func; eauto.
inversion H0.
subst.
trivial.
specialize (H1 a).
intuition.
specialize (H1 a).
intuition.
inversion H0; clear H0; subst.
specialize (H a).
intuition.
trivial.
inversion H2; clear H2; subst.
specialize (H a).
intuition.
f_equal; eauto.
Qed.
Fixpoint getTreeSupport_dups(A : Set)(t : DistApproxTree A) :=
match t with
| dat_leaf o =>
match o with
| None => nil
| Some a => a :: nil
end
| dat_internal t1 t2 =>
getTreeSupport_dups t1 ++ getTreeSupport_dups t2
end.
Definition getTreeSupport(A : Set)(eqd : eq_dec A)(t : DistApproxTree A) : list A :=
getUnique (getTreeSupport_dups t) eqd.
induction 1; intuition; simpl in *.
intuition; subst.
eapply getSupport_In_evalDet; eauto.
intuition.
unfold getTreeSupport in *.
eapply in_getUnique_if in H2.
simpl in *.
eapply in_app_or in H2.
intuition.
eapply IHdat_correct_h1.
eapply in_getUnique.
eauto.
eauto using in_getUnique.
Qed.
intuition.
eapply H0.
eauto using getTreeSupport_in.
Qed.

Lemma dat_exists_h : forall n s (A : Set)(c : Comp A),
well_formed_comp c ->
exists t : DistApproxTree A,
dat_correct_h c s n t.