(* $Id: listn.v,v 1.30 2000/11/10 11:27:35 freek Exp $ *)

(* Obsolete but maintained *)

Require Export finite.

Transparent sym_eq.
Transparent f_equal.

Implicit Arguments On.

Section Listn.
Variable A : Set.

Inductive listn : nat->Set :=
  niln: (listn O)
| consn: (a:A)(n:nat)(listn n)->(listn (S n)).


Section Special_listn_rec.
Variable C : (n:nat)(listn (S n))->Set.
Variable ih: (a:A)(n:nat; v:(listn n))(C (consn a v)).

Local tmp: (n:nat; v:(listn n))Set.
Induction n.
Intros. Exact unit.
Intros. Exact (C v).
Defined.

Definition listn_rec_S: (n:nat)(v:(listn (S n)))(C v).
Intros.
Cut (a:A; n:nat; l:(listn n))(tmp l)->(tmp (consn a l)).
Intros h. Exact (!listn_rec tmp tt h ? v).
Intros. Simpl. Apply ih.
Defined.
End Special_listn_rec.


Section Special_listn_ind.
Variable C : (n:nat)(listn (S n))->Prop.
Variable ih: (a:A)(n:nat; v:(listn n))(C (consn a v)).

Local tmp: (n:nat; v:(listn n))Prop.
Induction n.
Intros. Exact True.
Intros. Exact (C v).
Defined.

Lemma listn_ind_S: (n:nat)(v:(listn (S n)))(C v).
Intros.
Cut (a:A; n:nat; l:(listn n))(tmp l)->(tmp (consn a l)).
Intros h. Exact (!listn_ind tmp I h ? v).
Intros. Simpl. Apply ih.
Qed.
End Special_listn_ind.

Definition hdn: (n:nat; l:(listn (S n)))A.
Intros n l. Inversion l. Exact a.
Defined.

Definition tln: (n:nat; l:(listn (S n)))(listn n).
Intros n l. Inversion l. Exact H0.
Defined.

Definition appendn : (n,m:nat; l:(listn n); k:(listn m))(listn (plus n m)).
Induction n; Intros.
Exact k.
Exact (consn (hdn l) (H ? (tln l) k)).
Defined.

(*
Ax_iom listnO_inv: (l:(listn O)) l = niln.
*)
(*****************
Check (!listn_ind [n:nat](nat_rect [x:nat]((listn x)->Prop)
               ([x=O][v:(listn O)]v=niln)
               ([x:nat][_:(listn x)->Prop][_:(listn (S x))]True)
                n)).
Goal vnil_lemma : {n:nat}{v:vect n}(([n|nat]((nat_elim|([x:nat](vect x)->Prop)
           ([x=zero][v:vect zero](Eq v vnil))
           ([x:nat][_:((vect x)->Prop)][_:(vect (suc x))]trueProp)
           n):((vect n)->Prop))) v);
Refine vect_elim [n|nat]((nat_elim|([x:nat](vect x)->Prop)
           ([x=zero][v:vect zero](Eq v vnil))
           ([x:nat][_:((vect x)->Prop)][_:(vect (suc x))]trueProp)
           n):((vect n)->Prop));
Refine Eq_refl;
Intros;
Try Immed;
Save vnil_lemma;
***************)

Lemma listnS_inv: (n:nat; l:(listn (S n))) l = (consn (hdn l) (tln l)).
Intros n l. Elim l using listn_ind_S. Trivial.
Qed.

Definition nthn: (n:nat; l:(listn n); i:(fin n))A.
Intros; Cut (m:nat; j:(fin m); k:(listn m))A.
Intros h; Apply (h n i l).
Intros m j; Induction j; Intros.
Exact (hdn k).
Exact (Hrecj (tln k)).
Defined.

Lemma nthnFO_spec: (n:nat; l:(listn (S n))) (nthn l (FO n)) = (hdn l).
Intros; Rewrite (listnS_inv l); Trivial.
Qed.

Lemma nthnFS_spec:
   (n:nat; l:(listn (S n)); i:(fin n)) (nthn l (FS i)) = (nthn (tln l) i).
