(* 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.		*)
Set Implicit Arguments.
Local Open Scope nat_scope.
Opaque getSupport.
induction 1; intuition; simpl in *.
(* Bind case *)
repeat simp_in_support.
destruct x.
rewrite mult_plus_distr_r.
pose proof H4.
eapply (IHqueries_at_most _ count) in H4.
eapply (H1 _ _ S count) in H5.
rewrite H5.
rewrite plus_comm.
rewrite <- (plus_assoc).
rewrite (plus_comm (q2 * n)).
rewrite plus_assoc.
eapply plus_le_compat.
eauto.
eapply le_refl.
intuition.
intuition.
(* query case *)
rewrite plus_0_r.
eapply H; eauto.
(* ret case *)
Transparent getSupport.
repeat simp_in_support.
intuition.
(* run case *)
repeat simp_in_support.
destruct x.
simpl in *.
specialize (IHqueries_at_most (S * S0)%type (fun p =>  count (snd p)) _
(fun (x : S * S0) (y : A) =>
p <-$ (oc (fst x) y) S0 eqds0 o (snd x);
ret (fst (fst p), (snd (fst p), snd p)))
(s, s0) (q2 * n)
).
eapply le_trans.
eapply IHqueries_at_most.
intuition.
simpl.
repeat simp_in_support.
destruct x.
simpl in *.
eapply H1.
eauto.
eauto.
eauto.
simpl.
rewrite mult_assoc.
intuition.
(* trans case *)
eapply le_trans.
eapply IHqueries_at_most.
eauto.
eauto.
eapply plus_le_compat; intuition.
eapply mult_le_compat; intuition.
Grab Existential Variables.
repeat econstructor.
eauto.
Qed.
Local Open Scope rat_scope.
intuition.
simpl in *.
rewrite (sumList_partition evta).
eapply ratAdd_leRat_compat.
assert ( sumList (getSupport c)
(fun a : A => evalDist c a * Pr  [f a ] * (if evta a then 1 else 0)) <=
sumList (getSupport c)
(fun b : A =>
evalDist c b * (if EqDec_dec bool_EqDec (evta b) true then 1 else 0)) ).
eapply sumList_le; intuition.
destruct (EqDec_dec bool_EqDec (evta a) true ).
rewrite e.
eapply ratMult_leRat_compat; intuition.
eapply leRat_trans.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply evalDist_le_1.
rewrite ratMult_1_r.
intuition.
destruct (evta a); intuition.
repeat rewrite ratMult_0_r.
eapply rat0_le_all.
rewrite H1.
eapply H.
assert ( sumList (getSupport c)
(fun a : A => evalDist c a * Pr  [f a ] * (if evta a then 0 else 1)) <=
sumList (getSupport c)
(fun a : A => k2 * (evalDist c a * (if evta a then 0 else 1)))).
eapply sumList_le.
intuition.
case_eq (evta a); intuition.
eapply eqRat_impl_leRat.
repeat rewrite ratMult_0_r.
intuition.
rewrite H0.
eapply eqRat_impl_leRat.
repeat rewrite ratMult_1_r.
eapply ratMult_comm.
trivial.
trivial.
rewrite H1.
rewrite sumList_factor_constant_l.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply ratMult_1_r.
}
eapply ratMult_leRat_compat; intuition.
assert (sumList (getSupport c)
(fun a : A => evalDist c a * (if evta a then 0 else 1)) <=
sumList (getSupport c)
(fun a : A => evalDist c a)).
eapply sumList_le.
intuition.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply ratMult_1_r.
}
eapply ratMult_leRat_compat; intuition.
destruct (evta a); intuition.
eapply rat0_le_all.
rewrite H2.
eapply evalDist_sum_le_1.
Qed.
Local Opaque evalDist.
induction 1; intuition; simpl in *.
inline_first.
assert (
Pr
[a <-$ c S eqds o s;
p <-$ ([z, s']<-2 a; (f z) S eqds o s'); ret evt (snd p) ] <=
q1 / 1 * k (i * q1 + count s)%nat +
q2 / 1 * k (i * q2 + (i * q1 + count s))%nat
).
eapply evalDist_bind_event_le.
eapply (@IHqueries_at_most _ _ _ count evt); intuition.
intros.
comp_simp.
eapply leRat_trans.
eapply (@H1 _ _ _ _ _ count evt).
eapply H2.
trivial.
intuition.
intuition.
eapply ratMult_leRat_compat; intuition.
eapply H2.
eapply plus_le_compat; intuition.
eapply le_trans.
eapply (qam_count_gen _ _ _ _ _ i).
intuition.
eapply H5.
eauto.
eauto.
rewrite mult_comm.
intuition.
rewrite H6.
clear H6.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
symmetry.
rewrite ratAdd_num.
eapply ratMult_distrib_r.
}
eapply ratAdd_leRat_compat;
eapply ratMult_leRat_compat.
1, 3: reflexivity.
intuition.
eapply H2.
rewrite mult_plus_distr_l.
rewrite plus_comm.
repeat rewrite <- plus_assoc.
eapply plus_le_compat; intuition.
rewrite H1; intuition.
rewrite <- ratMult_1_l.
eapply ratMult_leRat_compat; intuition.
eapply leRat_terms; intuition.
inline_first.
eapply distro_irr_le.
intuition.
comp_simp.
simpl.
rewrite H0.
rewrite evalDist_ret_0.
eapply rat0_le_all.
congruence.
inline_first.
assert (EqDec C).
eapply oc_EqDec; intros.
eapply c.
assert (B * S).
eapply oc_base_exists.
eapply oc.
trivial.
trivial.
intuition.
assert (B' * S0).
eapply comp_base_exists.
eapply o.
trivial.
trivial.
intuition.
intuition.
trivial.
assert
(
(evalDist
(Bind
(c (prod S S0) (pair_EqDec eqds eqds0)
(fun (x : prod S S0) (y : A) =>
Bind ((oc (fst x) y) S0 eqds0 o (snd x))
(fun p : prod (prod B S) S0 =>
Ret (EqDec_dec (pair_EqDec eqdb (pair_EqDec eqds eqds0)))
(pair (fst (fst p)) (pair (snd (fst p)) (snd p)))))
(pair s s0))
(fun a : prod C (prod S S0) =>
Bind
(Ret
(EqDec_dec
(pair_EqDec
(pair_EqDec
(oc_EqDec c
(fun x : A =>
fst
(oc_base_exists (oc s x)
(fun y : A' =>
fst (comp_base_exists (o s0 y)))))
(fun x : A =>
EqDec_pair_l
(oc_EqDec (oc s x)
(fun y : A' =>
fst (comp_base_exists (o s0 y)))
(fun y : A' =>
EqDec_pair_l (comp_EqDec (o s0 y)) s0)) s))
eqds) eqds0))
(pair (pair (fst a) (fst (snd a))) (snd (snd a))))
(fun p : prod (prod C S) S0 =>
Ret (EqDec_dec bool_EqDec) (evt (snd p))))) true)
==
Pr
[a <-$
c (S * S0)%type (pair_EqDec eqds eqds0)
(fun (x : S * S0) (y : A) =>
p <-$ (oc (fst x) y) S0 eqds0 o (snd x);
ret (fst (fst p), (snd (fst p), snd p))) (s, s0);
ret (evt (snd (snd a))) ]
).
comp_skip.
simpl.
intuition.
rewrite H7.
clear H7.
eapply leRat_trans.
eapply (@IHqueries_at_most _ _
((fun (x : S * S0) (y : A) =>
p <-$ (oc (fst x) y) S0 eqds0 o (snd x);
ret (fst (fst p), (snd (fst p), snd p))))
(fun p => count (snd p)) (fun p => evt (snd p))
_ (fun x => q2 / 1 * k (x)%nat) (i * q2)%nat).
intuition.
eapply ratMult_leRat_compat; intuition.
trivial.
intuition.
comp_inline_l.
assert (
Pr
[a1 <-$ (oc (fst (a, b)) a0) S0 eqds0 o (snd (a, b));
p <-$ ret (fst (fst a1), (snd (fst a1), snd a1)); ret evt (snd (snd p)) ]
==
Pr
[a1 <-$ (oc (fst (a, b)) a0) S0 eqds0 o (snd (a, b));
ret evt (snd a1) ]
).
comp_skip.
simpl.
intuition.
rewrite H8.
clear H8.
simpl.
eapply leRat_trans.
eapply (@H1 ); intuition.
reflexivity.
intuition.
repeat simp_in_support.
destruct x.
simpl in *.
rewrite mult_comm.
eapply qam_count_gen.
eapply H0.
intuition.
eapply H5.
eapply H7.
eapply H8.
simpl.
rewrite <- ratMult_assoc.
eapply ratMult_leRat_compat.
eapply eqRat_impl_leRat.
rewrite <- ratMult_num_den.
eapply eqRat_terms; intuition.
eapply H2.
eapply plus_le_compat. 2: reflexivity.
rewrite <- mult_assoc.
eapply mult_le_compat. reflexivity.
rewrite mult_comm.
reflexivity.
rewrite IHqueries_at_most.
eapply ratMult_leRat_compat; intuition.
eapply leRat_terms; intuition.
intuition.
trivial.
intuition.
intuition.
Grab Existential Variables.
trivial.
repeat econstructor; eauto.
Qed.
intuition.
eapply leRat_trans.
eapply oc_eventProb; intuition.
eauto.
rewrite H4.
rewrite mult_1_l.
rewrite plus_0_r.
intuition.
Qed.
Local Open Scope nat_scope.

Theorem qam_count :
forall (A B C : Set)(c : OracleComp A B C)(q : nat),
queries_at_most c q ->
forall (S : Set)(count : S -> nat)(eqds : EqDec S)(o : S -> A -> Comp (B * S))(s : S),
(forall a b x y,
In (a, b) (getSupport (o x y)) ->
count b <= 1 + (count x)) ->
count s = 0 ->
forall a b,
In (a, b) (getSupport (c _ _ o s)) ->
count b <= q.