Section Lists_field.
Variable A : Set.
Fixpoint trunc (v : list A) : nat -> list A :=
fun n : nat =>
match v return (list A) with
| nil => nil
| b :: w =>
match n return (list A) with
| O => nil
| S p => b :: trunc w p
end
end.
Definition strip (v : list A) (n : nat) :=
rev A (trunc (rev A v) (length v - n)).
(* Selection d'une sous liste commencant a la position start, de longueur lengt *)
Definition sublist (v : list A) (start lengt : nat) :=
trunc (strip v start) lengt.
(* Selection de la liste contenant le i-eme element d'une liste *)
Definition elemlist (v : list A) (i : nat) := trunc (strip v i) 1.
(****************************************************************)
(* lemmes sur trunc *)
(*****************)
simple induction v. simpl in |- *. auto with arith.
intros b b0 H. simple induction i. simpl in |- *. trivial with arith.
simpl in |- *. intros. apply eq_S. apply H. apply le_S_n. exact H1.
Qed.
(**************)
simpl in |- *. trivial with arith.
Qed.
(**************)
simple induction v. simpl in |- *. trivial with arith.
intros. rewrite length_eq2. simpl in |- *. rewrite H. trivial with arith.
Qed. Hint Resolve trunc_all.
(**************)
simple induction v. simpl in |- *. trivial with arith.
intros. inversion H0. rewrite trunc_all. trivial with arith.
simpl in |- *. rewrite H. trivial with arith.
apply le_Sn_le. generalize H1. simpl in |- *. trivial with arith.
Qed.
(************)
simple induction v; auto with arith.
Qed. Hint Resolve trunc_O.
(********************)
simple induction v. simpl in |- *. auto with arith.
intros. case i. rewrite trunc_O. auto with arith.
intro. simpl in |- *. apply le_n_S. apply H.
Qed. Hint Resolve le_length_trunc.
(**************)
simple induction v1. simpl in |- *. auto with arith.
intros. rewrite app_eq2.
rewrite length_eq2. elim i. simpl in |- *. rewrite trunc_O. trivial with arith.
intros. simpl in |- *. rewrite H. trivial with arith.
Qed. Hint Resolve trunc_app.
(****************)
intros. rewrite trunc_app. rewrite (trunc_max v1 (length v1 + i)).
replace (length v1 + i - length v1) with i. trivial with arith. auto with arith.
auto with arith.
Qed.
(*************)
intros. rewrite H. trivial with arith.
Qed. Hint Resolve trunc_eq.
(**************)
simple induction v. simpl in |- *. trivial with arith.
simple induction i; simple induction j. trivial with arith.
repeat rewrite trunc_O. simpl in |- *. trivial with arith.
repeat rewrite trunc_O. simpl in |- *. trivial with arith.
intros. simpl in |- *. rewrite H. trivial with arith.
Qed.
(*****************)
simple induction v. simpl in |- *. trivial with arith.
simple induction i. repeat rewrite trunc_O. trivial with arith.
intros. simpl in |- *. rewrite H. trivial with arith.
Qed. Hint Resolve trunc_trunc1.
(*****************)
intros. rewrite (trunc_max (trunc v i) j). trivial with arith.
apply le_trans with i. apply le_length_trunc. exact H.
Qed.
(*****************)
intros. rewrite <- (trunc_max (trunc v j) i). rewrite trunc_sym. trivial with arith.
apply le_trans with j. apply le_length_trunc.
exact H.
Qed.
(*********************)
intros. rewrite <- H0. rewrite trunc_trunc3. trivial with arith. exact H.
Qed.
(****************************************************************)
(* lemmes sur strip *)
(**************)
intro. auto with arith.
Qed. Hint Resolve strip_nil.
(*****************)
unfold strip in |- *. simple induction i. simpl in |- *.
elim minus_n_O. intro. replace (length v) with (length (rev A v)).
rewrite trunc_all. rewrite trunc_app. rewrite trunc_all.
elim minus_n_n. rewrite trunc_O. rewrite app_v_nil. trivial with arith.
apply length_rev.
intros. apply rev_eq. simpl in |- *.
rewrite trunc_app. rewrite length_rev. rewrite minus_minus_lem1.
rewrite trunc_O. rewrite app_v_nil. trivial with arith.
Qed. Hint Resolve strip_cons_S.
(*****************)
unfold strip in |- *. intros. rewrite length_rev. rewrite length_trunc. trivial with arith.
rewrite length_rev. apply minus_le_lem2.
Qed.
(********************)
unfold strip in |- *. intros. rewrite length_rev. apply le_length_trunc.
Qed.
(***************)
unfold strip in |- *. trivial with arith.
Qed.
(**************)
unfold strip in |- *. intro. rewrite <- minus_n_n. rewrite trunc_O. auto with arith.
Qed. Hint Resolve strip_all.
(**************)
unfold strip in |- *. intros. rewrite <- rev_eq1.
apply rev_eq. rewrite <- length_rev. rewrite minus_le_O. auto with arith.
rewrite length_rev. exact H.
Qed.
(************)
intro. unfold strip in |- *. rewrite <- minus_n_O. rewrite <- length_rev.
rewrite trunc_all. rewrite rev_rev. trivial with arith.
Qed. Hint Resolve strip_O.
(**************)
simple induction v1. simpl in |- *. intros. elim minus_n_O. trivial with arith.
simple induction v2. intro. simpl in |- *.
rewrite strip_nil. rewrite app_v_nil. rewrite app_v_nil. trivial with arith.
simple induction i.
rewrite strip_O. simpl in |- *. rewrite strip_O. rewrite strip_O. auto with arith.
intros. rewrite app_eq2. rewrite strip_cons_S.
rewrite strip_cons_S. rewrite length_eq2. simpl in |- *. apply H.
Qed.
(******************)
simple induction v. intros. rewrite strip_nil. rewrite strip_nil. trivial with arith.
simple induction i. intros. rewrite strip_O.
do 2 rewrite strip_cons_S. rewrite strip_O. trivial with arith.
simple induction j. rewrite strip_O.
repeat rewrite strip_cons_S. elim n. rewrite strip_O. trivial with arith.
intros. rewrite <- H. rewrite strip_O. trivial with arith.
intros. do 2 rewrite strip_cons_S. apply H.
Qed.
(**************)
simple induction v. intros. rewrite strip_nil. rewrite strip_nil. trivial with arith.
simple induction i. intro. rewrite strip_O. rewrite strip_O. trivial with arith.
simple induction j. rewrite strip_O. rewrite strip_O. try trivial with arith.
intros. rewrite strip_cons_S. rewrite strip_cons_S.
replace (strip (strip l n) (S n0)) with (strip (strip l (S n)) n0).
apply H. apply strip_strip_S.
Qed.

Lemma strip_eq :
forall (v1 v2 : list A) (i : nat), v1 = v2 -> strip v1 i = strip v2 i.