(* 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.
induction n; intuition.
destruct (@evalDet_dec _ c s).
trivial.
destruct H0.
exists (dat_leaf (Some x)).
econstructor; eauto.
exists (dat_leaf None).
econstructor.
intuition.
eapply evalDet_done_eof_func; eauto.
destruct (@evalDet_dec _ c s).
trivial.
destruct H0.
exists (dat_leaf (Some x)).
econstructor.
trivial.
destruct (IHn (s ++ (true :: nil)) _ c).
trivial.
destruct (IHn (s ++ (false :: nil)) _ c).
trivial.
exists (dat_internal x x0).
econstructor; eauto.
intuition.
eapply evalDet_done_eof_func; eauto.
Qed.
intuition.
eapply dat_exists_h.
trivial.
Qed.
Fixpoint lowDistApproxFromTree(A : Set)(eqd : eq_dec A)(t : DistApproxTree A)(a : A) :=
match t with
| dat_leaf o =>
match o with
| None => 0
| Some a' => if (eqd a a') then 1 else 0
end
| dat_internal t1 t2 =>
(lowDistApproxFromTree eqd t1 a) * (1 / 2) + (lowDistApproxFromTree eqd t2 a) * (1 / 2)
end.
Definition lowDistApprox_ls (A : Set)(c : Comp A) a n (ls : Blist) r :=
exists vals count,
rel_map (fun s v => (evalDet c (ls ++ s) v)) (getAllBlists n) vals /\
pred_count (eq (ca_done a)) vals count /\
count /expnat 2 n == r.
intuition.
destruct H.
destruct H.
intuition.
econstructor.
econstructor.
intuition.
simpl.
eapply rel_map_eq.
eapply H0.
eauto.
intuition.
eauto.
intuition.
Qed.
intuition.
destruct H0.
destruct H0.
intuition.
destruct (eqd a2 a1); subst.
rewrite <- H3.
erewrite pred_count_eq_all_inv at 1.
erewrite <- rel_map_length.
rewrite getAllBlists_length.
apply num_dem_same_rat1.
unfold posnatToNat.
unfold natToPosnat.
eauto.
eapply H1.
eauto.
intuition.
eapply rel_map_unary_pred.
eapply H1.
intuition.
eapply evalDet_app_eq in H.
eapply evalDet_func; eauto.
trivial.
rewrite <- H3.
erewrite pred_count_eq_0 at 1.
apply rat_num_0.
2:{
eapply H1.
}
2:{
eapply H0.
}
intuition.
subst.
eapply n0.
assert (ca_done a1 = ca_done a2).
eapply evalDet_func.
eapply evalDet_app_eq.
eauto.
eauto.
inversion H5.
trivial.
Qed.
induction 1; intuition; simpl in *.
symmetry.
eapply evalDet_lowDistApprox_ls_done_inv; eauto.
inversion H0; clear H0; subst.
destruct H1; intuition.
simpl in *.
rewrite <- H3.
erewrite pred_count_eq_0 at 1.
apply eqRat_symm.
apply rat_num_0.
2:{
eapply H1.
}
2:{
eapply H0.
}
intuition.
simpl in *.
intuition.
subst.
rewrite app_nil_r in *.
eapply H; eauto.
destruct H2.
destruct H2.
intuition.
simpl in *.
apply rel_map_app_inv in H3.
intuition.
apply rel_map_map_inv in H4.
apply rel_map_map_inv in H6.
eapply (pred_count_first_skip) in H2.
destruct H2.
destruct H2.
intuition.
rewrite IHdat_correct_h1.
2:{
econstructor.
econstructor.
intuition.
eapply rel_map_eq.
eapply H4.
trivial.
intuition.
rewrite <- app_assoc.
simpl.
trivial.
eapply H3.
eapply eqRat_refl.
}
rewrite IHdat_correct_h2.
2:{
econstructor.
econstructor.
intuition.
eapply rel_map_eq.
eapply H6.
trivial.
intuition.
rewrite <- app_assoc.
simpl.
trivial.
eapply H2.
eapply eqRat_refl.
}
rewrite <- ratMult_distrib_r.
rewrite <- ratAdd_den_same.
rewrite H8.
rewrite <- ratMult_num_den.
rewrite mult_1_r.
unfold posnatMult.
unfold natToPosnat.
rewrite <- H5.
eapply eqRat_terms; trivial.
unfold natToPosnat, posnatToNat.
rewrite mult_comm.
simpl.
trivial.
Qed.
intuition.
eapply low_tree_approx_same_inv_h.
eauto.
eapply lowDistApprox_ls_impl.
trivial.
Qed.
intuition.
destruct H0.
destruct H0.
intuition.
specialize (@pred_count_eq_0 (comp_answer A) Blist (getAllBlists n) x (evalDet c) (eq (ca_done a)) x0); intuition.
rewrite H2 in H3.
rewrite H3.
apply rat_num_0.
intuition.
subst.
eapply H.
eapply getSupport_In_evalDet; eauto.
trivial.
trivial.
Qed.
Definition getSupport_bind (A B : Set)(c1 : Comp B)(c2 : B -> Comp A) : list (B * (list A)) :=
(map (fun b => (b , (getSupport (c2 b)))) (getSupport c1)).
Fixpoint flattenPair (A B : Type)(ls : list (A * list B)) :=
match ls with
| nil => nil
| (a, ls_b) :: ls' =>
(map (fun b => (a, b)) ls_b) ++ (flattenPair ls')
end.
induction ls; intuition; simpl in *.
intuition.
inversion H1; clear H1; subst.
eapply in_or_app.
left.
eapply in_map_iff.
econstructor.
intuition.
eapply in_or_app.
right.
eapply IHls; eauto.
Qed.
Definition getSupport_bind_cp (A B : Set)(c1 : Comp B)(c2 : B -> Comp A) : list (B * A) :=
flattenPair (getSupport_bind c1 c2).
intuition.
unfold getSupport_bind_cp, getSupport_bind.
eapply in_flattenPair.
eapply in_map_iff.
econstructor; intuition.
trivial.
Qed.
intuition.
destruct (in_dec eqdb b (getSupport c1)); intuition.
destruct (in_dec eqda a (getSupport (c2 b))); intuition.
exfalso.
eapply H.
eapply In_getSupport_bind_cp; eauto.
Qed.
Instance length_getSupport_nz : forall (A : Set)(c : Comp A),
well_formed_comp c ->
nz (length (getSupport c)).
intuition.
econstructor.
eapply getSupport_length_nz.
trivial.
Qed.
unfold lowDistApprox_ls.
intuition.
exists (listRepeat (ca_done a1) (length (getAllBlists n))).
destruct (eqd a1 a2); subst.
exists (length (getAllBlists n)).
intuition.
eapply rel_map_listRepeat.
intuition.
eapply evalDet_app_eq.
trivial.
eapply pred_count_eq_all; intuition.
symmetry.
eapply in_listRepeat_inv.
eauto.
rewrite listRepeat_length.
trivial.
destruct (eqd a2 a2); try congruence.
rewrite getAllBlists_length.
apply num_dem_same_rat1.
unfold natToPosnat, posnatToNat.
trivial.
exists O.
intuition.
eapply rel_map_listRepeat.
intuition.
eapply evalDet_app_eq.
trivial.
eapply pred_count_eq_none; intuition.
subst.
assert (ca_done a2 = ca_done a1).
eapply in_listRepeat_inv.
eauto.
inversion H1; subst; clear H1.
intuition.
destruct (eqd a2 a1); subst; try congruence.
apply rat_num_0.
Qed.
intuition.
unfold lowDistApprox_ls.
exists (listRepeat (@ca_eof A) (length (getAllBlists n))).
exists O.
intuition.
eapply rel_map_listRepeat; intuition.
destruct (@evalDet_dec _ c (s ++ a)).
trivial.
destruct H2.
exfalso.
eapply H0.
eauto.
eauto.
trivial.
eapply pred_count_eq_none; intuition.
assert (a = (ca_eof A)).
eapply in_listRepeat_inv.
eauto.
subst.
discriminate.
eapply rat_num_0.
Qed.
induction 1; intuition; simpl in *.
eapply evalDet_lowDistApprox_ls_done.
trivial.
eapply evalDet_lowDistApprox_ls_not_done.
trivial.
intuition.
simpl in *.
intuition.
subst.
rewrite app_nil_r in *.
eauto.
destruct (IHdat_correct_h1 a).
trivial.
destruct H3.
destruct (IHdat_correct_h2 a).
trivial.
destruct H4.
intuition.
unfold lowDistApprox_ls.
econstructor. econstructor.
intuition.
simpl.
eapply rel_map_app.
eapply rel_map_map.
eapply rel_map_eq.
eapply H5.
trivial.
intuition.
rewrite <- app_assoc in H11.
simpl in *.
trivial.
eapply rel_map_map.
eapply rel_map_eq.
eapply H3.
trivial.
intuition.
rewrite <- app_assoc in H11.
simpl in *.
trivial.
eapply pred_count_app; eauto.
simpl.
rewrite <- H8.
rewrite <- H9.
repeat rewrite <- ratMult_num_den.
rewrite <- ratAdd_den_same.
eapply eqRat_terms.
repeat rewrite mult_1_r.
trivial.
unfold posnatMult, natToPosnat, posnatToNat.
rewrite mult_comm.
simpl.
trivial.
Qed.
intuition.
unfold dat_correct in *.
edestruct low_tree_approx_same_h.
eauto.
trivial.
destruct H1.
econstructor.
econstructor.
intuition.
simpl in *.
eauto.
eauto.
rewrite H4.
eapply eqRat_refl.
Qed.
unfold left_total.
intuition.
destruct (@dat_exists n _ c).
trivial.
exists (lowDistApproxFromTree eqd x a).
eapply low_tree_approx_same.
trivial.
trivial.
Qed.
Inductive datMap(A B : Set)(f : A -> DistApproxTree B -> Prop) : DistApproxTree A -> DistApproxTree B  -> Prop :=
| datMap_leaf_None :
datMap f (dat_leaf None) (dat_leaf None)
| datMap_leaf_Some :
forall a t,
f a t ->
datMap f (dat_leaf (Some a)) t
| datMap_internal :
forall t1a t2a t1b t2b,
datMap f t1a t1b ->
datMap f t2a t2b ->
datMap f (dat_internal t1a t2a) (dat_internal t1b t2b).
(* a variant of datMap that builds a tree of a maximum depth *)
Inductive datMap_depth(A B : Set)(f : nat -> A -> DistApproxTree B -> Prop) : nat -> DistApproxTree A -> DistApproxTree B -> Prop :=
| datMap_depth_leaf_None :
forall n,
datMap_depth f n (dat_leaf None) (dat_leaf None)
| datMap_depth_leaf_Some :
forall n a t,
f n a t ->
datMap_depth f n (dat_leaf (Some a)) t
| datMap_depth_internal :
forall n t1a t2a t1b t2b,
datMap_depth f n t1a t1b ->
datMap_depth f n t2a t2b ->
datMap_depth f (S n) (dat_internal t1a t2a) (dat_internal t1b t2b).
Definition dat_correct_bind(A B : Set)(c1 : Comp B)(c2 : B -> Comp A)(n : nat)(t : DistApproxTree A) :=
exists tb, dat_correct c1 n tb /\
(datMap_depth (fun n' b ta => (dat_correct (c2 b) n' ta)) n tb t).
Definition dat_correct_bind2(A B : Set)(c1 : Comp B)(c2 : B -> Comp A)(n : nat)(t : DistApproxTree A) :=
exists tb, dat_correct c1 n tb /\
(datMap (fun b ta => (dat_correct (c2 b) n ta)) tb t).
induction t; intuition; simpl in *.
destruct o.
destruct (eqd a a0); subst.
exfalso.
eapply H.
simpl.
intuition.
intuition.
intuition.
rewrite IHt1.
rewrite IHt2.
rewrite ratMult_0_l.
rewrite <- ratAdd_0_r.
intuition.
intuition.
eapply H.
unfold getTreeSupport in *.
simpl.
eapply in_getUnique.
eapply in_or_app.
right.
eapply in_getUnique_if.
eauto.
intuition.
eapply H.
unfold getTreeSupport in *.
simpl.
eapply in_getUnique.
eapply in_or_app.
left.
eapply in_getUnique_if.
eauto.
Qed.
induction 1; intuition; simpl in *.
apply sumList_rel_all_0_inv in H1;
intuition.
simpl in *.
intuition.
eapply sumList_rel_only_one_inv in H2.
rewrite H2.
eapply eqRat_refl.
unfold getTreeSupport.
simpl.
eauto.
unfold getTreeSupport.
simpl.
econstructor.
intuition.
econstructor.
intuition.
simpl in *.
intuition.
intuition.
rewrite <- H3.
destruct (eqdb a a); intuition.
rewrite ratMult_1_l.
eapply eqRat_refl.
intuition.
trivial.
unfold getTreeSupport in *.
simpl in *.
assert (sumList_rel
(fun (b : B) (r' : Rat) =>
forall ta' : DistApproxTree A,
mapRel b ta' ->
((lowDistApproxFromTree eqdb t1a b * (1 / 2) * lowDistApproxFromTree eqda ta' a) +
(lowDistApproxFromTree eqdb t2a b * (1 / 2) * lowDistApproxFromTree eqda ta' a)
== r'))
(getUnique (getTreeSupport_dups t1a ++ getTreeSupport_dups t2a) eqdb)
r).
eapply sumList_rel_body_eq.
eapply H3.
intuition.
rewrite <- ratMult_distrib_r.
eapply H4; eauto.
intuition.
trivial.
clear H3.
remember (fun b r' => forall ta',
(mapRel b ta' -> lowDistApproxFromTree eqdb t1a b * lowDistApproxFromTree eqda ta' a == r')) as rel1.
remember (fun b r' => forall ta',
(mapRel b ta' -> lowDistApproxFromTree eqdb t2a b * lowDistApproxFromTree eqda ta' a == r')) as rel2.
edestruct (sumList_rel_left_total rel1).
intuition.
destruct (H1 a0).
eapply in_getUnique.
eapply in_or_app.
left.
eapply in_getUnique_if.
eapply H3.
exists (lowDistApproxFromTree eqdb t1a a0 * lowDistApproxFromTree eqda x a).
subst.
intuition.
assert (x = ta').
eauto.
subst.
intuition.
edestruct (sumList_rel_left_total rel2).
intuition.
subst.
destruct (H1 a0).
eapply in_getUnique.
eapply in_or_app.
right.
eapply in_getUnique_if.
eapply H5.
exists (lowDistApproxFromTree eqdb t2a a0 * lowDistApproxFromTree eqda x0 a).
intuition.
assert (x0 = ta').
eauto.
subst.
intuition.
rewrite IHdatMap1; subst; eauto.
rewrite IHdatMap2; subst; eauto.
assert (sumList_rel
(fun (b : B) (r' : Rat) =>
forall ta' : DistApproxTree A,
mapRel b ta' ->
lowDistApproxFromTree eqdb t1a b * lowDistApproxFromTree eqda ta' a ==
r' * (2/1)) (getUnique (getTreeSupport_dups t1a) eqdb) (x * (1/2))).
eapply (sumList_rel_factor_constant (pos 1) (pos 2)).
eapply sumList_rel_body_eq.
eapply H3.
intuition.
specialize (H6 ta').
rewrite H6.
intuition.
rewrite ratMult_assoc.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
rewrite <- ratMult_num_den.
symmetry.
eapply num_dem_same_rat1.
unfold posnatMult, posnatToNat, natToPosnat.
trivial.
trivial.
rewrite ratMult_assoc.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
rewrite <- ratMult_num_den.
symmetry.
eapply num_dem_same_rat1.
trivial.
trivial.
clear H3.
assert (sumList_rel
(fun (b : B) (r' : Rat) =>
forall ta' : DistApproxTree A,
mapRel b ta' ->
lowDistApproxFromTree eqdb t2a b * lowDistApproxFromTree eqda ta' a ==
r' * (2/1)) (getUnique (getTreeSupport_dups t2a) eqdb) (x0 * (1/2))).
eapply (sumList_rel_factor_constant (pos 1) (pos 2)).
eapply sumList_rel_body_eq.
eapply H5.
intuition.
specialize (H3 ta').
intuition.
rewrite H8.
rewrite ratMult_assoc.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
rewrite <- ratMult_num_den.
symmetry.
eapply num_dem_same_rat1.
unfold posnatMult, posnatToNat, natToPosnat.
trivial.
rewrite ratMult_assoc.
rewrite <- ratMult_1_r at 1.
eapply ratMult_eqRat_compat; intuition.
rewrite <- ratMult_num_den.
symmetry.
eapply num_dem_same_rat1.
trivial.
trivial.
clear H5.
assert (sumList_rel
(fun (b : B) (r' : Rat) =>
forall ta' : DistApproxTree A,
mapRel b ta' ->
lowDistApproxFromTree eqdb t1a b * lowDistApproxFromTree eqda ta' a ==
r' * (2 / 1)) (getUnique (getTreeSupport_dups t1a ++ getTreeSupport_dups t2a) eqdb)
(x * (1 / 2))).
eapply sumList_rel_ls_intersect.
eapply H6.
eapply getUnique_NoDup.
eapply getUnique_NoDup.
trivial.
intuition.
destruct (H1 a0).
eapply in_getUnique.
eapply in_or_app.
left.
eapply in_getUnique_if.
eauto.
assert (r1 * (2/1) == r2 * (2/1)).
rewrite <- H7.
rewrite <- H8.
eapply eqRat_refl.
eauto.
eauto.
eapply ratMult_same_r_inv.
eauto.
intuition.
intuition.
exfalso.
eapply H7.
eapply in_getUnique.
eapply in_or_app.
left.
eapply in_getUnique_if.
eauto.
intuition.
rewrite ratMult_0_l.
eapply ratMult_0.
left.
eapply lowDistApproxFromTree_eq_0.
unfold getTreeSupport.
intuition.
clear H6.
assert (sumList_rel
(fun (b : B) (r' : Rat) =>
forall ta' : DistApproxTree A,
mapRel b ta' ->
lowDistApproxFromTree eqdb t2a b * lowDistApproxFromTree eqda ta' a ==
r' * (2 / 1)) (getUnique (getTreeSupport_dups t1a ++ getTreeSupport_dups t2a) eqdb)
(x0 * (1 / 2))).
eapply sumList_rel_ls_intersect.
eapply H3.
eapply getUnique_NoDup.
eapply getUnique_NoDup.
trivial.
intuition.
destruct (H1 a0).
eapply in_getUnique.
eapply in_or_app.
right.
eapply in_getUnique_if.
eauto.
assert (r1 * (2/1) == r2 * (2/1)).
rewrite <- H7.
rewrite <- H8.
eapply eqRat_refl.
eauto.
trivial.
eapply ratMult_same_r_inv.
eauto.
intuition.
intuition.
exfalso.
eapply H7.
eapply in_getUnique.
eapply in_or_app.
right.
eapply in_getUnique_if.
eauto.
intuition.
rewrite ratMult_0_l.
eapply ratMult_0.
left.
eapply lowDistApproxFromTree_eq_0.
intuition.
clear H3.
symmetry.
eapply sumList_rel_plus_inv.
3:{
eapply H5.
}
3:{
eapply H6.
}
eapply H4.
intuition.
destruct (H1 a0).
trivial.
rewrite <- H7; eauto.
specialize (H8 _ H10).
specialize (H9 _ H10).
eapply ratMult_inverse_nat in H8.
eapply ratMult_inverse_nat in H9.
eapply ratAdd_eqRat_compat.
rewrite ratMult_assoc.
rewrite (ratMult_comm (1/2)).
rewrite <- ratMult_assoc.
eapply H8.
rewrite ratMult_assoc.
rewrite (ratMult_comm (1/2)).
rewrite <- ratMult_assoc.
eauto.
intuition.
destruct (H1 b).
eapply in_getUnique.
eapply in_or_app.
right.
eapply in_getUnique_if.
eauto.
econstructor.
eauto.
intuition.
destruct (H1 b).
eapply in_getUnique.
eapply in_or_app.
left.
eapply in_getUnique_if.
eauto.
econstructor.
eauto.
Qed.
induction t; intuition; simpl in *.
destruct o.
simpl in *.
intuition.
destruct (eqd a a0); subst; intuition.
intuition.
rewrite IHt1.
rewrite IHt2.
rewrite ratMult_0_l.
rewrite <- ratAdd_0_r.
intuition.
intuition.
eapply H.
unfold getTreeSupport in *.
eapply in_getUnique.
simpl.
eapply in_or_app.
right.
eapply in_getUnique_if.
eauto.
intuition.
eapply H.
unfold getTreeSupport in *.
eapply in_getUnique.
simpl.
eapply in_or_app.
left.
eapply in_getUnique_if.
eauto.
Qed.
intuition.
unfold lowDistApprox in *.
destruct H.
destruct H.
intuition.
rewrite H2.
eapply rat_le_1.
eapply le_trans.
eapply pred_count_le_length.
eapply H.
erewrite <- rel_map_length; eauto.
rewrite getAllBlists_length.
reflexivity.
Qed.
intuition.
destruct H2. (*dat_correct_bind2 *)
intuition.
inversion H1; clear H1; subst. (*lowDistApprox_bind *)
unfold dat_correct in *.
symmetry.
eapply lowDistApproxFromTree_datMap_inv; intuition.
eapply H4.
destruct (@dat_exists n _ (c2 b)).
eapply H0.
eapply getTreeSupport_in.
eauto.
eauto.
econstructor.
eauto.
simpl in *.
eapply dat_correct_func; eauto.
eapply sumList_rel_ls_intersect.
eapply sumList_rel_body_eq_strong.
eapply H2.
intuition.
erewrite H5.
eapply eqRat_refl.
eapply low_tree_approx_same.
trivial.
eapply H3.
eapply low_tree_approx_same.
eapply H0.
eapply H1.
eapply H6.
intuition.
eauto.
eapply getSupport_NoDup.
eapply getUnique_NoDup.
eapply comp_eq_dec; eauto.
intuition.
destruct (@dat_exists n _ (c2 a0)).
eapply H0.
trivial.
rewrite <- H5.
rewrite H6.
intuition.
eauto.
eauto.
intuition.
eapply ratMult_0.
left.
eapply getTreeSupport_approx_0.
eauto.
intuition.
eapply ratMult_0.
left.
eapply getTreeSupport_approx_0.
intuition.
eapply H5.
eapply getTreeSupport_in; eauto.
Grab Existential Variables.
eapply comp_eq_dec; eauto.
Qed.
induction ls; intuition; simpl in *.
intuition.
apply in_app_or in H.
intuition.
apply in_map_iff in H0.
destruct H0.
intuition.
inversion H0; clear H0; subst.
econstructor.
split.
eauto.
left.
trivial.
edestruct IHls.
eauto.
intuition.
econstructor.
split.
eauto.
right.
trivial.
Qed.
intuition.
unfold getSupport_bind_cp, getSupport_bind in *.
destruct a0.
eapply in_flattenPair_inv in H.
destruct H.
intuition.
simpl.
eapply in_map_iff in H1.
destruct H1.
intuition.
inversion H1; clear H1; subst.
trivial.
Qed.
unfold rat_inf_limit, inf_limit.
intuition.
assert (forall (epsilon : Rat),
~ epsilon == 0 ->
exists n : nat,
forall n': nat,
n' >= n ->
(forall (b : B) r,
lowDistApprox c1 b n' r ->
(ratDistance r (evalDist c1 b)) <= epsilon)).
assert (forall (epsilon : Rat),
(epsilon == 0 -> False) ->
forall (a : B),
exists n : nat,
forall n' : nat,
n' >= n ->
forall r,
lowDistApprox c1 a n' r ->
(ratDistance r (evalDist c1 a) <= epsilon)).
intuition.
intuition.
specialize (H4 _ H5).
edestruct (rel_map_left_total _ (getSupport c1) H4).
Local Open Scope rat_scope.
econstructor.
intuition.
assert (n' >= (maxList x)).
eapply H7.
edestruct (in_dec (comp_eq_dec c1) b (getSupport c1)).
edestruct (rel_map_in_inv H6); eauto.
intuition.
eapply H12.
eapply le_trans.
eapply maxList_correct; eauto.
eauto.
trivial.
eapply leRat_trans.
eapply eqRat_impl_leRat.
eapply (ratIdentityIndiscernables r).
eapply eqRat_trans.
eapply getSupport_not_In_lowDistApprox; eauto.
eapply eqRat_symm.
eapply getSupport_not_In_evalDist; eauto.
eapply rat0_le_all.
clear H1.
assert (forall (epsilon : Rat),
~ epsilon == 0 ->
exists n : nat,
forall n' : nat,
n' >= n ->
(forall a b r,
In b (getSupport c1) ->
lowDistApprox (c2 b) a n' r ->
(ratDistance r (evalDist (c2 b) a)) <= epsilon)).
assert (forall (epsilon : Rat),
(epsilon == 0 -> False) ->
forall (x : (B * A)),
In (fst x) (getSupport c1) ->
exists n : nat,
forall n' : nat,
n' >= n ->
forall r,
lowDistApprox (c2 (fst x)) (snd x) n' r ->
(ratDistance r (evalDist (c2 (fst x)) (snd x)) <= epsilon)).
intuition.
intuition.
specialize (H1 epsilon0).
intuition.
edestruct (@rel_map_left_total_strong' _ nat (getSupport_bind_cp c1 c2) (fun y => In (fst y) (getSupport c1)) (fun x n => forall n',
n' >= n ->
forall r : Rat,
lowDistApprox (c2 (fst x)) (snd x) n' r ->
(ratDistance r (evalDist (c2 (fst x)) (snd x))) <= epsilon0)).
eapply H6.
eapply in_getSupport_bind_cp_fst.
exists (maxList x).
intuition.
edestruct (in_dec (EqDec_dec (pair_EqDec (comp_EqDec c1) (bind_EqDec c1 c2))) (b, a0) (getSupport_bind_cp c1 c2)).
edestruct (rel_map_in_inv H1); eauto.
intuition.
simpl in *.
eapply H12.
eapply le_trans.
eapply maxList_correct; eauto.
eauto.
trivial.
eapply leRat_trans.
eapply eqRat_impl_leRat.
eapply (ratIdentityIndiscernables r).
apply not_In_getSupport_bind_cp in n.
edestruct n.
intuition.
eapply eqRat_trans.
eapply getSupport_not_In_lowDistApprox; eauto.
eapply eqRat_symm.
eapply getSupport_not_In_evalDist; eauto.
eauto.
eapply comp_eq_dec; eauto.
eapply bind_eq_dec; eauto.
eapply rat0_le_all.
clear H2.
assert (nz (length (getSupport c1))).
econstructor.
eapply getSupport_length_nz.
trivial.
(*----------------------------- choose epsilon here---------------------------- *)
specialize (H4 ((1 / 3 ) * (epsilon * (RatIntro 1 (natToPosnat H2))))).
specialize (H1 ((1 / 3 ) * (epsilon * (RatIntro 1 (natToPosnat H2))))).
(* ---------------------------- choose epsilon here ------------------------------- *)
edestruct H4.
eapply ratMult_nz;
econstructor.
discriminate.
eapply ratMult_nz; econstructor; intuition.
clear H4.
edestruct H1.
eapply ratMult_nz; econstructor.
discriminate.
eapply ratMult_nz; econstructor; intuition.
clear H1.
exists (max x x0).
intuition.
inversion H6; clear H6; subst.
eapply (@leRat_trans _ (epsilon * (RatIntro 1 (natToPosnat H2)) * (length (getSupport c1) / 1))).
simpl.
eapply sumList_rel_distance; eauto.
intuition.
2:{
eapply sumList_rel_sumList.
}
simpl in *.
subst.
assert (well_formed_comp (c2 a0)).
eapply H0.
trivial.
destruct (@lowDistApprox_left_total _ (comp_eq_dec c1) c1 a0 H n').
destruct (@lowDistApprox_left_total _ (bind_eq_dec c1 c2) (c2 a0) a H9 n').
erewrite H8; eauto.
eapply leRat_trans.
eapply ratDistance_ratMult_le.
eapply H5.
eapply Max.max_lub_l.
eapply H1.
trivial.
eapply H4.
eapply Max.max_lub_r.
eapply H1.
trivial.
trivial.
eapply lowDistApprox_le_1; eauto.
eapply lowDistApprox_le_1; eauto.
eapply evalDist_le_1.
eapply evalDist_le_1.
rewrite <- ratMult_assoc.
rewrite <- ratMult_num_den.
rewrite num_dem_same_rat1.
rewrite ratMult_1_l.
eapply leRat_refl.
unfold posnatMult, natToPosnat, posnatToNat.
trivial.
rewrite ratMult_assoc.
rewrite ratMult_comm.
rewrite <- ratMult_num_den.
rewrite num_dem_same_rat1.
rewrite ratMult_1_l.
eapply leRat_refl.
unfold posnatMult, natToPosnat, posnatToNat.
rewrite mult_comm.
trivial.
Qed.
induction t; intuition; simpl in *.
destruct o.
destruct (H a).
simpl.
intuition.
econstructor.
econstructor.
eauto.
econstructor.
econstructor.
edestruct IHt1; eauto.
intuition.
edestruct H.
unfold getTreeSupport in *.
simpl in *.
eapply in_getUnique.
eapply in_or_app.
left.
eapply in_getUnique_if.
eauto.
econstructor; eauto.
edestruct IHt2; eauto.
intuition.
edestruct H.
unfold getTreeSupport in *.
simpl in *.
eapply in_getUnique.
eapply in_or_app.
right.
eapply in_getUnique_if.
eauto.
econstructor; eauto.
econstructor.
econstructor; eauto.
Qed.
intuition.
destruct (@dat_exists n _ c1).
trivial.
edestruct (@datMap_left_total B A (comp_eq_dec c1) x).
2:{
econstructor.
econstructor.
intuition.
eauto.
eauto.
}
intuition.
destruct (@dat_exists n _ (c2 a)).
eapply H0.
eapply getTreeSupport_in.
eauto.
eauto.
econstructor.
eauto.
Qed.
(* dat_better is an inductive predicate that lets us conclude that one tree will produce an approximation that is at least as good as some other tree. *)
Inductive dat_better(A : Set) : DistApproxTree A -> DistApproxTree A -> Prop :=
| dat_better_leaf_None : forall t,
dat_better t (dat_leaf None)
| dat_better_leaf_Some : forall a,
dat_better (dat_leaf (Some a)) (dat_leaf (Some a))
| dat_better_internal : forall ta1 ta2 tb1 tb2,
dat_better ta1 tb1 ->
dat_better ta2 tb2 ->
dat_better (dat_internal ta1 ta2) (dat_internal tb1 tb2).
Hint Constructors dat_better : dat.
induction t; intuition.
destruct o; econstructor.
Qed.
induction 1; intuition.
inversion H; clear H; subst; eauto with  dat.
inversion H1; clear H1; subst.
econstructor.
econstructor; eauto.
Qed.
induction 1; intuition.
inversion H0; clear H0; subst.
assert (ca_done a = ca_done a0).
eapply evalDet_func; eauto.
inversion H0.
econstructor.
econstructor.
specialize (H2 a).
intuition.
inversion H0; clear H0; subst.
specialize (H a).
intuition.
econstructor.
omega.
inversion H2; clear H2; subst.
specialize (H a).
intuition.
econstructor.
assert (n >= n0).
omega.
eauto with dat.
Qed.
induction 1; intuition; simpl in *.
apply rat0_le_all.
rewrite <- IHdat_better1.
rewrite <- IHdat_better2.
eapply leRat_refl.
Qed.
induction t; intuition; simpl in *.
inversion H0; clear H0; subst.
inversion H1; clear H1; subst.
econstructor.
inversion H1; clear H1; subst.
eapply H; eauto.
inversion H0; clear H0; subst.
inversion H1; clear H1; subst.
econstructor; eauto.
Qed.
induction 1; intuition; simpl in *.
inversion H1; clear H1; subst.
econstructor.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
eauto.
inversion H2; clear H2; subst.
inversion H3; clear H3; subst.
econstructor.
eapply IHdat_better1; eauto; omega.
eapply IHdat_better2; eauto; omega.
Qed.
intuition.
unfold dat_correct_bind, dat_correct_bind2 in *.
destruct H.
destruct H0.
intuition.
eapply datMap_depth_better.
4:{
eauto.
}
3:{
simpl.
eauto.
}
eapply dat_correct_dat_better; eauto.
intuition.
eapply dat_correct_dat_better; eauto.
omega.
Qed.
induction t; intuition; simpl in *.
inversion H0; clear H0; subst.
inversion H3; clear H3; subst.
apply evalDet_steps_bind_done_inv in H1.
destruct H1. destruct H0.
intuition.
assert (evalDet_steps (cs_more c1 (ls1 ++ ls2)) (cs_done a (nil ++ ls2))).
eapply evalDet_steps_app_eq.
eauto.
simpl in *.
specialize (evalDet_steps_done_func H1 H0); intuition; subst.
econstructor.
econstructor.
eauto.
econstructor.
intuition.
inversion H0; clear H0; subst.
eapply H3.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eapply evalDet_steps_app_eq.
eauto.
simpl.
eauto.
inversion H0; clear H0; subst.
econstructor.
intuition.
inversion H0; clear H0; subst.
eapply H3.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eapply evalDet_steps_app_eq.
eauto.
simpl.
eauto.
eapply IHt1.
eauto.
rewrite app_assoc.
eauto.
eapply IHt2.
eauto.
rewrite app_assoc.
eauto.
Qed.
induction 1; intuition; subst; simpl in *.
inversion H; clear H; subst. (*evalDet *)
inversion H3; clear H3; subst. (*dat_correct *)
inversion H; clear H; subst. (*evalDet *)
apply evalDet_steps_bind_done_inv in H4.
destruct H4. destruct H. intuition.
econstructor.
econstructor.
specialize (evalDet_steps_done_func H3 H0); intuition; subst.
assert (x0 = nil); eauto; subst.
econstructor.
eauto.
apply evalDet_steps_bind_done_inv in H4.
destruct H4. destruct H0. intuition.
exfalso.
eapply H.
econstructor.
eauto.
apply evalDet_steps_bind_done_inv in H4.
destruct H4. destruct H3. intuition.
exfalso.
eapply H.
econstructor.
eauto.
inversion H3; clear H3; subst.
inversion H0; clear H0; subst.
econstructor.
econstructor.
intuition.
inversion H0; clear H0; subst.
assert (s' = nil); eauto; subst.
eapply H.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eauto.
eauto.
econstructor.
inversion H5; clear H5; subst.
inversion H2; clear H2; subst.
assert (s' = nil); eauto; subst.
econstructor.
econstructor.
intuition.
inversion H2; clear H2; subst.
eapply H.
econstructor.
eapply evalDet_steps_trans.
eapply evalDet_steps_bind_done.
eauto.
eauto.
simpl.
eapply dat_correct_h_bind_app; eauto.
eapply dat_correct_h_bind_app; eauto.
econstructor.
eapply IHdat_correct_h1; eauto.
intuition.
eapply evalDet_app_nil; eauto.
edestruct (@evalDet_dec _ c1 s); trivial.
destruct H5.
exfalso.
eauto.
eapply IHdat_correct_h2; eauto.
intuition.
eapply evalDet_app_nil; eauto.
edestruct (@evalDet_dec _ c1 s); trivial.
destruct H5.
exfalso.
eauto.
Qed.
intuition.
edestruct dat_exists_bind2.
eauto.
eauto.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
symmetry.
eapply (bind_low_tree_approx_same_inv).
eauto.
eauto.
eauto.
eauto.
}
edestruct dat_exists.
eapply well_formed_Bind; eauto.
eapply leRat_trans.
eapply eqRat_impl_leRat.
symmetry.
eapply low_tree_approx_same_inv.
eauto.
eauto.
apply lowDistApprox_dat_better_le.
inversion H3; clear H3; subst.
intuition.
eapply datMap_depth_better.
4:{
eapply dat_correct_bind_same_h.
eapply H4.
eauto.
trivial.
intuition.
eapply evalDet_steps_done_nil_inv; eauto.
eauto.
}
eapply dat_better_refl.
intuition.
eapply dat_correct_dat_better.
eapply H7.
eapply H8.
trivial.
eapply H6.
auto.
Grab Existential Variables.
eapply bind_eq_dec; eauto.
Qed.
intuition.
unfold dat_correct_bind in *.
edestruct (dat_exists).
eauto.
econstructor.
intuition.
eauto.
eapply dat_correct_bind_same_h.
eauto.
eauto.
trivial.
intuition.
eapply evalDet_nil; eauto.
eauto.
Qed.
Fixpoint datDepth (A : Set)(t : DistApproxTree A) : nat :=
match t with
| dat_leaf o => O
| dat_internal t1 t2 =>
S (max (datDepth t1) (datDepth t2))
end.
induction 1; intuition; simpl in *.
inversion H0; clear H0; subst.
econstructor.
inversion H0; clear H0; subst.
inversion H; clear H; subst.
eapply H2; eauto.
omega.
inversion H2; clear H2; subst.
inversion H1; clear H1; subst.
econstructor.
eapply IHdat_better1.
eauto.
eauto.
destruct (le_dec (datDepth tb1) (datDepth tb2)).
rewrite Max.max_r in H3; eauto.
omega.
rewrite Max.max_l in H3; omega.
eauto.
eapply IHdat_better2.
eauto.
eauto.
destruct (le_dec (datDepth tb1) (datDepth tb2)).
rewrite Max.max_r in H3; omega.
rewrite Max.max_l in H3; omega.
eauto.
Qed.
induction 1; intuition; simpl in *.
destruct (le_dec (datDepth t1) (datDepth t2)).
rewrite Max.max_r; eauto.
omega.
rewrite Max.max_l; omega.
Qed.

Lemma dat_better_bind_div2 : forall (A B : Set)(c1 : Comp B)(c2 : B -> Comp A) n t1 t2,
dat_correct_bind c1 c2 n t1 ->
dat_correct_bind2 c1 c2 (div2 n) t2 ->
dat_better t1 t2.