Section RandomPerm.
Variable D R : Set.
Hypothesis D_EqDec : EqDec D.
Hypothesis R_EqDec : EqDec R.
Variable RndR : Comp R.
Hypothesis RndR_wf : well_formed_comp RndR.
Fixpoint inRange(f : list (D * R))(r : R) :=
match f with
| nil => false
| (d', r') :: f' =>
if (eqb r r') then true
else (inRange f' r)
end.
Definition getUnusedR(f : list (D * R)) :=
Repeat (RndR) (fun r => negb (inRange f r)).
intuition.
destruct (in_dec (EqDec_dec _) x (getSupport (getUnusedR ls1))).
unfold getUnusedR in *.
simpl in i.
apply filter_In in i; intuition.
eapply evalDist_Repeat_eq.
intuition.
rewrite H.
trivial.
eapply filter_In; intuition.
eapply sumList_permutation.
eapply NoDup_Permutation.
eapply filter_NoDup.
eapply getSupport_NoDup.
eapply filter_NoDup.
eapply getSupport_NoDup.
intuition.
apply filter_In in H2; intuition.
eapply filter_In; intuition.
rewrite <- H.
trivial.
apply filter_In in H2; intuition.
eapply filter_In; intuition.
rewrite H.
trivial.
unfold getUnusedR in *.
simpl in n.
apply filter_not_In in n.
intuition.
simpl.
rewrite getSupport_not_In_evalDist_h; intuition.
repeat rewrite ratMult_0_r.
intuition.
simpl.
unfold indicator.
rewrite <- H.
rewrite H0.
repeat rewrite ratMult_0_l.
intuition.
Qed.
induction ls; intuition; simpl in *.
discriminate.
case_eq (eqb x b); intuition.
rewrite eqb_leibniz in H0.
subst.
intuition.
right.
eapply IHls.
rewrite H0 in H.
trivial.
Qed.
intuition.
unfold getUnusedR.
eapply (well_formed_Repeat _ _ r).
wftac.
eapply filter_In.
intuition.
rewrite H.
simpl.
trivial.
Grab Existential Variables.
unfold eq_dec; intuition.
eapply (EqDec_dec _).
Qed.
Hint Resolve getUnusedR_wf : wftac.
(* A random permutation *)
Definition randomPerm(p : (list (D * R) *  D)) : Comp (list (D * R) * R) :=
let (f, d) := p in
match (f#d) with
| None => (r <-$ getUnusedR f ; ret ((d, r) :: f, r))
| Some r => ret (f, r)
end.
intuition.
unfold randomPerm.
case_eq (ls#b0); intuition; wftac.
edestruct H; eauto.
intuition.
wftac.
Qed.
(* Many proofs involving random permutations will need to query the random permutation repeatedly.  In order to show that each call to the permutation is well-formed, we need to preserve the invariant that the state of the permutation is actually a permutation (as opposed to an arbitrary function).  The well_formed_perm is the predicate that we will use for this invariant. *)
Definition well_formed_perm ls :=
forall lsd,
NoDup lsd ->
(forall d, In d lsd -> ls#d = None) ->
exists lsr,
(forall r, In r lsr -> inRange ls r = false /\ In r (getSupport RndR)) /\
NoDup lsr /\
length lsd = length lsr.
(* Lemma well_formed_perm_nil : well_formed_perm nil.  intuition. unfold well_formed_perm. intuition. econstructor. intuition. eapply H1. eapply getSupport_NoDup.  exists lsd. intuition.  Qed. *)
intuition.
specialize (H (d :: nil)).
edestruct H.
econstructor.
simpl. intuition.
econstructor.
intuition.
simpl in *.
intuition. subst.
trivial.
intuition.
destruct x.
simpl in *.
omega.
destruct x; simpl in *.
econstructor.
eapply H2.
intuition.
omega.
Qed.
Hint Resolve well_formed_perm_1 : wftac.
induction ls; intuition; simpl in *.
intuition.
subst.
f_equal.
destruct (eqd a0 a0).
trivial.
congruence.
destruct (eqd a0 a); subst.
trivial.
simpl.
f_equal.
eauto.
Qed.
unfold well_formed_perm in *.
intuition.
destruct (in_dec (EqDec_dec _) d lsd).
specialize (H3 d).
intuition.
simpl in *.
rewrite eqb_refl in H4.
discriminate.
edestruct (H (d :: lsd)).
econstructor; trivial.
intuition.
simpl in *.
intuition. subst.
trivial.
specialize (H3 d0).
intuition.
destruct (eqb d0 d).
discriminate.
trivial.
intuition.
(* now I have |lsd| + 1 unique elements that are not in the range *)
(* but r may be in there *)
destruct (in_dec (EqDec_dec _) r x).
(* r is in the list, take it out and we get a list of the correct length *)
exists (removeFirst (EqDec_dec _) x r).
intuition.
simpl.
case_eq (eqb r0 r); intuition.
rewrite eqb_leibniz in H8.
subst.
exfalso.
eapply removeFirst_NoDup_not_in.
eapply H4.
eapply H6.
eapply H5.
eapply removeFirst_in_iff.
eauto.
eapply H5.
eapply removeFirst_in_iff.
eauto.
eapply removeFirst_NoDup.
trivial.
simpl in H7.
eapply eq_add_S.
rewrite H7.
symmetry.
eapply removeFirst_length.
trivial.
(* r is not in the list, just use the tail of it *)
destruct x.
simpl in *. omega.
exists x.
intuition.
simpl in *.
intuition.
case_eq (eqb r1 r); intuition.
exfalso.
rewrite eqb_leibniz in H10.
subst.
intuition.
eapply H5.
right.
trivial.
eapply H5.
simpl.
intuition.
inversion H4; clear H4; subst.
trivial.
Qed.
intuition.
unfold well_formed_perm.
intuition.
destruct (in_dec (EqDec_dec _) d lsd).
specialize (H3 d).
intuition.
simpl in *.
rewrite eqb_refl in H4.
discriminate.
edestruct (H (d :: lsd)).
econstructor; trivial.
intuition.
simpl in H4.
intuition. subst.
trivial.
specialize (H3 d0).
intuition.
simpl in *.
destruct (eqb d0 d).
discriminate.
trivial.
intuition.
destruct (in_dec (EqDec_dec _) r1 x).
exists (removeFirst (EqDec_dec _) x r1).
intuition.
simpl.
case_eq (eqb r r1); intuition.
rewrite eqb_leibniz in H8.
subst.
exfalso.
eapply removeFirst_NoDup_not_in.
eapply H4.
eauto.
case_eq (eqb r r2); intuition.
rewrite eqb_leibniz in H9.
subst.
assert (inRange ls r2 = false).
eapply H5.
eapply removeFirst_in_iff.
eauto.
congruence.
eapply H5.
eapply removeFirst_in_iff.
eauto.
eapply H5.
eapply removeFirst_in_iff.
eauto.
eauto using removeFirst_NoDup.
eapply eq_add_S.
simpl in H7.
rewrite H7.
symmetry.
eapply removeFirst_length.
trivial.
destruct x.
simpl in *.
omega.
exists x.
intuition.
simpl in *.
case_eq (eqb r0 r1); intuition.
rewrite eqb_leibniz in H8.
subst.
intuition.
case_eq (eqb r0 r2); intuition.
rewrite eqb_leibniz in H11.
subst.
assert (inRange ls r2 = false).
eapply H5.
intuition.
congruence.
eapply H5.
intuition.
eapply H5.
simpl.
intuition.
inversion H4; clear H4; subst.
trivial.
Qed.
intuition.
unfold getUnusedR in *.
simpl in H1.
apply filter_In in H1.
intuition.
eapply well_formed_perm_cons; eauto.
destruct (inRange ls r); simpl in *; congruence.
Qed.
intuition.
apply getSupport_Bind_In in H1.
destruct H1.
intuition.
simpl in H3.
intuition.
inversion H1; clear H1; subst.
eapply getUnusedR_preserves_wf; eauto.
Qed.

Lemma randomPerm_preserves_wf : forall ls d ls' r,
well_formed_perm ls ->
In (ls', r) (getSupport (randomPerm (ls, d))) ->
well_formed_perm ls'.