Section contents.
Variable X: Set.
Variable Xle: X -> X -> Prop.
Hypothesis XO: preorder X Xle.
Definition Xlt (x y: X): Prop := Xle x y /\ ~ Xle y x.
(* Vsorted *)
Inductive sorted: forall n, Vector.t X n -> Prop := (* Coq.Sorting's definition sucks *)
| sorted_nil: sorted Vector.nil
| sorted_one x: sorted (Vector.cons x Vector.nil)
| sorted_more (a b: X) n (t: Vector.t X n):
Xle a b -> sorted (Vector.cons b t) -> sorted (Vector.cons a (Vector.cons b t)).
Hint Constructors sorted.
Proof with auto.
intros.
rewrite (eq_cons v).
apply sorted_more...
rewrite <- eq_cons...
Qed.
Proof with auto.
induction v; intros.
apply sorted_one.
apply sorted_more...
apply H. left...
Qed.
Proof with auto.
induction v...
intros.
simpl.
apply sorted_cons'.
intros.
clear IHv.
rewrite list_round_trip in H2.
destruct (List.in_app_or v w y H2).
simpl in H.
apply (sorted_cons_inv' H).
rewrite list_round_trip...
apply H1...
left...
apply IHv...
simpl in H.
apply sorted_tail with a...
intros.
apply H1...
simpl...
Qed.
Proof with auto with arith.
intros s.
induction s.
intros.
inversion i.
intros.
rewrite (nb1 i).
rewrite (nb1 j).
simpl.
apply preord_refl...
intro i. pattern i. apply natBelow_S_inv'; [idtac | intro m]; intro j; pattern j; apply natBelow_S_inv'.
rewrite nth_0.
intros. apply preord_refl...
rewrite nth_0.
intros.
rewrite nth_S.
apply (preord_trans _ _ XO) with (nth (Vector.cons b t) (nb0 _))...
rewrite val_Snb.
simpl @nb_val.
intros.
inversion H0.
intro.
do 2 rewrite val_Snb.
do 2 rewrite nth_S...
Qed.
Proof with auto with arith.
intros s.
induction s.
intros.
inversion i.
intros i j.
rewrite (nb1 i).
rewrite (nb1 j).
simpl.
intro.
elimtype False.
apply (Xlt_irrefl H).
intro i. pattern i. apply natBelow_S_inv'; [idtac | intro m]; intro j; pattern j; apply natBelow_S_inv'.
rewrite nth_0.
intros.
elimtype False.
apply (Xlt_irrefl H0).
intro.
rewrite val_nb0.
rewrite val_Snb...
rewrite nth_S.
rewrite nth_0.
intros.
elimtype False.
apply (Xle_nlt H).
apply Xle_lt_trans with (nth (Vector.cons b t) m)...
apply (sorted_le_indices_le_values s (nb0 _) m)...
intro.
do 2 rewrite nth_S.
do 2 rewrite val_Snb...
Qed.
(* insertion sort *)
Variable XleDec: forall x y, { Xle x y } + { Xle y x }.
Fixpoint insert_ordered (x: X) n: Vector.t X n -> Vector.t X (S n) :=
match n return Vector.t X n -> Vector.t X (S n) with
| 0 => fun _ => Vector.cons x Vector.nil
| S n' => fun v => if XleDec x (head v)
then Vector.cons x v
else Vector.cons (head v) (insert_ordered x (tail v))
end.
Hint Immediate perm_refl.
Proof with auto.
induction v; simpl...
destruct (XleDec x h)...
apply perm_trans with (Vector.cons h (Vector.cons x v))...
Qed.
Proof with auto.
induction v.
simpl...
simpl.
intros.
destruct (XleDec x h).
apply sorted_more...
destruct n.
rewrite (eq_nil v).
simpl.
apply sorted_more...
cset (IHv (sorted_tail H)). clear IHv.
cset (eq_cons v).
revert H1.
generalize (head v).
generalize (tail v).
intros.
subst.
simpl in *.
destruct (XleDec x x1).
apply sorted_more...
apply sorted_more...
apply (sorted_cons_inv H).
Qed.
Fixpoint insertion_sort n: Vector.t X n -> Vector.t X n :=
match n return Vector.t X n -> Vector.t X n with
| 0 => fun _ => Vector.nil
| S n' => fun v => insert_ordered (head v) (insertion_sort (tail v))
end.

Lemma insertion_sort_sorts n (l: Vector.t X n): sorted (insertion_sort l).