Intros; Rewrite (listnS_inv l); Trivial.
Qed.

(*
(* listn and = *)
Lemma listn_eq: (n:nat; l,k:(listn n))((i:(fin n))(nthn l i)=(nthn k i))->l=k.
Induction n; Intros.
(* niln *)
Rewrite (listnO_inv l); Rewrite (listnO_inv k); Trivial.
(* consn *)
Rewrite (listnS_inv l); Rewrite (listnS_inv k).
  Rewrite <- (nthnFO_spec l); Rewrite (H0 (FO n0)).
  Rewrite (H (tln l) (tln k)); Trivial.
Intro i; Rewrite <- (nthnFS_spec l i); Rewrite <- (nthnFS_spec k i).
  Apply (H0 (FS i)).
Qed.
*)


Fixpoint constListn [n:nat] : A->(listn n) :=
[a:A]<[m:nat](listn m)>Cases n
of O => niln
 | (S m) => (consn a (constListn m a))
end.

Lemma constListn_spec: (n:nat; i:(fin n); a:A)(nthn (constListn n a) i) = a.
Induction i; Trivial.
Qed.

Section StandardBases.
Variables z,o : A.

Definition unitListn: (n:nat; i:(fin n))(listn n).
Intros n i; Induction i; Intros.
(* FO *)
Exact (consn o (constListn n z)).
(* FS *)
Exact (consn z Hreci).
Defined.

Lemma unitListn_spec_diag:
   (n:nat; i:(fin n))(nthn (unitListn i) i) = o.
Induction i; Intros.
(* FO *)
Trivial.
(* FS *)
Auto.
Qed.

Lemma unitListn_spec_offDiag:
   (n:nat; i,j:(fin n)) ~(i = j) -> (nthn (unitListn j) i) = z.
Induction i; Intros.
(* FO *)
Simpl. Elim (finS_inv j); Intros.
Elim (H (sym_eq ??? H0)).
Elim H0; Intros. Rewrite H1. Trivial.
(* FS *)
Elim (finS_inv j); Intros.
Rewrite H1. Simpl. Apply constListn_spec.
Elim H1; Intros. Rewrite H2. Simpl. Apply H.
Red; Intro eqfx. Apply H0. Rewrite H2. Rewrite eqfx. Trivial.
Qed.

Lemma unitListn_inv:
   (n:nat; i,j:(fin n))
     (i=j /\ (nthn (unitListn j) i) = o) \/
     (~i=j /\ (nthn (unitListn j) i) = z).
Intros; Elim (fin_decidable i j); Intros.
Left; Split. Assumption. Rewrite H; Apply unitListn_spec_diag.
Right; Split. Assumption. Apply (unitListn_spec_offDiag H).
Qed.

End StandardBases.
End Listn.


Section Mapping.
Variables B, C, D : Set.
Variable g : B -> C.
Variable f : B -> C -> D.

Definition mapn: (n:nat; bs:(listn B n))(listn C n).
Intros n bs; Induction bs.
Exact (niln C).
Apply (consn (g a) Hrecbs).
Defined.

Definition map2n: (n:nat; bs:(listn B n); cs:(listn C n))(listn D n).
Intros n bs; Induction bs; Intros.
Apply (niln D).
Inversion cs. Exact (consn (f a a0) (Hrecbs H0)).
Defined.

Lemma mapn_spec:
  (n:nat; i:(fin n); bs:(listn B n))(nthn (mapn bs) i) = (g (nthn bs i)).
Induction i; Intros; Rewrite (listnS_inv bs).
(* base *)
Trivial.
(* step *)
Simpl. Apply H.
Qed.

Lemma map2n_spec:
  (n:nat; i:(fin n); bs:(listn B n); cs:(listn C n))
     (nthn (map2n bs cs) i) = (f (nthn bs i) (nthn cs i)).
Induction i; Intros; Rewrite (listnS_inv bs); Rewrite (listnS_inv cs).
(* base *)
Trivial.
(* step *)
Simpl. Apply H.
Qed.

End Mapping.

Lemma mapn_compose: (B,C,D:Set; f:B->C; g:C->D; n:nat; l:(listn B n))
       (mapn g (mapn f l)) = (mapn [b:B](g (f b)) l).
