From Equations Require Import Equations.

Require Import Vector.
Derive NoConfusion NoConfusionHom for vector.

Arguments Vector.nil {A}.
Arguments Vector.cons {A} _ {n}.

Notation " x |:| y " := (@Vector.cons _ x _ y) (at level 20, right associativity) : vect_scope.
Notation " x |: n :| y " := (@Vector.cons _ x n y) (at level 20, right associativity) : vect_scope.
Notation "[]v" := Vector.nil (at level 0) : vect_scope.
Local Open Scope vect_scope.

Equations app {A} {n m} (v : vector A n) (w : vector A m) : vector A (n + m) :=
  app []v w := w ;
  app (cons a v) w := a |:| app v w.

Equations In {A n} (x : A) (v : vector A n) : Prop :=
  In x nil := False;
  In x (cons a v) := (x = a) ∨ In x v.

Inductive All {A : Type} (P : AProp) : {n}, vector A nProp :=
| All_nil : All P nil
| All_cons {a n} {v : vector A n} : P aAll P vAll P (a |:| v).

Lemma All_impl {A : Type} (P Q : AProp) {n} (v : vector A n) : ( x, P xQ x) → All P vAll Q v.
Proof. induction 2; constructor; auto. Qed.

Derive Signature for All.
Lemma All_app {A P n m} (v : vector A n) (w : vector A m) :
  @All A P _ vAll P wAll P (app v w).
Proof.
  funelim (app v w). auto.
  intros. depelim H0; simpl in ×. constructor; auto.
Qed.

Lemma In_All {A P n} (v : vector A n) : All P v ↔ ( x, In x vP x).
Proof.
  split. induction 1. intros. depelim H. auto. intros x; simpl. simp In. intuition. subst; auto.
  induction v; simpl; intros; auto; constructor. apply H; simp In; auto.
  firstorder.
Qed.

