Set Implicit Arguments.
Basics List Plus Program Morphisms Wf Wf_nat Omega
qs_definitions monoid_monad_trans util list_utils sort_order nat_seqs
insertion_sort arith_lems.
Require qs_det_parts.
(* We take as given an arbitrary decidable order: *)
Variable X: E.
(* The Quicksort we'll use is the monadic determinstic one that uses a partition pass, instantiated with the SimplyProfiled monad: *)
Print SimplyProfiled.
Definition counted_cmp (x y: X): (monads.mon SimplyProfiled) comparison := (1%nat, Ecmp _ x y).
Let qs := mon_det_partition.qs _ counted_cmp.
Let part := mon_det_partition.partition _ counted_cmp.
(* By unfolding the (monadic) definition, we can characterize the cost and result of partitioning, and the cost of sorting: *)
Proof with auto.
unfold cost.
induction l...
simpl.
omega.
Qed.
Proof with auto.
induction l.
simpl...
simpl...
destruct (cmp_cmp (Ecmp _ a p) c)...
simpl.
rewrite <- IHl...
Qed.
Proof with auto.
pattern l, (qs l).
apply (qs_det_parts.rect counted_cmp SimplyProfiled_ext)...
intros.
unfold qs_det_parts.partitionPart.
rewrite bind_cost.
rewrite partition_cost.
unfold qs_det_parts.lowRecPart.
repeat rewrite bind_cost.
rewrite return_cost.
rewrite <- plus_assoc.
f_equal.
do 2 rewrite partition_result.
rewrite plus_0_r.
unfold qs.
do 3 f_equal; apply filter_eq_morphism...
intro...
rewrite Ecmp_sym.
unfold Egtb.
destruct (Ecmp X h a)...
intro...
unfold Eltb.
rewrite Ecmp_sym.
destruct (Ecmp X h a)...
Qed.
(* Since cost_qs tells us all we need to know about qs (for the purposes of proving its average case complexity), we will not need any further monad reasoning. We will need some R stuff: *)
Coercion INR: nat >-> R.
Hint Resolve Rmult_lt_0_compat Rmult_lt_0_compat Rinv_0_lt_compat Rle_Rinv: real.
(* We now define the recurrence relation *)
Inductive CR: nat -> R -> Prop :=
| C0: CR 0 0
| Cn n (l: list R): elemsR CR (nats 0 (S n)) l -> CR (S n) (n + 2 * Ravg l).
Hint Constructors CR.
(* .. and note that it is a function: *)
Proof with auto.
intro n. pattern n.
apply (well_founded_ind lt_wf).
intros.
destruct x. inversion_clear H0. inversion_clear H1...
inversion_clear H0.
inversion_clear H1.
rewrite (@elemsRuniq _ _ CR (nats 0 (S x))) with l l0...
intros.
apply H with x0...
destruct (In_nats_inv _ _ _ H1)...
Qed.
(* .. which is even computable: *)
Proof with eauto.
refine (fix F n (a: Acc lt n) {struct a} :=
match a with
| Acc_intro x =>
let Re := fun m (p: lt m n) => F m (x m p)  in _
end).
clearbody Re. clear F.
destruct n...
destruct (elemsRimpl CR (nats 0 (S n)))...
intros.
destruct (In_nats_inv _ _ _ H)...
Qed.
Definition C n: R := proj1_sig (CRimpl (lt_wf n)).
(* .. and which satisfies the following recursive equation: *)
Proof with auto.
unfold C at 1.
destruct CRimpl.
simpl proj1_sig.
induction c...
simpl pred.
f_equal.
f_equal.
f_equal.
generalize H. clear H.
generalize (nats 0 (S n)). intro.
generalize l0. clear n l0.
induction l; intros; inversion_clear H...
simpl.
rewrite <- IHl...
unfold C.
destruct CRimpl.
f_equal.
apply (CRuniq H0 c).
Qed.
(* .. as well as some other properties: *)
Proof with auto with real.
pattern n.
apply (well_founded_ind lt_wf).
intros.
rewrite Ceq.
destruct x...
simpl pred.
apply Rplus_le_le_0_compat...
apply Rmult_le_pos...
apply Rmult_le_pos...
apply Rsum_nonneg.
intros.
apply in_map_iff in H0. destruct H0. destruct H0. subst.
apply H.
destruct (In_nats_inv _ _ _ H1)...
rewrite map_length. rewrite nats_length...
Qed.

Lemma C_S n: C n = 2 * pred n / n + S n / n * C (pred n).