Induction l.
Trivial.
Intros; Simpl. Rewrite H; Trivial.
Qed.

(** enumerating a finite set is useful in programming **)
Fixpoint fin_as_listn [n:nat] : (listn (fin n) n) :=
  <[m:nat](listn (fin m) m)>Cases n
  of O     => (niln (fin O))
   | (S m) => (consn (FO m) (mapn (!FS m) (fin_as_listn m)))
  end.
Fixpoint fin_as_listn_rev [n:nat] : (listn (fin n) n) :=
  <[m:nat](listn (fin m) m)>Cases n
  of O     => (niln (fin O))
   | (S m) => (consn (nat_fin m) (mapn (!fin_inj m) (fin_as_listn_rev m)))
  end.

Lemma fal_spec: (n:nat; i:(fin n))(nthn (fin_as_listn n) i)=i.
Induction i.
(* F0 *)
Trivial.
(* FS *)
Intros; Simpl.
Rewrite (mapn_spec (FS 1!n0) f (fin_as_listn n0)); Rewrite H; Trivial.
Qed.


(* an inverse to "nthn" *)
Section nhtn_sec.
Variable A:Set.

Lemma fal_spec_inv: (n:nat; l:(listn A n)) (mapn (nthn l) (fin_as_listn n)) = l.
Induction l.
(* niln *)
Trivial.
(* consn *)
Intros; Simpl.
Rewrite (mapn_compose (FS 1!n0) (nthn (consn a l0)) (fin_as_listn n0)).
Change (consn a (mapn (nthn l0) (fin_as_listn n0))) = (consn a l0).
Rewrite H; Trivial.
Qed.

Definition nhtn [n:nat; g:(vec A n)]: (listn A n) := (mapn g (fin_as_listn n)).

Lemma nthn_nhtn: (n:nat; g:(vec A n); i:(fin n)) (nthn (nhtn g) i) = (g i).
Intros; Cut (nn:nat; ii:(fin nn); gg:(vec A nn)) (nthn (nhtn gg) ii) = (gg ii).
Intros h; Apply (h n i g).
Induction ii; Intros.
Trivial.
Unfold nhtn.
  Rewrite (mapn_spec gg (FS f) (fin_as_listn (S n0))).
  Rewrite (fal_spec (FS f)); Trivial.
Qed.

Lemma nhtn_nthn: (n:nat; l:(listn A n)) (nhtn (nthn l)) = l.
Unfold nhtn; Simpl; Intros; Apply fal_spec_inv.
Qed.

End nhtn_sec.


Section Folding.
Variables B, C : Set.
Variable g : B -> C -> C.
Variable c : C.

Fixpoint foldrn [n:nat; bs:(listn B n)] : C :=
  Cases bs of niln => c
            | (consn b _ tl) => (g b (foldrn tl))
  end.

Lemma foldrn_spec_nil: (foldrn (niln B))=c.
Trivial.
Qed.

Lemma foldrn_spec_cons:
   (b:B)(n:nat; bs:(listn B n))(foldrn (consn b bs))=(g b (foldrn bs)).
Trivial.
Qed.

End Folding.


(* componentwise operations *)
Section ComponentwiseOperations.
Variable A,B,C : Set.
Variable fx1 : A -> B.
Variable fx2 : A -> B -> C.

Local As := (listn A).
Local Bs := (listn B).
Local Cs := (listn C).

Definition fx1n: (n:nat)(As n)->(Bs n) := (mapn fx1).
Definition fx2n: (n:nat)(As n)->(Bs n)->(Cs n) := (map2n fx2).

End ComponentwiseOperations.


Definition zipn [B,C:Set]: (n:nat; bs:(listn B n); cs:(listn C n))(listn B*C n) :=
  (map2n (pair B C)).

Section finFolding.
Variables A,B,C : Set.
Variable h : B -> C -> C.
Variable c : C.
Variable n : nat.
Variable v : (vec B n).

Definition foldrf: C := (foldrn h c (mapn v (fin_as_listn n))).

End finFolding.

Implicit Arguments Off.