(* Lemma All_In_All {A P n m} (v : vector A n) (v' : vector A m) : *)
(*   All (fun x => In x v) v' -> All P v -> All P v'. *)
(* Proof. *)
(*   induction 1. simpl. constructor. *)
(*   intros. constructor; auto. *)
(*   eapply In_All; eauto. *)
(* Qed. *)

Inductive Sorted {A : Type} (R : AAProp) : {n}, vector A nProp :=
| Sorted_nil : Sorted R nil
| Sorted_cons {a n} {v : vector A n} : All (R a) vSorted R vSorted R (a |:| v).
Import Sigma_Notations.
Derive Signature for Sorted.

Lemma Sorted_app {A R n m} (v : vector A n) (w : vector A m) :
  @Sorted A R _ vSorted R w
  Sorted R (app v w).
Proof.
Admitted.

Lemma In_app {A n m} (v : vector A n) (w : vector A m) (a : A) : In a vIn a wIn a (app v w).
Proof.
  funelim (app v w). intuition. depelim H0.
  split. intros; depelim H0; simp In in *; intuition. simp In in ×. intuition.
  apply H in H1. intuition.
Qed.

Section QuickSort.
  Context {A : Type} (leb : AAbool).
  Context (leb_inverse : x y, leb x y = falseleb y x = true).
  Local Definition sorted {n} (v : vector A n) := Sorted (fun x yleb x y = true) v.
  Set Program Mode.

  Equations? filter {n} (v : vector A n) (f : Abool) :
    &{ k : nat & { v : vector A k | knAll (fun xf x = true) v } } :=
    filter nil f := &(0 & nil);
    filter (cons a v') f with dec (f a) :=
           { | left H ⇒ &(_ & cons a (filter v' f).2);
             | right H ⇒ &(_ & (filter v' f).2) }.
  Proof.
    split; auto. constructor.
    destruct filter as [n' [v'' [Hn' Hv']]]. simpl.
    split; auto with arith. constructor; auto.
    destruct filter as [n' [v'' [Hn' Hv']]]. simpl.
    split; auto with arith.
  Defined.

  Equations? pivot {n} (v : vector A n) (f : Abool) :
    &{ k : nat & &{ l : nat & &{ v' : vector A k &
    { w : vector A l
    | (k + l = n)%nat
      ∧ x, In x v
                   (if f x then In x v'
                    else In x w) } } } } :=
                   (*   All (fun x => In x v /\ f x = true) v' *)
                   (* /\ All (fun x => In x v /\ f x = false) w } } } } := *)
    pivot nil f := &(0 , 0 , nil & nil);
    pivot (cons a v') f with dec (f a), pivot v' f :=
           { | left H | &(k, l, v & w) ⇒ &(_ , _, cons a v & w);
             | right H | &(k, l, v & w) ⇒ &(_ , _, v & cons a w) }.
  Proof.
    split; intros; simp In; auto. intuition. destruct (f x); auto. simpl.
    split; auto with arith. intros x. simp In. split; intros Hx.
    intuition; subst; try rewrite H; intuition. specialize (proj1 (i _) H0). destruct (f x); intuition.
    specialize (i x). destruct (f x); intuition.
    split; auto with arith. intros x. constructor; simp In; intuition auto.
    subst. rewrite H. auto. specialize (proj1 (i _) H1). destruct (f x); intuition.
    specialize (i x). destruct (f x); intuition.
  Defined.

  Equations? qs {n} (l : vector A n) : { v : vector A n | sorted v ∧ ( x, In x lIn x v) } by wf n lt :=
    qs nil := nil ;
    qs (cons a v) with pivot v (fun xleb x a) :=
                { | &(k, l, lower & higher) ⇒
                    app (qs lower) (a |:| qs higher) }.
  Proof.
    all:simpl. all:repeat (destruct qs; simpl).
    repeat constructor; trivial. auto with arith. auto with arith.
    simpl. destruct (eq_sym (plus_n_Sm k l)). simpl.
    intuition.
    apply Sorted_app; auto. constructor.
    apply In_All. intros x1 Inx1. apply H2 in Inx1. eapply leb_inverse. specialize (

    eapply All_In_All; eauto. eapply All_impl; eauto. simpl. intros x1 [inx1 lebx1].
    apply leb_inverse; assumption. intuition.
    eapply All_app. eapply All_In_All; eauto. eapply All_impl; eauto. simpl.
    intros x1 [inx1 lebx1]. constructor; auto.
    constructor; auto. constructor.
    eapply All_In_All; eauto.
    eapply All_impl; eauto. simpl. intros x1 [Inx1 lebx1]. constructor; auto.
  Defined.

  Definition qs_forget {n} (l : vector A n) : vector A n := qs l.

  (* Proof after the definition. *)

  Lemma All_In {n} (v : vector A n) P : All P v → ( x, In x vP x).
  Proof. induction 1. intros x Hx. depelim Hx. intros x Hx. depelim Hx. auto. auto. Qed.

  Lemma All_In_self {n} (v : vector A n) : All (fun xIn x v) v.
  Proof.
    induction v. constructor. constructor. constructor. eapply All_impl; eauto. simpl.
    intros. constructor; auto.
  Qed.

  Local Open Scope program_scope.

  Local Open Scope program_scope.
  Lemma qs_all {n} (l : vector A n) : x, In x (qs_forget l) → In x l.
  Proof.
    intros x. unfold qs_forget. destruct (qs l). simpl; eauto. destruct a.
    eapply (All_In _ _ H0).
  Qed.

  Lemma all_qs {n} (l : vector A n) : x, In x lIn x (qs_forget l).
  Proof.
    intros x. unfold qs_forget. funelim (qs l); simpl.
    + trivial.
    + destruct qs_obligation_4. simpl.
      clear H1.
      intros Hx. eapply In_app. destruct Hx.
      destruct pr6. simpl in ×. destruct a. destruct a. simpl in ×.

      constructor. clear Heq. eapply All_In in a. intuition eauto. auto.
      clear Heq; intuition; destruct pr6; intuition; simpl in ×.
      depelim H1. constructor. constructor. simpl in H1. apply H0 in H1.
      intuition. eapply All_In in H5. intuition eauto. auto.
  Qed.
  Lemma qs_all {n} (l : vector A n) : x, In x (qs_forget l) → In x l.
  Proof.
    intros x. unfold qs_forget. funelim (qs l); simpl.
    + trivial.
    + destruct qs_obligation_4. simpl.
      clear H1.
      intros Hx. apply In_app in Hx. destruct Hx. apply H in H1.
      destruct pr6. simpl in ×. destruct a. destruct a. simpl in ×.
      constructor. clear Heq. eapply All_In in a. intuition eauto. auto.
      clear Heq; intuition; destruct pr6; intuition; simpl in ×.
      depelim H1. constructor. constructor. simpl in H1. apply H0 in H1.
      intuition. eapply All_In in H5. intuition eauto. auto.
  Qed.

  Lemma qs_equiv {n} (l : vector A n) : x, In x lIn x (qs_forget l).
  Proof.
    split; auto using qs_all. intros.
    unfold qs_forget. funelim (destruct qs. simpl. intuition.
    eapply (All_In in H1.
    pose (All_In_self x0). eapply All_In_All in a; eauto.

End QuickSort.

Extraction Inline pivot.
Extraction qs.

This page has been generated by coqdoc