Global Set Automatic Coercions Import.
Set Implicit Arguments.
(* Intended for use without Import. *)
Require Vector.
Require List.
Arguments Vector.cons [A] _ [n].
Arguments Vector.nil [A].
(* eliminators/inversion *)
Definition head A n (v: Vector.t A (S n)): A :=
match v with
| Vector.nil => I | Vector.cons h _ _ => h
end.
Definition tail n A (v: Vector.t A (S n)): Vector.t A n :=
match v with
| Vector.nil => I | Vector.cons _ _ t => t
end.
(* conversion to/from list *)
Fixpoint to_list X (n: nat) (v: Vector.t X n) {struct v}: List.list X :=
match v with
| Vector.nil => List.nil | Vector.cons x _ v' => List.cons x (to_list v')
end.
Fixpoint from_list A (l: List.list A): Vector.t A (List.length l) :=
match l return Vector.t A (List.length l) with
| List.nil => Vector.nil | List.cons h t => Vector.cons h (from_list t)
end.
Coercion to_list: Vector.t >-> List.list.
Coercion from_list: List.list >-> Vector.t.
Proof with try reflexivity. induction l... simpl. rewrite IHl... Qed.
Proof with auto.
revert f.
induction v...
intros.
simpl.
apply (IHv (fun (m: nat) (w: Vector.t X m) => f (S m) (Vector.cons h w))).
Qed.
Proof with auto.
induction n; intros.
rewrite (eq_nil x), (eq_nil y)...
rewrite (eq_cons x), (eq_cons y) in *...
inversion H.
rewrite (IHn (tail x) (tail y))...
Qed.
Proof with auto.
induction l; simpl; intros.
rewrite (eq_nil v)...
rewrite <- H...
simpl.
rewrite list_round_trip...
Qed.
(* simultaneous induction over two vectors *)
(* misc *)
Proof with auto. induction l... simpl. apply eq_S... Qed.
Fixpoint app A n: Vector.t A n -> forall m, Vector.t A m -> Vector.t A (n + m) :=
match n return Vector.t A n -> forall m, Vector.t A m -> Vector.t A (n + m) with
| 0 => fun _ _ w => w
| S n' => fun v _ w => Vector.cons (head v) (app (tail v) w)
end.
(* vmap *)
Fixpoint map X Y (f: X -> Y) (n: nat) (v: Vector.t X n): Vector.t Y n :=
match v with
| Vector.nil => @Vector.nil Y
| Vector.cons h _ t => Vector.cons (f h) (map f t)
end.
(*Fixpoint map X Y (f: X -> Y) (n: nat): Vector.t X n -> Vector.t Y n := match n with | 0 => fun _ => Vector.nil Y | S n' => fun v => Vector.cons (f (head v)) (map f (tail v)) end.*)
Proof with auto.
induction v...
simpl.
rewrite IHv...
Qed.
Proof with auto.
induction v...
simpl.
rewrite IHv.
rewrite (e h)...
Qed. (* todo: as a morphism *)
(* vnth *)
Definition natBelow_S_bla (T: Type) (n: nat) (b: natBelow n): T -> (natBelow (pred n) -> T) -> T :=
match b with
| mkNatBelow 0 _ => fun z s => z
| mkNatBelow (S i) p => fun z s => s (mkNatBelow i p)
end.
Proof with auto.
induction v.
inversion i.
simpl.
destruct (natBelow_S_inv i).
destruct s.
subst.
simpl.
unfold natBelow_S_bla.
unfold Snb.
simpl.
destruct x.
apply IHv.
subst...
Qed.
Proof with auto.
revert n x y.
apply (double_rect (fun n (x y: Vector.t A n) => ext_eq (nth x) (nth y) -> x = y))...
intros.
cset (H0 (nb0 n)).
simpl in H1.
subst.
rewrite H...
intro.
cset (H0 (Snb x)).
repeat rewrite nth_S in H1...
Qed.
Proof with auto.
induction i using natBelow_rect in v |- *.
simpl.
intros.
rewrite (eq_cons v).
simpl head.
left...
intros.
rewrite (eq_cons v).
right.
simpl plus.
fold (Snb (mkNatBelow v0 p)).
rewrite nth_S...
Qed.
Proof with auto.
induction n.
intros.
rewrite (eq_nil v)...
intros.
rewrite (eq_cons v).
simpl.
rewrite IHn...
Qed.
Proof with auto.
induction v.
intros.
inversion H.
intros.
inversion_clear H.
exists (nb0 n).
simpl...
destruct (IHv H0).
exists (Snb x).
rewrite nth_S...
Qed.
Proof with auto.
induction n in m, a, b, c, d |- *; simpl; intros.
rewrite (eq_nil a).
rewrite (eq_nil b)...
destruct (Vcons_eq_inv H).
destruct (IHn _ _ _ _ _ H1).
split...
rewrite (eq_cons a).
rewrite (eq_cons b).
rewrite H0.
rewrite H2...
Qed.
(* remove *)
Definition remove (T: Set) (n: nat) (v: Vector.t T (S n)) (nb: natBelow (S n)): Vector.t T n :=
natBelow_rect_S
(fun (n0: nat) (_: natBelow (S n0)) => Vector.t T (S n0) -> Vector.t T n0)
(fun p => @tail p _)
(fun v p H v0 => Vector.cons (head v0) (H (tail v0))) nb v.
(* permutations *)
Inductive Permutation (A: Type): forall n, Vector.t A n -> Vector.t A n -> Prop :=
| perm_nil: Permutation Vector.nil Vector.nil
| perm_skip (x: A) n (v v': Vector.t A n): Permutation v v' -> Permutation (Vector.cons x v) (Vector.cons x v')
| perm_swap (x y: A) n (l: Vector.t A n): Permutation (Vector.cons y (Vector.cons x l)) (Vector.cons x (Vector.cons y l))
| perm_trans n (l l' l'': Vector.t A n): Permutation l l' -> Permutation l' l'' -> Permutation l l''.
Hint Resolve perm_nil.
Hint Resolve perm_skip.
Hint Resolve perm_swap.
Proof with auto. intros p. induction p... apply perm_trans with l'... Qed.
Proof with reflexivity.
revert v.
pattern n, i.
apply natBelow_rect_S.
simpl.
intros.
rewrite (eq_cons v).
simpl.
do 2 rewrite remove_head...
intros.
simpl plus.
cset remove_tail.
simpl plus in *.
rewrite H0.
rewrite H0.
simpl.
rewrite <- H.
rewrite (eq_cons v0).
reflexivity.
Qed.
Proof with auto.
revert v.
pattern n, nb.
apply natBelow_rect_S.
simpl.
intros.
rewrite remove_head.
rewrite (eq_cons v).
simpl.
apply perm_refl.
intros.
simpl plus.
rewrite remove_tail.
cset (H (tail v0)).
clear H.
simpl plus in *.
cset' (remove (tail v0) (mkNatBelow v p)).
fold (Snb (mkNatBelow v p)).
rewrite nth_S.
cut (Permutation (Vector.cons (nth (tail v0) (mkNatBelow v p)) (Vector.cons (head v0) H)) (Vector.cons (head v0) (tail v0))).
rewrite <- eq_cons.
intros...
apply perm_trans with (Vector.cons (head v0) (Vector.cons (nth (tail v0) (mkNatBelow v p)) H))...
Qed.
Definition remove_In (X: Set) n (v: Vector.t X (S n)) x i (p: List.In x (remove v i)): List.In x v
:= incl_In x p (SkipList_incl (SkipList_remove i v)).
(* nats *)
Proof with auto. (* todo: rename *)
induction v in u, w |- *...
simpl.
intros.
destruct H.
left.
subst.
apply natBelow_unique.
rewrite val_Snb.
rewrite nb_val_eq_rec_r.
rewrite nb_val_eq_rec_r...
right.
rewrite <- List_map in H.
destruct (In_map_inv H). clear H.
destruct H0.
subst.
set (fun d: natBelow (S (S (u + v))) => eq_rec_r natBelow d (eq_S (u + S v) (S (u + v)) (trans_plus_n_Sm u v))).
replace (Snb (eq_rec_r natBelow x (trans_plus_n_Sm u v))) with (n (Snb x)).
rewrite <- List_map.
apply List.in_map.
apply (IHv (S u))...
apply natBelow_unique.
subst n.
simpl.
rewrite val_Snb.
repeat rewrite nb_val_eq_rec_r.
rewrite val_Snb...
Qed.
Proof with auto.
induction v in n, m |- *.
simpl.
intros.
left.
rewrite nb_val_eq_rec_r...
simpl.
intros.
repeat rewrite nb_val_eq_rec_r.
simpl.
cset (IHv n m).
simpl in H.
rewrite nb_val_eq_rec_r in H.
destruct H.
right.
left.
simpl.
simpl in H.
apply eq_S...
rewrite map_map in H.
rewrite <- List_map in H.
destruct (In_map_inv H). clear H.
destruct H0.
unfold compose in H.
rewrite nb_val_eq_rec_r in H.
simpl.
right.
right.
rewrite map_map.
rewrite map_map.
unfold compose.
assert (ext_eq (fun x1: natBelow (S (S (m + (v + n)))) => nb_val (eq_rec_r natBelow (eq_rec_r natBelow x1 (eq_S (m + S (v + n)) (S (m + (v + n))) (trans_plus_n_Sm m (v + n)))) (trans_plus_n_Sm m (S (v + n))))) nb_val).
intro.
repeat rewrite nb_val_eq_rec_r...
rewrite (map_ext H1).
replace (S (v + m)) with (nb_val (Snb x)).
rewrite <- List_map.
apply List.in_map.
apply (In_nats_S (v + n) (S m))...
clear H1 H0.
destruct x.
simpl in *.
apply eq_S...
Qed.
Proof with auto.
intros.
destruct (le_exists_plus H).
subst.
assert (x0 < n) by omega.
destruct (lt_exists_plus H1).
subst.
rewrite plus_comm.
apply In_nb_nats.
Qed.
Proof with auto.
intros.
rewrite <- List_map in H.
destruct (In_map_inv H). clear H.
destruct H0.
rewrite <- (natBelow_unique _ _ H)...
Qed.
Proof with auto.
induction n.
intros.
rewrite (eq_nil a).
rewrite (eq_nil b).
apply perm_nil.
pattern a. apply S_rect. clear a. intros ha ta.
pattern b. apply S_rect. clear b. intros hb tb.
intros.
assert (List.In ha (Vector.cons hb tb)).
apply H0.
left...
destruct (In_inv_perm ha (Vector.cons hb tb) H1).
apply perm_trans with (Vector.cons ha x)...
apply perm_skip.
apply IHn.
inversion_clear H...
cut (List.incl ta (Vector.cons ha x)).
intros.
simpl in H3.
do 2 intro.
destruct (H3 _ H4)...
subst.
inversion_clear H.
elimtype False...
apply List.incl_tran with (to_list (Vector.cons hb tb)).
do 2 intro.
apply H0.
right...
apply Permutation_incl.
apply Permutation.Permutation_sym.
apply List_Permutation...
Qed.
Proof with auto.
induction z in y, x |- *.
intros.
elimtype False...
simpl.
rewrite <- List_map.
intro.
destruct H.
subst.
rewrite nb_val_eq_rec_r.
simpl.
omega.
destruct (In_map_inv H). clear H.
destruct H0.
subst.
rewrite nb_val_eq_rec_r.
destruct (IHz (S y) x0 H0).
split.
apply le_Sn_le...
rewrite <- plus_n_Sm in H1...
Qed.
Proof with auto. (* todo: proof way too long *)
induction y in x |- *.
simpl...
simpl.
intros.
apply List.NoDup_cons.
intro.
rewrite <- List_map in H.
destruct (In_map_inv H). clear H.
destruct H0.
destruct (In_nats_inv y (S x) x0 H0).
assert (nb_val x0 = x).
replace x with (nb_val (eq_rec_r natBelow (mkNatBelow x y) (trans_plus_n_Sm x y))).
rewrite <- H.
rewrite nb_val_eq_rec_r...
rewrite nb_val_eq_rec_r...
apply le_Sn_n with x.
simpl in H1.
rewrite H3 in H1...
rewrite <- List_map.
apply NoDup_map.
intros.
apply natBelow_unique.
rewrite <- (nb_val_eq_rec_r x0 (trans_plus_n_Sm x y)).
rewrite <- (nb_val_eq_rec_r y0 (trans_plus_n_Sm x y)).
rewrite H1...
apply (IHy (S x)).
Qed.
Proof with auto.
revert n.
pattern m, i.
apply natBelow_rect.
simpl.
intros.
(*Set Printing Coercions.*)
apply natBelow_unique.
rewrite val_Snb.
do 2 rewrite nb_val_eq_rec_r...
intros.
apply natBelow_unique.
simpl plus.
rewrite (val_Snb (nth (nats n (S (S (v + p)))) (mkNatBelow (S v) p))).
rewrite nth_nats.
cset (nth_nats (mkNatBelow (S v) p) (S n)).
simpl plus in H0.
rewrite H0.
simpl...
Qed. (* todo: hm, didn't need induction hypothesis *)
Proof with reflexivity.
induction n; intros.
rewrite (eq_nil v)...
rewrite (eq_cons v).
simpl.
rewrite IHn...
Qed.

Lemma nb_nats_plus x n y: nb_nats n (x + y) = app (nb_nats n x) (nb_nats (n + x) y).