Require Import Arith.
Require Import Relations.
Require Import List.
Require Import Orders.
Require Import Wellfounded.

Set Implicit Arguments.

Section ListType.

Variable T:Type.

Inductive Swap: relation (list T) :=
|Swap_here: forall a b l, Swap (a::b::l) (b::a::l)
|Swap_there: forall a l m, Swap l m -> Swap (a::l) (a::m)
.
Inductive Perm: relation (list T) :=
|Perm_nil: Perm nil nil
|Perm_Add: forall a l la m ma, Perm l m -> Add a l la -> Add a m ma -> Perm la ma
.
Hint Constructors Swap Perm Add.
Hint Resolve in_eq in_cons.
Definition Perm' := clos_refl_trans (list T) Swap.

Theorem Swap_sym : forall l m, Swap l m -> Swap m l. Proof. intros. induction H; auto. Qed.
Theorem Perm'_sym : forall l m, Perm' l m -> Perm' m l. Proof. intros. induction H. apply rt_step; apply Swap_sym; auto. apply rt_refl. apply rt_trans with y; auto. Qed.
Theorem Perm'_refl : forall l, Perm' l l. Proof. intros. apply rt_refl; auto. Qed.
Theorem Perm'_trans : forall l m n, Perm' l m -> Perm' m n -> Perm' l n. Proof. intros. apply rt_trans with m; auto. Qed.
Theorem Swap_Perm' : forall l m, Swap l m -> Perm' l m. Proof. intros. apply rt_step; auto. Qed.
Hint Resolve Swap_sym Perm'_sym Perm'_refl Perm'_trans Swap_Perm'.
Theorem Perm'_cons: forall a l m, Perm' l m -> Perm' (a::l) (a::m). Proof. intros. induction H; eauto. Qed.
Theorem Perm'_cons_Add: forall a l la, Add a l la -> Perm' (a::l) la. Proof. intros. induction H; auto. apply Perm'_trans with (x::a::l); auto. apply Perm'_cons; auto. Qed.
Hint Resolve Perm'_cons Perm'_cons_Add.

Theorem Perm__Perm' : forall l m, Perm l m -> Perm' l m. Proof. intros. induction H; auto. apply Perm'_trans with (a::l); auto. apply Perm'_trans with (a::m); auto. Qed.
Theorem Perm_length : forall l m, Perm l m -> length l = length m. Proof. intros. induction H; auto. apply Add_length in H0. apply Add_length in H1. rewrite H0. rewrite H1. auto. Qed.
Theorem Perm_In : forall l m a, Perm l m -> In a l -> In a m. Proof. intros. induction H; auto. apply Add_in with (x:=a) in H1. apply Add_in with (x:=a) in H2. apply H2. apply H1 in H0. destruct H0; [left|right]; auto. Qed.
Theorem Perm_refl : forall l, Perm l l. Proof. induction l; auto. apply Perm_Add with a l l; auto. Qed.
Theorem Perm_sym : forall l m, Perm l m -> Perm m l. Proof. intros. induction H; auto. apply Perm_Add with a m l; auto. Qed.
Theorem Perm_cons: forall a l m, Perm l m -> Perm (a::l) (a::m). Proof. intros. eapply Perm_Add; eauto. Qed.
Hint Resolve Perm_In Perm_length Perm__Perm' Perm_refl Perm_sym Perm_cons.
Theorem Add_insert : forall (a:T) l m, Add a (l++m) (l++a::m). Proof. induction l; simpl; intros; auto. Qed.
Theorem Add_dual : forall l (a:T) la, Add a la l -> forall b lb, Add b lb l -> a=b /\ la=lb \/ exists lc, Add a lc lb /\ Add b lc la. Proof. intros l a la H. induction H; intros. inversion H; [left|right]; auto. exists l0; auto.
  inversion H0. right. subst l0 x l'. exists l; auto. subst lb x0 l'0. destruct (IHAdd b l0 H3) as [[H4 H5]|[lc [H4 H5]]]. left; subst b l0; auto. right; exists (x::lc); auto. Qed.
Theorem Perm_Add_inv : forall a l la m ma, Add a l la -> Add a m ma -> Perm la ma -> Perm l m. Proof. intros a l la. revert l. apply (Fix (well_founded_ltof (list T) (length (A:=T)))) with (P:=fun la=>forall l m ma,Add a l la->Add a m ma->Perm la ma->Perm l m). clear la. intros la IH. intros. inversion H1 as [|b lb lb' mb mb']. subst la ma; inversion H0. subst lb' mb'.
  destruct (Add_dual H H3) as [[H5 H6]|[lc [H5 H6]]]; destruct (Add_dual H0 H4) as [[H7 H8]|[mc [H7 H8]]]. subst b lb mb; auto. subst b lb. destruct (Add_inv a l) as [lc H9]. apply Perm_In with mb; auto. apply Add_in with (x:=a) in H7; apply H7; left; auto. apply Perm_Add with a lc mc; auto. apply IH with l mb; auto. unfold ltof. apply Add_length in H3. rewrite H3; auto.
  subst b mb. destruct (Add_inv a m) as [mc H7]. apply Perm_In with lb; auto. apply Add_in with (x:=a) in H5; apply H5; left; auto. apply Perm_Add with a lc mc; auto. apply IH with lb m; auto. unfold ltof. apply Add_length in H3. rewrite H3; auto. apply Perm_Add with b lc mc; auto. apply IH with lb mb; auto. unfold ltof. apply Add_length in H3. rewrite H3; auto. Qed.
Theorem Perm_trans : forall l m n, Perm l m -> Perm m n -> Perm l n. Proof. intros l m n H. revert n. induction H; intros. inversion H; auto. destruct (Add_inv a n) as [n' H3]. apply Perm_In with ma; auto. apply Add_in with (x:=a) in H1; apply H1; left; auto. apply Perm_Add with a l n'; auto. apply IHPerm. apply Perm_Add_inv with a ma n; auto. Qed.
Theorem Perm'__Perm : forall l m, Perm' l m -> Perm l m. Proof. intros. induction H; auto. induction H; auto. apply Perm_Add with a (b::l) (b::l); auto. apply Perm_trans with y; auto. Qed.
Hint Resolve Add_dual Perm_Add_inv Perm_trans Perm'__Perm.

Theorem Perm_rev: forall l, Perm l (rev l). Proof. induction l; simpl; auto. apply Perm_Add with a l (rev l); auto. generalize (rev l) as m. induction m; simpl; auto. Qed.
Theorem Perm_nil_eq: forall l, Perm nil l -> l=nil. Proof. intros. destruct l; auto. apply Perm_length in H. inversion H. Qed.
Theorem Perm_one: forall (a:T) l, Perm (a::nil) l -> l=a::nil. Proof. intros. inversion H. inversion H1. subst l0 a0 l1 ma la. inversion H0. subst m. inversion H2; auto. inversion H4. inversion H7. Qed.
Theorem app_Add: forall (a:T) l la m, Add a l la -> Add a (l++m) (la++m). Proof. intros. induction H; simpl; auto. Qed.
Theorem Perm_app_swap: forall l m, Perm (l++m) (m++l). Proof. induction l; simpl; intros. rewrite app_nil_r; auto. apply Perm_Add with a (l++m) (m++l); auto. induction m; simpl; auto. Qed.
Theorem Perm_app: forall l1 m1 l2 m2, Perm l1 m1 -> Perm l2 m2 -> Perm (l1++l2) (m1++m2). Proof. intros. induction H; simpl; auto. apply Perm_Add with a (l++l2) (m++m2); auto; apply app_Add; auto. Qed.
Theorem Perm_app_rev: forall l1 m1 l2 m2, Perm l1 m1 -> Perm (l1++l2) (m1++m2) -> Perm l2 m2. Proof. intros. induction H; simpl in H0; auto. apply IHPerm. apply Perm_Add_inv with a (la++l2) (ma++m2); auto; apply app_Add; auto. Qed.
Theorem NoDup_incl_length: forall  (l m:list T), NoDup l -> incl l m ->length l<=length m. Proof. induction l; simpl; intros. apply le_O_n. inversion H. subst x l0. destruct (Add_inv a m) as [m' H5]. apply H0; auto. rewrite Add_length with T a m' m; auto. apply le_n_S. apply IHl; auto. intros x Hx. apply Add_in with (x:=x) in H5. cut (In x m); intros. apply H5 in H1. destruct H1; auto. subst x; contradiction. apply H0; auto. Qed.
Theorem NoDup_incl_Perm : forall l m, incl l m -> NoDup l -> length m <= length l -> Perm l m. Proof. induction l; intros. destruct m; auto. contradict H1. apply lt_not_le. simpl. apply le_n_S. apply le_O_n. destruct (Add_inv a m) as [m' H2]. apply H. left; auto. apply Perm_Add with a l m'; auto. apply IHl; auto. intros y H3. apply Add_in with (x:=y) in H2. cut (In y m); intros. apply H2 in H4. destruct H4; auto. subst y. inversion H0; contradiction. apply H. right; auto. inversion H0; auto. apply Add_length in H2. rewrite H2 in H1. apply le_S_n; auto. Qed.
Theorem NoDup_incl_each_Perm: forall l m, NoDup l -> NoDup m -> incl l m -> incl m l -> Perm l m. Proof. induction l;intros; auto. destruct m; auto. absurd (In t nil); auto. inversion H. subst x l0. destruct (Add_inv a m) as [m' H3]; auto. apply (NoDup_Add H3) in H0. destruct H0. apply Perm_Add with a l m'; auto. apply IHl; auto. intros x Hx. apply Add_in with (x:=x) in H3. cut (In x m); intros. apply H3 in H7. destruct H7; auto. subst x; contradiction. auto. intros x Hx. cut (In x (a::l)); intros. destruct H7; auto. subst x; contradiction. apply H2. apply Add_in with (x:=x) in H3; auto. apply H3; auto. Qed.
Theorem NoDup_repeat: forall (a:T) n, NoDup (repeat a n) <-> n<=1. Proof. intros; split; intros. destruct n; auto. destruct n; auto. simpl in H. inversion H. contradict H2; auto. inversion H; simpl. apply NoDup_cons; auto. apply NoDup_nil. inversion H1. simpl. apply NoDup_nil. Qed.
Theorem NoDup_Perm: forall  (l m:list T), Perm l m -> NoDup l -> NoDup m. Proof. intros. induction H; auto. apply NoDup_Add in H1. apply H1 in H0. destruct H0. apply NoDup_Add in H2. apply H2. split; auto. contradict H3. apply Perm_In with m; auto. Qed.
Theorem NoDup_app_rev: forall (l m:list T), NoDup (l++m) -> NoDup m. Proof. induction l; simpl; intros; auto. inversion H; auto. Qed.

Theorem partition_Perm: forall f l, let (la,lb) := partition f l in Perm l (la++lb). Proof. induction l; simpl; intros; auto. destruct (f a); destruct (partition f l); simpl. apply Perm_Add with a l (l0++l1); auto. apply Perm_Add with a l (l0++l1); auto. clear IHl. induction l0; simpl; auto. Qed.
Theorem filter_app_Perm: forall f l, Perm l (filter f l++filter (fun x=>negb (f x)) l). Proof. induction l; simpl; auto. destruct (f a); simpl; eapply Perm_Add with (a:=a); eauto. generalize (filter f l) as m. induction m; simpl; auto. Qed.
Theorem fold_right_Perm: forall (o:T->T->T) a l m, (forall x y z, o (o x y) z = o x (o y z)) -> (forall x y, o x y = o y x) -> Perm l m -> fold_right o a l = fold_right o a m. Proof. intros. induction H1; simpl; auto. assert (Ha:forall l la, Add a0 l la -> fold_right o a la = o a0 (fold_right o a l)). clear -H H0. intros. induction H1; simpl; auto. rewrite IHAdd. rewrite <- H. rewrite <- H. f_equal; auto. rewrite Ha with l la; auto. rewrite Ha with m ma; auto. f_equal; auto. Qed.
Theorem filter_Add1: forall (a:T) l la f, f a=true -> Add a l la -> Add a (filter f l) (filter f la). Proof. intros. induction H0; simpl. rewrite H; auto. destruct (f x); auto. Qed.
Theorem filter_Add2: forall (a:T) l la f, f a=false -> Add a l la -> filter f l = filter f la. Proof. intros. induction H0; simpl. rewrite H; auto. destruct (f x); auto; f_equal; auto. Qed.
Theorem filter_Perm: forall l m, Perm l m -> forall f, Perm (filter f l) (filter f m). Proof. intros. induction H; simpl; auto. remember (f a) as b. destruct b. apply Perm_Add with a (filter f l) (filter f m); auto; apply filter_Add1; auto. rewrite <- filter_Add2 with (a:=a) (l:=l) (la:=la); auto. rewrite <- filter_Add2 with (a:=a) (l:=m) (la:=ma); auto. Qed.
Theorem filter_Forall: forall f (l:list T), (forall x, In x l->f x=true) -> filter f l = l. Proof. induction l; simpl; intros; auto. remember (f a) as b. destruct b; auto. f_equal; auto. absurd (false = true); auto. rewrite Heqb. auto. Qed.
Theorem filter_None: forall f (l:list T), (forall x, In x l -> f x=false) -> filter f l = nil. Proof. induction l; simpl; intros; auto. remember (f a) as b. destruct b; auto. absurd (true=false); auto. discriminate. rewrite Heqb. auto. Qed.
Theorem filter_ord: forall f g (l:list T), filter f (filter g l) = filter g (filter f l). Proof. induction l; simpl; auto. remember (f a) as b. remember (g a) as c. destruct b; destruct c; simpl; auto. rewrite <- Heqb. rewrite <- Heqc. f_equal; auto. rewrite <- Heqc; auto. rewrite <- Heqb; auto. Qed.
Theorem filter_and: forall f g (l:list T), filter (fun x=>andb (f x) (g x)) l = filter f (filter g l). Proof. induction l; simpl; auto. remember (f a) as b. remember (g a) as c. destruct b; destruct c; simpl; auto. rewrite <- Heqb; auto. f_equal; auto. rewrite <- Heqb; auto. Qed.
Theorem filter_app: forall f (l m:list T), filter f (l++m) = filter f l++filter f m. Proof. induction l; intros; simpl; auto. destruct (f a); simpl; auto. f_equal; auto. Qed.
Theorem filter_NoDup: forall f (l:list T), NoDup l -> NoDup (filter f l). Proof. induction l; simpl; intros; auto. inversion H. destruct (f a); auto. apply NoDup_cons; auto. contradict H2. apply filter_In in H2. destruct H2; auto. Qed.
Theorem filter_equiv: forall (f g:T->bool) l, (forall x, In x l ->f x=g x) -> filter f l = filter g l. Proof. induction l; simpl; intros; auto. remember (f a) as b. remember (g a) as c. destruct b; destruct c; auto. f_equal; auto. absurd (true=false); auto. discriminate. rewrite Heqb. rewrite Heqc. apply H; auto. absurd (false=true). discriminate. rewrite Heqb. rewrite Heqc; auto. Qed.
Definition dec2b {P:T->Prop} (P_dec:forall x,{P x}+{~P x}): T->bool := fun x=>if P_dec x then true else false.
Theorem dec2b_true: forall P P_dec x, dec2b (P:=P) P_dec x = true <-> P x. Proof. intros. unfold dec2b. destruct (P_dec x). split; auto. split; intros. inversion H. contradiction. Qed.
Theorem dec2b_false: forall P P_dec x, dec2b (P:=P) P_dec x = false <-> ~P x. Proof. intros. unfold dec2b. destruct (P_dec x). split; intros. inversion H. contradiction. split; intros; auto. Qed.

Definition Forall_dec: forall (P:T->Prop) l (P_dec:forall x, In x l->{P x}+{~P x}), {x|In x l & ~P x}+{Forall P l}. induction l; intros. right; auto. destruct IHl as  [[x H]|H]. intros. apply P_dec; auto. left; exists x; auto. destruct (P_dec a); auto. left; exists a; auto. Defined.
Theorem Forall_imp: forall (P Q:T->Prop) l, (forall x, In x l->P x->Q x) -> Forall P l -> Forall Q l. Proof. induction l; intros; auto. inversion H0. apply Forall_cons; auto. Qed.
Theorem Forall_incl: forall (P:T->Prop) l m, incl l m -> Forall P m -> Forall P l. Proof. intros. apply Forall_forall. intros. apply Forall_forall with (x:=x) in H0; auto. Qed.
Definition Exists_dec: forall (P:T->Prop) l (P_dec:forall x, In x l->{P x}+{~P x}), {Exists P l}+{~Exists P l}. induction l; intros. right; intros C. inversion C. destruct (P_dec a); auto. destruct IHl; auto. right. intros C. inversion C; contradiction. Defined.
Definition findP : forall (P:T->Prop) (l:list T) (P_dec:forall x, In x l->{P x}+{~P x}), {x|In x l & P x}+{forall x, In x l ->~P x}. induction l; intros. right. intros. destruct H. destruct (P_dec a); auto. left; auto. exists a; auto. destruct IHl as [[x H]|H]; [|left; exists x|right]; auto. intros. destruct H0; auto. subst a; auto. Defined.
Definition findP_nth: forall (P:T->Prop) l (P_dec:forall x, In x l ->{P x}+{~P x}), {n:nat & {x:T|nth_error l n = Some x & P x}}+{forall x, In x l -> ~P x}. induction l; intros. right. intros. destruct H. destruct (P_dec a). left; auto. left; exists 0; exists a; auto. destruct IHl as [[m [x H1 H2]]|H1]. intros. apply P_dec; right; auto. left; exists (S m); exists x; auto. right. intros. destruct H; auto. subst x; auto. Defined.

Theorem Rpair_list: forall (R:relation T) l, NoDup l -> (forall x, In x l->~R x x) -> (forall x, In x l->exists y, R x y/\In y l/\forall z,In z l->R x z->z=y) -> (forall x y, In x l->In y l->R x y->R y x) -> exists m, Perm l (map fst m++map snd m) /\ Forall (fun p=>R (fst p) (snd p)) m. Proof. intros R l. apply (Fix (well_founded_ltof (list T) (length (A:=T)))) with (P:=fun l=>NoDup l ->(forall x, In x l -> ~ R x x) ->(forall x, In x l -> exists y : T, R x y /\ In y l/\forall z,In z l->R x z->z=y) ->(forall x y, In x l -> In y l -> R x y -> R y x) -> exists m, Perm l (map fst m ++ map snd m) /\ Forall (fun p : T * T => R (fst p) (snd p)) m). clear l. intros l IH. intros. destruct l as [|a l]. exists nil; simpl; auto. destruct (H1 a) as [b [H4 [H5 H6]]]; auto. destruct H5. subst b; absurd (R a a); auto. destruct (Add_inv b l H3) as [l' H5]. inversion H. subst x l0.
  destruct (IH l') as [m [H11 H12]]; intros; auto. unfold ltof. apply Add_length in H5. simpl. rewrite H5; auto. apply NoDup_Add in H5. apply H5 in H10. destruct H10; auto. apply H0. right. apply Add_in with (x:=x) in H5. apply H5; auto. assert (In x l). apply (Add_in) with (x:=x) in H5. apply H5; auto.  destruct (H1 x) as [y [H11 [H12 H13]]]; auto. exists y; split; [|split]; auto. destruct H12. subst y. absurd (In b l'). apply NoDup_Add in H5. apply H5 in H10. destruct H10; auto. replace b with x; auto. apply Add_in with (x:=y) in H5. apply H5 in H12. destruct H12; auto. subst y. contradict H9. replace a with x; auto. destruct (H1 b) as [z [Ha [Hb Hc]]]; auto. rewrite Hc; auto. intros; apply H13; auto. right. apply Add_in with (x:=z) in H5. apply H5; auto. apply H2; auto; right. apply Add_in with (x:=x) in H5. apply H5; auto. apply Add_in with (x:=y) in H5. apply H5; auto.
  exists ((a,b)::m). split; auto. apply Perm_Add with a l (map fst m++b::map snd m); simpl; auto. apply Perm_Add with b l' (map fst m++map snd m); auto. generalize (map fst m) as n. induction n; simpl; auto. Qed.

Variable T_eq_dec: forall x y:T, {x=y}+{x<>y}.

Definition add_inv: forall (a:T) l, {m|Add a m l}+{~In a l}. induction l. right; auto. destruct (T_eq_dec a0 a). left. subst a0. exists l; auto. destruct IHl as [[m H]|H]. left. exists (a0::m); auto. right. intros C. destruct C; contradiction. Defined.
Definition Perm_dec: forall l m, {Perm l m}+{~Perm l m}. induction l; intros. destruct m; [left|right]; auto. intros C. absurd (In t nil); auto. apply Perm_In with (t::m); auto. destruct (add_inv a m) as [[m' H]|H]. destruct (IHl m') as [H1|H1]; [left|right]; auto. apply Perm_Add with a l m'; auto. contradict H1. apply Perm_Add_inv with a (a::l) m; auto. right; contradict H. apply Perm_In with (a::l); auto; left; auto. Defined.

Theorem count_occ_Add_eq: forall (a:T) l la, Add a l la -> count_occ T_eq_dec la a = S(count_occ T_eq_dec l a). Proof. intros. induction H; simpl. destruct (T_eq_dec a a); auto. contradict n; auto. destruct (T_eq_dec x a); auto. Qed.
Theorem count_occ_Add_neq: forall a b l la, Add a l la -> b<>a -> count_occ T_eq_dec la b = count_occ T_eq_dec l b. Proof. intros. induction H; simpl. destruct (T_eq_dec a b); auto. contradict H0; auto. destruct (T_eq_dec x b); auto. Qed.
Theorem Perm__count_occ: forall l m, Perm l m -> forall x:T, count_occ T_eq_dec l x= count_occ T_eq_dec m x. Proof. intros. induction H; simpl; auto. destruct (T_eq_dec x a). subst x. rewrite count_occ_Add_eq with a l la; auto. rewrite count_occ_Add_eq with a m ma; auto. rewrite count_occ_Add_neq with a x l la; auto. rewrite count_occ_Add_neq with a x m ma; auto. Qed.
Theorem count_occ__Perm: forall l m, (forall x, count_occ T_eq_dec l x=count_occ T_eq_dec m x) -> Perm l m. Proof. induction l; intros. destruct m; auto. absurd (count_occ T_eq_dec (t::m) t = 0). simpl. destruct (T_eq_dec t t). discriminate. contradict n; auto. rewrite <- H. auto. destruct (add_inv a m) as [[m' H1]|H1]. apply Perm_Add with a l m'; auto. apply IHl. intros. destruct (T_eq_dec x a). subst x. cut (S(count_occ T_eq_dec l a)=S(count_occ T_eq_dec m' a)). intros. inversion H0; auto.
  rewrite <- count_occ_Add_eq with a m' m; auto. rewrite <- H. symmetry. apply count_occ_Add_eq; auto. rewrite <- count_occ_Add_neq with a x m' m; auto. rewrite <- count_occ_Add_neq with a x l (a::l); auto. contradict H1. destruct count_occ_In with (eq_dec:=T_eq_dec) (x:=a) (l:=m). apply H1. rewrite <- H. simpl. destruct (T_eq_dec a a); auto. apply le_n_S. apply le_O_n. contradict n; auto. Qed.
Theorem nodup_Add1: forall a l la, Add a l la -> ~In a l -> Add a (nodup T_eq_dec l) (nodup T_eq_dec la). Proof. intros. induction H; simpl. destruct (in_dec T_eq_dec a l); auto; contradiction. destruct (in_dec T_eq_dec x l); destruct (in_dec T_eq_dec x l'); auto. contradict n. apply Add_in with (x:=x) in H; apply H; auto. apply Add_in with (x:=x) in H. apply H in i. destruct i. subst x; contradict H0; auto. contradiction. apply Add_cons. apply IHAdd. contradict H0; auto. Qed.
Theorem nodup_Add2: forall a l la, Add a l la -> In a l -> Perm (nodup T_eq_dec l) (nodup T_eq_dec la). Proof. intros. induction H. simpl. destruct (in_dec T_eq_dec a l); auto; contradiction. simpl. destruct (in_dec T_eq_dec x l); destruct (in_dec T_eq_dec x l'). destruct H0; auto. subst x; auto. contradict n. apply Add_in with (x:=x) in H. apply H; auto. apply Perm_Add with x (nodup T_eq_dec l) (nodup T_eq_dec l); auto. apply nodup_Add1; auto. destruct H0. subst a; auto. apply Add_in with (x:=x) in H. apply H in i. destruct i; [subst x|]; contradiction.
  destruct H0. subst x. contradict n0. apply Add_in with (x:=a) in H. apply H; auto. apply Perm_Add with x (nodup T_eq_dec l) (nodup T_eq_dec l'); auto. Qed.
Theorem nodup_Perm: forall l m, Perm l m -> Perm (nodup T_eq_dec l) (nodup T_eq_dec m). Proof. intros. induction H; simpl; auto. destruct (in_dec T_eq_dec a l) as [H2|H2]. apply Perm_trans with (nodup T_eq_dec m). apply Perm_trans with (nodup T_eq_dec l); auto. apply Perm_sym. apply nodup_Add2 with a; auto. apply nodup_Add2 with a; auto. apply Perm_In with l; auto. apply Perm_Add with a (nodup T_eq_dec l) (nodup T_eq_dec m); auto; apply nodup_Add1; auto. contradict H2. apply Perm_In with m; auto. Qed.
Theorem nodup_incl_min: forall l m, incl l m -> length (nodup T_eq_dec l) <= length m. Proof. induction l; simpl; intros; auto. apply le_O_n. destruct (in_dec T_eq_dec a l). apply IHl. intros y H0. apply H; auto. destruct (add_inv a m) as [[m' H1]|H1]. rewrite Add_length with T a m' m; auto.  simpl. apply le_n_S. apply IHl. intros y Hy. apply Add_in with (x:=y) in H1. cut (In y m). intros. apply H1 in H0. destruct H0; auto. subst y; contradiction. apply H. auto. contradict H1. apply H; auto. Qed.

Theorem remove_length: forall l a, length (remove T_eq_dec a l)<=length l. Proof. induction l; simpl; intros; auto. destruct (T_eq_dec a0 a); auto. simpl. apply le_n_S; auto. Qed.
Theorem remove_length2: forall l (a:T), In a l -> length (remove T_eq_dec a l)<length l. Proof. intros l a. induction l; simpl; intros. destruct H. destruct H. subst a0. destruct (T_eq_dec a a). apply le_n_S. apply remove_length. contradict n; auto. destruct (T_eq_dec a a0). subst a0. apply le_S; auto. apply IHl; auto. simpl. apply le_n_S; auto. apply IHl; auto. Qed.
Theorem remove_notIn: forall l a, ~In a l -> remove T_eq_dec a l=l. Proof. induction l; simpl; intros; auto. destruct (T_eq_dec a0 a); auto. contradict H; subst a0; auto. f_equal. apply IHl. contradict H; auto. Qed.
Theorem remove_Add: forall a l m, Add a l m ->remove T_eq_dec a l = remove T_eq_dec a m. Proof. intros. induction H; simpl. destruct (T_eq_dec a a); auto. contradict n; auto. destruct (T_eq_dec a x); auto; f_equal; auto. Qed.
Definition count_list: forall l, {pl| Perm l (fold_right (fun p=>app (repeat (fst p) (snd p))) nil pl) /\ NoDup (map fst pl) /\ Forall (fun x=>x<>0) (map snd pl)}. apply (Fix (well_founded_ltof (list T) (length (A:=T)))). intros l IH. destruct l. exists nil; simpl; auto. split; auto. split; auto. apply NoDup_nil. destruct (IH (remove T_eq_dec t l)) as [m [H1 [H2 H3]]]. unfold ltof. simpl. apply le_n_S. apply remove_length. exists ((t, S(count_occ T_eq_dec l t))::m). simpl. split. apply Perm_cons. remember (count_occ T_eq_dec l t) as c. revert H1 Heqc. clear -l. revert l. induction c; simpl; intros. rewrite remove_notIn in H1. apply H1. destruct count_occ_not_In with (eq_dec:=T_eq_dec) (l:=l) (x:=t). apply H0; auto.
  destruct (add_inv t l) as [[l' H2]|H2]. apply Perm_Add with t l' (repeat t c++fold_right (fun p=>app (repeat (fst p) (snd p))) nil m); auto. apply IHc. rewrite remove_Add with t l' l; auto. rewrite count_occ_Add_eq with t l' l in Heqc; auto. contradict H2. destruct (count_occ_In T_eq_dec l t). apply H0. rewrite <- Heqc; auto. apply le_n_S. apply le_0_n. split. apply NoDup_cons. assert (~In t (remove T_eq_dec t l)). apply remove_In.
  contradict H. eapply Perm_In. apply Perm_sym. eapply H1. apply in_map_iff in H. destruct H as [[n c] [H4 H5]]. simpl in H4. subst n. clear -H3 H5. induction m. destruct H5. simpl. apply in_or_app. destruct H5; [left|right]. subst a. simpl. destruct c; simpl; auto. inversion H3. auto. apply IHm. inversion H3; auto. auto. auto. apply Forall_cons; auto. Defined.
Theorem remove_In2: forall a l (x:T), In x (remove T_eq_dec a l) -> In x l. Proof. induction l; simpl; intros; auto. destruct (T_eq_dec a a0); auto. destruct H; auto. Qed.
Theorem remove_In3: forall l a x, In x l -> x=a \/ In x (remove T_eq_dec a l). Proof. induction l; simpl; intros; auto. destruct H. subst x. destruct (T_eq_dec a0 a); auto. destruct (IHl a0 x H); auto. right. destruct (T_eq_dec a0 a); auto. Qed.

Theorem incl_nil_l: forall l:list T, incl nil l. Proof. intros l x H. destruct H. Qed.
Theorem incl_l_nil: forall l:list T, incl l nil -> l=nil. Proof. intros l H. destruct l; auto. absurd (In t nil); auto. Qed.
Theorem remove_incl: forall l m (a:T), incl l m -> incl (remove T_eq_dec a l) (remove T_eq_dec a m). Proof. intros. intros x H0. destruct remove_In3 with m a x; auto. apply H. apply remove_In2 with a; auto. subst a. contradict H0. apply remove_In. Qed.
Theorem in_in_remove: forall (x y:T) l, x<>y -> In x l -> In x (remove T_eq_dec y l). Proof. induction l; intros. destruct H0. destruct H0. subst a. simpl. destruct (T_eq_dec y x). contradict H; auto. left; auto. simpl. destruct (T_eq_dec y a); auto. Qed.
Definition removeAll (l m:list T):= fold_right (remove T_eq_dec) m l.
Theorem removeAll_In: forall  (l m:list T) x, ~In x l /\ In x m <-> In x (removeAll l m). Proof. induction l; intros; simpl; split; intros. destruct H; auto. split; auto. destruct H. destruct (T_eq_dec x a). subst x; contradict H; auto. assert (In x (removeAll l m)). apply IHl with (m:=m). split; auto. apply remove_In3 with (a:=a) in H1. destruct H1; auto; contradiction. assert (In x (removeAll l m)). apply remove_In2 in H; auto. apply IHl in H0. destruct H0. split; auto. contradict H0. destruct H0; auto. subst a. contradict H. apply remove_In; auto. Qed.
Theorem removeAll_app: forall  (l1 l2 m:list T), removeAll (l1++l2) m = removeAll l1 (removeAll l2 m). Proof. induction l1; simpl; intros; auto. f_equal; auto. Qed.
Theorem removeAll_length: forall  (l m:list T), length (removeAll l m) <= length m. Proof. induction l; simpl; intros; auto. eapply le_trans. apply remove_length. apply IHl; auto. Qed.
Theorem removeAll_length2: forall  (l m:list T) x, In x l -> In x m -> length (removeAll l m) < length m. Proof. induction l; intros. destruct H. simpl. destruct H. subst x. destruct (in_dec T_eq_dec a l). apply le_lt_trans with (length (removeAll l m)); auto. apply remove_length. apply IHl with a; auto. apply lt_le_trans with (length (removeAll l m)). apply remove_length2; auto. apply removeAll_In; auto. apply removeAll_length. eapply le_lt_trans. eapply remove_length. eapply IHl; eauto. Qed.
Definition incl_dec: forall  (l m:list T), {x|In x l & ~In x m}+{incl l m}. induction l; intros. right. intros x H; inversion H. destruct (in_dec T_eq_dec a m). destruct (IHl m); [left|right]. destruct s. exists x; auto. intros x H. destruct H; auto. subst x; auto. left; exists a; auto. Defined.
Definition commonList: forall (l m:list T), {c|forall x, In x c<->In x l /\ In x m}. intros. exists (filter (dec2b (fun x=>in_dec T_eq_dec x m)) l). intros; split; intros. induction l. inversion H. simpl in H. remember (dec2b (fun x=>in_dec T_eq_dec x m) a) as b. destruct b. destruct H. subst a. symmetry in Heqb. apply dec2b_true in Heqb. auto. destruct IHl; auto. destruct IHl; auto. destruct H. induction l. destruct H. simpl. destruct H. subst a. remember (dec2b (fun y=>in_dec T_eq_dec y m) x) as b. symmetry in Heqb. destruct b; auto. apply dec2b_false in Heqb. contradiction. destruct (dec2b (fun y=>in_dec T_eq_dec y m) a); auto. Defined.
Definition split_until: forall (P:T->Prop) (l:list T) (P_dec:forall x, In x l->{P x}+{~P x}), {m1:list T & {x:T &{m2|P x /\ l=m1++x::m2 & Forall (fun x=>~P x) m1}}}+{Forall (fun x=>~P x) l}. induction l; intros. right; auto. destruct IHl as [[m1 [x [m2 [H1 H2] H3]]]|H1]. intros. apply P_dec; auto. subst l. destruct (P_dec a). left; auto. left. exists nil. exists a. exists (m1++x::m2); auto. left. exists (a::m1). exists x. exists m2; auto. destruct (P_dec a). auto. left. exists nil. exists a. exists l; auto. right. auto. Defined.
Definition head_n_split: forall n l, {l1:list T &{l2|l=l1++l2 & n <= length l->length l1=n}}. induction n. intros. exists nil. exists l; auto. intros. destruct l. exists nil. exists nil; auto. intros. inversion H. destruct (IHn l) as [l1 [l2 H1 H2]]. exists (t::l1). exists l2. simpl; f_equal; auto. intros. simpl. f_equal. apply H2. apply le_S_n; auto. Defined.
Definition repeat_head: forall a l, {n:nat &{b:T &{m| l=repeat a n++b::m & b<>a}}}+{n|l=repeat a n}. induction l. right. exists 0; auto. destruct (T_eq_dec a0 a). subst a0. destruct IHl as [[n [b [m H1 H2]]]|[n H1]]. subst l. left. exists (S n). exists b. exists m; auto. subst l. right. exists (S n); auto. left. exists 0. exists a0. exists l; auto. Defined.
Lemma repeat_app: forall (a:T) n l m, repeat a n = l++m -> {x:nat & {y:nat | l=repeat a x/\m=repeat a y&n=x+y}}. induction n; simpl; intros. exists 0. exists 0; simpl; auto. destruct l; [destruct m|]; auto; inversion H. destruct l. exists 0. exists (S n); simpl; auto. inversion H. subst t. apply IHn in H2. destruct H2 as [x [y [H3 H4] H5]]. exists (S x). exists y; simpl; [split|]; auto. f_equal; auto. Defined.
Lemma repeat_eq_rev: forall (a b:T) n m, repeat a n = repeat b m -> n=m. Proof. induction n; simpl; intros. destruct m; auto. inversion H. destruct m. inversion H. inversion H. subst b. f_equal; auto. Qed.
Lemma repeat_plus: forall (a:T) n m, repeat a (n+m) = repeat a n++repeat a m. Proof. induction n; simpl; intros; auto. f_equal. auto. Qed.
Definition app_rev: forall (l1 l2 m1 m2:list T), l1++l2=m1++m2 -> {n|l1=m1++n /\ m2=n++l2 & n<>nil}+{n|m1=l1++n/\l2=n++m2&n<>nil}+{l1=m1/\l2=m2}. induction l1; intros. destruct m1. right. simpl in H; auto. left. right. exists (t::m1); auto. intros D; inversion D. destruct m1 as [|b m1]. simpl in H. left. left. exists (a::l1); auto. intros D; inversion D. simpl in H. inversion H. subst b. apply IHl1 in H2. destruct H2 as [[[n [H3 H4] H5]|[n [H3 H4] H5]]|H3]. subst l1 m2. left. left. exists n; auto. subst m1 l2. left. right. exists n; auto. destruct H3. subst m1 m2. right; auto. Defined.
Theorem In_split: forall (a:T) l, {l1:list T &{l2| l=l1++a::l2 & ~In a l1}}+{~In a l}. induction l. right; auto. destruct (T_eq_dec a0 a). subst a0. left. exists nil. exists l; auto. destruct IHl as [[l1 [l2 H1 H2]]|H1]. left. exists (a0::l1). exists l2; auto. simpl. f_equal; auto. intros D. destruct D; contradiction. right. intros D. destruct D; contradiction. Defined.
Theorem pegeon_hole: forall  (l m:list T), incl l m -> length m<length l -> {a:T &{l1:list T &{l2:list T &{l3:list T|l=l1++a::l2++a::l3}}}}. Proof. intros. revert dependent l. induction m; intros. destruct l. contradict H0. apply le_not_lt; auto. absurd (In t nil); auto. destruct (In_split a l) as [[l1 [l2 H1 H2]]|H1]. subst l. destruct (In_split a l2) as [[l3 [l4 H3 H4]]|H3]. subst l2. exists a. exists l1. exists l3. exists l4; auto. destruct (IHm (l1++l2)). intros x Hx. cut (In x (a::m)); intros. destruct H1. subst x. apply in_app_or in Hx. destruct Hx; contradiction. auto. apply H. apply in_or_app. apply in_app_or in Hx. destruct Hx; auto. rewrite app_length in H0. simpl in H0. rewrite plus_comm in H0. simpl in H0. apply le_S_n in H0. rewrite app_length. rewrite plus_comm; auto. destruct s as [l3 [l4 [l5 H4]]]. exists x. apply app_rev in H4. destruct H4 as [[[n [Ha Hb] Hc]|[n [Ha Hb] Hc]]|Ha]. subst l1. destruct n. contradict Hc; auto. inversion Hb. subst t. clear Hb Hc. apply app_rev in H5. destruct H5 as [[[o [Hd He] Hf]|[o [Hd He] Hf]]|Hf].  subst l4 l2. exists l3. exists (n++a::o). exists l5. rewrite <- app_assoc. f_equal. simpl. f_equal. rewrite <- app_assoc. f_equal. subst n. destruct o. contradict Hf; auto. inversion He. subst t l5. exists l3. exists l4. exists (o++a::l2). rewrite <- app_assoc. f_equal. simpl; f_equal. rewrite <- app_assoc. f_equal. destruct Hf. subst n l2. exists l3. exists (l4++a::nil). exists l5. rewrite <- app_assoc. f_equal. simpl. f_equal. rewrite <- app_assoc. f_equal. auto. subst l3 l2. exists (l1++a::n).  exists l4. exists l5. rewrite <- app_assoc. f_equal. auto. destruct Ha. subst l2 l3. exists (l1++a::nil). exists l4. exists l5. rewrite <- app_assoc; auto. auto. apply IHm. intros x Hx. assert (In x (a::m)). apply H; auto. destruct H2; auto. subst x; contradiction. simpl in H0. apply lt_le_weak; auto. Defined.

Inductive ForallR (R: relation T): list T->Prop:=
|ForallR_nil: ForallR R nil
|ForallR_cons: forall x l, ForallR R l -> (forall y, In y l->R x y) -> ForallR R (x::l)
.
Inductive NoRDup (R:relation T): list T->Prop:=
|NoRDup_nil: NoRDup R nil
|NoRDup_cons: forall x l, NoRDup R l-> (forall y, In y l->~R x y) -> NoRDup R (x::l)
.
Hint Constructors ForallR NoRDup.
Theorem ForallR_Add_rev: forall (R:relation T) a l m, (forall x y, R x y->R y x) -> Add a l m -> ForallR R m -> ForallR R l /\ forall x, In x l -> R a  x. Proof. intros. induction H0; auto. inversion H1. subst x l0. split; auto. inversion H1. subst x0 l0. destruct (IHAdd H4). split; auto. apply ForallR_cons; auto. intros. apply Add_in with (x:=y) in H0. apply H5. apply H0; auto. intros y Hy. destruct Hy. subst y. apply H. apply H5. apply Add_in with (x:=a) in H0; apply H0; auto. apply H3; auto. Qed.
Theorem ForallR_Add: forall (R:relation T) a l m, (forall x y, R x y->R y x) -> Add a l m -> ForallR R l -> (forall x, In x l->R a x) -> ForallR R m. Proof. intros. induction H0; auto. apply ForallR_cons; auto. apply IHAdd; auto. inversion H1; auto. intros. apply Add_in with (x:=y) in H0. apply H0 in H3. destruct H3; auto. subst y. apply H. auto. inversion H1. auto. Qed.
Theorem ForallR_Perm: forall (R:relation T) l m, (forall x y, R x y->R y x) -> Perm l m -> ForallR R l -> ForallR R m. Proof. intros. revert H1. induction H0; intros; auto. destruct ForallR_Add_rev with R a l la; auto. apply ForallR_Add with a m; auto. intros. apply H5. apply Perm_In with m; auto. Qed.
Theorem NoRDup_Add_rev: forall (R:relation T) a l m, (forall x y, R x y->R y x) -> Add a l m -> NoRDup R m -> NoRDup R l /\ forall x, In x l -> ~R a x. Proof. intros. induction H0. inversion H1; auto. inversion H1. subst x0 l0. destruct (IHAdd H4). split. apply NoRDup_cons; auto. intros. apply Add_in with (x:=y) in H0; auto. apply H5. apply H0; auto. intros y Hy. destruct Hy. subst y. intros C. apply H in C. contradict C. apply H5. apply Add_in with (x:=a) in H0. apply H0; auto. auto. Qed.
Theorem NoRDup_Add: forall (R:relation T) a l m, (forall x y, R x y->R y x) -> Add a l m -> NoRDup R l -> (forall x, In x l->~R a x) -> NoRDup R m. Proof. intros. induction H0; auto. apply NoRDup_cons; auto. apply IHAdd; auto. inversion H1; auto. intros. apply Add_in with (x:=y) in H0. apply H0 in H3. destruct H3; auto. subst y. intros C. apply H in C. contradict C. auto. inversion H1. auto. Qed.
Theorem NoRDup_Perm: forall (R:relation T) l m, (forall x y, R x y->R y x) -> Perm l m -> NoRDup R l -> NoRDup R m. Proof. intros. revert H1. induction H0; intros; auto. destruct NoRDup_Add_rev with R a l la; auto. apply NoRDup_Add with a m; auto. intros. apply H5. apply Perm_In with m; auto. Qed.
Theorem NoRDup_app: forall (R:relation T) l m, NoRDup R l -> NoRDup R m -> (forall x y, In x l -> In y m -> ~R x y) -> NoRDup R (l++m). Proof. intros R l m H. revert m. induction H; simpl; intros; auto. apply NoRDup_cons. apply IHNoRDup; auto. intros. apply in_app_or in H3. destruct H3; auto. Qed.

Theorem nth_error_nth: forall l i (d:T), i<length l-> nth_error l i = Some (nth i l d). Proof. induction l; intros. inversion H. simpl. destruct i. simpl; auto. simpl. apply IHl. apply le_S_n; auto. Qed.
Theorem NoRDup_nth: forall (R:relation T) l i j (d:T), (forall x y, R x y->R y x) -> NoRDup R l -> i<length l -> j<length l -> R (nth i l d) (nth j l d) -> i=j. Proof. intros R l i j d H H0. revert i j. induction H0; intros. inversion H0. destruct i; destruct j; auto; simpl in H4. absurd (R x (nth j l d)); auto. apply H1. apply nth_In. apply le_S_n; auto. absurd (R x (nth i l d)); auto. apply H1. apply nth_In. apply le_S_n; auto. f_equal. apply IHNoRDup; auto; apply le_S_n; auto. Qed.

Inductive Head: T -> list T -> Prop := Head_intro: forall a l, Head a (a::l).
Inductive Tail: T -> list T -> Prop := Tail_nil: forall a, Tail a (a::nil) | Tail_cons: forall  a b l, Tail a l -> Tail a (b::l).
Hint Constructors Head Tail.
Definition Head_dec': forall (l:list T), {a| Head a l & forall b, Head b l -> b=a}+{l=nil}. intros. destruct l. right; auto. left; exists t; auto. intros. inversion H; auto. Defined.
Definition Tail_dec': forall (l:list T), {a| Tail a l & forall b, Tail b l -> b=a}+{l=nil}. intros. destruct l. right; auto. left. induction l. exists t; auto. intros. inversion H; auto. inversion H2. destruct IHl as [b H1 H2]. destruct l. exists a; auto. intros. inversion H. inversion H4; auto. inversion H8. exists b. inversion H1; auto. intros. apply H2. inversion H. inversion H4; auto. Defined.
Definition Tail_dec: forall (a:T) l, {Tail a l}+{~Tail a l}. intros. destruct (Tail_dec' l) as [[b H1 H2]|H1]. destruct (T_eq_dec a b). subst b; left; auto. right. contradict n; auto. subst l; right. intros D; inversion D. Defined.
Definition Tail_rev: forall (l:list T) t, Tail t l -> {m|l=m++t::nil}. intros. induction l. exfalso. inversion H. destruct l. exists nil. inversion H; subst a; auto. inversion H2. destruct IHl as [m H1]. inversion H; auto. exists (a::m). simpl. f_equal; auto. Defined.
Definition tail: forall (l:list T), {a:T & {m | l=m++a::nil}}+{l=nil}. induction l. right; auto. destruct IHl. destruct s as [b [m H]]. left. exists b. exists (a::m); auto. simpl. f_equal; auto. subst l. left. exists a. exists nil; auto. Defined.
Theorem Tail_In: forall (l:list T) t, Tail t l -> In t l. Proof. intros. induction H; auto. Qed.
Theorem Tail_app: forall(t:T) l m, Tail t l -> Tail t (m++l). Proof. intros. induction m; simpl; auto. Qed.
Theorem Tail_app_rev: forall (t:T) l m, Tail t (l++m) -> m<>nil -> Tail t m. Proof. intros. induction l. auto. inversion H. destruct l. destruct m. contradict H0; auto. inversion H4. inversion H4. auto. Qed.

Definition Disjoint: relation (list T):= fun l m =>forall x, ~(In x l /\ In x m).
Theorem Disjoint_comm: forall (l m:list T), Disjoint l m -> Disjoint m l. Proof. unfold Disjoint. intros. intros D. destruct D. absurd (In x l/\In x m); auto. Qed.
Theorem Disjoint_In1: forall l m (x:T), Disjoint l m -> In x l -> ~In x m. Proof. intros. intros D. unfold Disjoint in H. absurd (In x l/\In x m); auto. Qed.

Theorem incl_refl: forall (l:list T), incl l l. Proof. intros. intros x H; auto. Qed.
Theorem In_cons_l: forall x (l:list T), In x (x::l). Proof. intros; left; auto. Qed.
Theorem In_cons_r: forall x y (l:list T), In y l -> In y (x::l). Proof. intros; right; auto. Qed.
Theorem incl_cons: forall x (l:list T), incl l (x::l). Proof. intros. intros y H. right; auto. Qed.
Theorem incl_trans: forall (l m n:list T), incl l m -> incl m n -> incl l n. Proof. intros. intros x H1. apply H0. apply H; auto. Qed.
Theorem In_one: forall (x y:T), In y (x::nil) -> y=x. Proof. intros. destruct H; auto. destruct H. Qed.

Theorem firstn_S: forall i (l:list T) (d:T), i<length l -> firstn (S i) l = firstn i l++nth i l d::nil. Proof. induction i; simpl; intros. destruct l; auto. inversion H. destruct l; auto. inversion H. simpl. f_equal. apply IHi. simpl in H. apply le_S_n; auto. Qed.
Theorem skipn_S: forall {T:Type} (l:list T) n t, n<length l -> skipn n l=nth n l t::skipn (S n) l. Proof. induction l; intros. inversion H. destruct n. simpl; auto. simpl. apply IHl. apply le_S_n; auto. Qed.
Theorem combine_app: forall {T U:Type} (l1 l2:list T) (m1 m2:list U), length l1=length m1 -> combine (l1++l2) (m1++m2) = combine l1 m1++combine l2 m2. Proof. induction l1; intros. destruct m1. auto. inversion H. destruct m1. inversion H. simpl. f_equal. apply IHl1. inversion H; auto. Qed.
Theorem combine_cons: forall {T U:Type} (a:T) (b:U) l m, combine (a::l) (b::m) = (a,b)::combine l m. Proof. intros. auto. Qed.

Definition maxl (l:list nat) : nat := fold_right max 0 l.
Theorem maxl_le: forall x l, In x l -> x <= maxl l. Proof. induction l; intros. destruct H. simpl. destruct H. subst x. apply Nat.le_max_l. apply le_trans with (maxl l); auto. apply Nat.le_max_r. Qed.
Theorem maxl_In: forall l, In (maxl l) l \/ l=nil. Proof. induction l; intros; auto. left. simpl. destruct IHl. destruct (le_lt_dec a (maxl l)). right. rewrite max_r; auto. left. rewrite max_l; auto. apply lt_le_weak; auto. subst l. left. simpl. rewrite max_l; auto. apply le_O_n. Qed.
Fixpoint Smaxl (l:list nat) : nat := match l with |nil=>0 |a::l => let y:=Smaxl l in if le_lt_dec y a then S a else y end.
Theorem Smaxl_lt: forall x l, In x l -> x < Smaxl l. Proof. induction l; intros. destruct H. simpl. destruct H. subst x. destruct (le_lt_dec (Smaxl l) a); auto. destruct (le_lt_dec (Smaxl l) a); auto. apply lt_le_trans with (Smaxl l); auto. Qed.
Theorem Smaxl_lt2: forall x l, (forall y, In y l->y<x) -> Smaxl l<=x. Proof. induction l; intros; simpl. apply le_O_n. destruct (le_lt_dec (Smaxl l) a). apply H. left; auto. apply IHl. intros. apply H. right; auto. Qed.

(* equiv *)
Definition equiv (l m:list T) := forall x, In x l <-> In x m.
Theorem equiv_refl: forall l, equiv l l. Proof. intros. intros x; split; intros; auto. Qed.
Theorem equiv_sym: forall l m, equiv l m -> equiv m l. Proof. intros. intros x; split; intros; apply H; auto. Qed.
Theorem equiv_trans: forall l m n, equiv l m -> equiv m n -> equiv l n. Proof. intros. intros x; split; intros. apply H0; apply H; auto. apply H; apply H0; auto. Qed.
Definition equiv_dec: forall l m, {equiv l m}+{~equiv l m}. induction l; intros. destruct m; [left|right]. apply equiv_refl. intros C. absurd (In t nil); auto. apply C. left; auto. destruct (in_dec T_eq_dec a m); [|right]. destruct (in_dec T_eq_dec a l). destruct (IHl m); [left|right]. intros x; split; intros. destruct H. subst a; auto. apply e; auto. right; apply e; auto. contradict n. intros x; split; intros. apply n; right; auto. apply n in H. destruct H. subst a; auto. auto.
  destruct (IHl (remove T_eq_dec a m)); [left|right]. intros x; split; intros. destruct H. subst a; auto. apply e in H. apply remove_In2 in H; auto. apply remove_In3 with (a:=a) in H. destruct H. subst a; left; auto. right. apply e; auto. contradict n0. intros x; split; intros. cut (In x m). intros. apply remove_In3 with (a:=a) in H0. destruct H0; auto. subst x. contradiction. apply n0. right; auto. assert (In x m). apply remove_In2 in H. auto. apply n0 in H0. destruct H0; auto. subst x. contradict H. apply remove_In. contradict n. apply n; left; auto. Defined.

(* Sort *)
Variable R: relation T.
Variable R_ord: order T R.
Variable R_fullord: forall x y, R x y \/ R y x.
Variable R_dec: forall x y, {R x y}+{~R x y}.

Inductive Sorted: list T -> Prop :=
|Sorted_nil: Sorted nil
|Sorted_one: forall a, Sorted (a::nil)
|Sorted_cons: forall a b l, R a b -> Sorted (b::l) -> Sorted (a::b::l)
.
Hint Constructors Sorted.

Definition Sorted_dec: forall l, {Sorted l}+{~Sorted l}. induction l. left; auto. destruct l as [|b l]. left; auto. destruct IHl; [destruct (R_dec a b); [left|right]|right]; auto; contradict n; inversion n; auto. Defined.
Theorem Sorted_cons_rev: forall a l, Sorted (a::l) -> Sorted l. Proof. intros. inversion H; auto. Qed.
Theorem Sorted_min_cons: forall a l, Sorted l -> (forall x, In x l -> R a x) -> Sorted (a::l). Proof. intros. induction H; auto. Qed.
Theorem Sorted_min: forall a l, Sorted (a::l) -> forall x, In x (a::l) -> R a x. Proof. destruct R_ord. induction l; simpl; intros. destruct H0; [subst x|]; auto. destruct H0. destruct H0. subst x; auto. destruct H0. subst x. inversion H; auto. apply IHl; auto. inversion H. subst a1 a0 l0. inversion H5; auto. apply Sorted_cons; auto. apply ord_trans with b; auto. Qed.
Theorem Sorted_Perm_uniq: forall l m, Sorted l -> Sorted m -> Perm l m -> l=m. Proof. induction l; simpl; intros. destruct m; auto. absurd (In t nil); auto. apply Perm_In with (t::m); auto. destruct m as [|b m]. absurd (In a nil); auto. apply Perm_In with (a::l); auto. cut (a=b); intros. subst b. f_equal. apply IHl; try apply Sorted_cons_rev with a; auto. apply Perm_Add_inv with a (a::l) (a::m); auto. destruct R_ord. apply ord_antisym. apply Sorted_min with l; auto. apply Perm_In with (b::m); auto. apply Sorted_min with m; auto. apply Perm_In with (a::l); auto. Qed.
Theorem Sorted_app: forall l a m, Sorted l -> Sorted (a::m) -> (forall x, In x l ->R x a) -> Sorted (l++a::m). Proof. intros l a m H. induction H; simpl; intros; auto. Qed.
Definition insert_one: forall a l,  Sorted l -> {m|Add a l m & Sorted m}. induction l; intros. exists (a::nil); auto. destruct R_ord. destruct (R_dec a a0). exists (a::a0::l); auto. destruct IHl as [m H1 H2]. apply Sorted_cons_rev with a0; auto. exists (a0::m); auto. apply Sorted_min_cons; auto. intros. apply Add_in with (x:=x) in H1. apply H1 in H0. destruct H0. subst x. destruct (R_fullord a0 a); auto; contradiction. apply Sorted_min with l; auto. Defined.
Definition insert_sort: forall l, {m|Sorted m & Perm l m}. induction l. exists nil; auto. destruct IHl as [m H1 H2]. destruct (insert_one a H1) as [m' H3 H4]; auto. exists m'; auto. apply Perm_Add with a l m; auto. Defined.
Definition quick_sort: forall l, {m|Sorted m & Perm l m}. apply (Fix (well_founded_ltof (list T) (length (A:=T)))). intros l IH. destruct l as [|a l]. exists nil; auto. assert (Perm l (filter (fun x=>if R_dec x a then true else false) l++filter (fun x=>negb (if R_dec x a then true else false)) l)). apply filter_app_Perm. destruct (IH (filter (fun x=>if R_dec x a then true else false) l)) as [ma H1 H2]. unfold ltof. simpl. apply le_n_S. apply Perm_length in H. rewrite H. rewrite app_length. apply le_plus_l. destruct (IH (filter (fun x=>negb (if R_dec x a then true else false)) l)) as [mb H3 H4]. unfold ltof. simpl. apply le_n_S. apply Perm_length in H. rewrite H. rewrite app_length. apply le_plus_r.
  exists (ma++a::mb). apply Sorted_app; auto. apply Sorted_min_cons; auto. intros. apply Perm_sym in H4. apply Perm_In with (a:=x) in H4; auto. apply filter_In in H4. destruct H4. destruct (R_dec x a). inversion H5. destruct (R_fullord x a); auto; contradiction. intros. apply Perm_sym in H2. apply Perm_In with (a:=x) in H2; auto. apply filter_In in H2. destruct H2. destruct (R_dec x a); auto. inversion H5. apply Perm_Add with a l (ma++mb); auto. eapply Perm_trans. eapply H. apply Perm_app; auto. clear -ma. induction ma; simpl; auto. Defined.
Definition nat_eq_dec: forall x y:nat, {x=y}+{x<>y}. induction x; intros. destruct y; [left|right]; auto. destruct y. right; auto. destruct (IHx y); [left|right]; auto. Defined.
Definition half_split: forall l, {la:list T & {lb|Perm l (la++lb) & length la = length lb \/ length la=S (length lb)}}. induction l. exists nil; exists nil; simpl; auto. destruct IHl as [la [lb H1 H2]]. destruct (nat_eq_dec (length la) (length lb)). exists (a::la); exists lb; simpl. apply Perm_Add with a l (la++lb); auto. right; auto. exists la; exists (a::lb). apply Perm_Add with a l (la++lb); auto. clear -la; induction la; simpl; auto. destruct H2. contradiction. left. rewrite H; auto. Defined.
Definition merge': forall p, Sorted (fst p)->Sorted (snd p)->{n|Sorted n & Perm n (fst p++snd p)}. intros p. apply (Fix (well_founded_ltof (list T*list T) (fun p=>length (fst p)+length (snd p)))) with (P:=fun p=>Sorted (fst p)->Sorted (snd p)->{n|Sorted n & Perm n (fst p++snd p)}). clear p. intros p IH. destruct p as [la lb]. simpl. intros. destruct la as [|a la]. exists lb; auto. destruct lb as [|b lb]. rewrite app_nil_r. exists (a::la); auto. destruct (R_dec a b). destruct (IH (la,b::lb)) as [m H1 H2]. unfold ltof. simpl. auto. simpl; apply Sorted_cons_rev with a; auto. simpl; auto. exists (a::m). apply Sorted_min_cons; auto. intros. apply Perm_In with (a:=x) in H2; auto. apply in_app_or in H2. destruct H2. apply Sorted_min with la; auto. destruct R_ord. apply ord_trans with b; auto. apply Sorted_min with lb; auto.
  simpl. apply Perm_Add with a m (la++b::lb); auto. destruct R_ord. destruct (IH (a::la, lb)) as [m H1 H2]; auto. unfold ltof. simpl. rewrite <- plus_n_Sm; auto. apply Sorted_cons_rev with b; auto. exists (b::m). destruct (R_fullord a b). contradiction. apply Sorted_min_cons; auto. intros. apply Perm_In with (a:=x) in H2; auto. apply in_app_or in H2. destruct H2. apply ord_trans with a; auto. apply Sorted_min with la; auto. apply Sorted_min with lb; auto. apply Perm_Add with b m ((a::la)++lb); auto. generalize (a::la) as l. induction l; simpl; auto. Defined.
Definition merge: forall l m, Sorted l -> Sorted m -> {n|Sorted n & Perm n (l++m)}. intros. destruct (merge' (l,m)) as [n H1 H2]; auto. exists n; auto. Defined.
Definition merge_sort: forall l, {m|Sorted m & Perm l m}. apply (Fix (well_founded_ltof (list T) (length (A:=T)))). intros l IH. destruct (half_split l) as [la [lb H1 H2]]. destruct lb as [|b lb]. exists la. destruct la; auto. destruct la; auto. simpl in H2. destruct H2; inversion H. rewrite app_nil_r in H1; auto. destruct (IH la) as [ma H3 H4]. unfold ltof. apply Perm_length in H1. rewrite H1. rewrite app_length. simpl. rewrite <- plus_n_Sm. apply le_n_S. apply le_plus_l. destruct (IH (b::lb)) as [mb H5 H6]. unfold ltof. apply Perm_length in H1. rewrite H1. rewrite app_length. destruct la. simpl in H2. destruct H2; inversion H. simpl. apply le_n_S. apply le_plus_r. destruct (merge H3 H5) as [m H7 H8]. exists m; auto. apply Perm_trans with (la++b::lb); auto. apply Perm_trans with (ma++mb); auto. apply Perm_app; auto. Defined.

End ListType.

Section ListType2.
Variable T U V:Type.

Hint Constructors NoDup Perm Add.
Theorem NoDup_map_inv: forall (f:T->U) l, NoDup (map f l) -> NoDup l. Proof. induction l; simpl; intros; auto. inversion H. apply NoDup_cons; auto. contradict H2. apply in_map_iff. exists a; auto.  Qed.
Theorem NoDup_map: forall (f:T->U) l, NoDup l -> (forall x y, In x l -> In y l -> f x=f y -> x=y) -> NoDup (map f l). Proof. induction l; simpl; intros; auto. inversion H. apply NoDup_cons; auto. contradict H3. apply in_map_iff in H3. subst x l0. destruct H3 as [x [H6 H5]]. replace a with x; auto. Qed.
Theorem NoDup_flat_map: forall (f:T->list U) l, NoDup l -> (forall x, In x l->NoDup (f x)) -> (forall x y z, In x l->In y l->In z (f x)->In z (f y)->x=y) -> NoDup (flat_map f l). Proof. induction l; intros; simpl; auto. inversion H. subst x l0. assert (NoDup (f a)). apply H0; left; auto. remember (f a) as m. assert (forall y, In y m->~In y (flat_map f l)). intros. intros C. apply in_flat_map in C. destruct C as [x [H6 H7]]. subst m. assert (a=x). apply H1 with y; auto. left; auto. right; auto. subst a. contradiction. assert (NoDup (flat_map f l)). apply IHl; auto. intros. apply H0. right; auto. intros. apply H1 with z; auto; right; auto. clear -H2 H3 H6. induction m; simpl; auto. apply NoDup_cons. intros C. apply in_app_or in C. destruct C. inversion H2; contradiction. contradict H; apply H3; left; auto. apply IHm. inversion H2; auto. intros. apply H3; right; auto. Qed.
Theorem map_Add: forall (f:T->U) l a la, Add a l la -> Add (f a) (map f l) (map f la). Proof. intros. induction H; simpl; auto. Qed.
Hint Resolve map_Add.
Theorem Perm_map: forall (f:T->U) l m, Perm l m -> Perm (map f l) (map f m). Proof. intros. induction H; simpl; auto. apply Perm_Add with (f a) (map f l) (map f m); auto. Qed.
Theorem Perm_map_inv: forall (f:T->U) l m, (forall x y, f x=f y -> x=y) -> Perm (map f l) (map f m) -> Perm l m. Proof. induction l; simpl; intros. destruct m; auto. simpl in H0. absurd (In (f t) nil); auto. apply Perm_In with (f t::map f m); auto. apply Perm_sym; auto. left; auto. destruct Add_inv with (a:=a) (l:=m) as [m' H1]. cut (In (f a) (map f m)); intros. apply in_map_iff in H1. destruct H1 as [y [H2 H3]]. replace a with y; auto. apply Perm_In with (f a::map f l); auto. left; auto. apply Perm_Add with a l m'; auto. apply IHl; auto. apply Perm_Add_inv with (f a) (f a::map f l) (map f m); auto. Qed.
Theorem filter_map: forall (m:T->U) (f:U->bool) l, filter f (map m l) = map m (filter (fun x=>f (m x)) l). Proof. induction l; simpl; auto. destruct (f (m a)); simpl; auto. f_equal; auto. Qed.
Theorem flat_map_app: forall (f:T->list U) l m, flat_map f (l++m) = flat_map f l ++flat_map f m. Proof. induction l; intros; simpl; auto. rewrite <- app_assoc. f_equal; auto. Qed.
Theorem Perm_flat_map: forall (f:T->list U) l m, Perm l m -> Perm (flat_map f l) (flat_map f m). Proof. induction l; intros. destruct m; simpl; auto. absurd (In t nil); auto. apply Perm_In with (t::m). apply Perm_sym; auto. left; auto. simpl. destruct (Add_inv a m) as [m' H1]. apply Perm_In with (a::l); auto. left; auto. destruct (Add_split H1) as [m1 [m2 [H2 H3]]]. subst m m'. rewrite flat_map_app. simpl. apply Perm_trans with (f a++flat_map f m1++flat_map f m2). apply Perm_app; auto. apply Perm_refl. rewrite <- flat_map_app. apply IHl. apply Perm_Add_inv with a (a::l) (m1++a::m2); auto. repeat rewrite app_assoc. apply Perm_app; auto. apply Perm_app_swap. apply Perm_refl. Qed.
Theorem map_repeat: forall (f:T->U) a n, map f (repeat a n) = repeat (f a) n. Proof. induction n; simpl; auto. f_equal; auto. Qed.

Definition all_pair (f:T->U->V) l m : list V := fold_right (fun x=>app (map (f x) m)) nil l.
Theorem all_pair_spec1: forall f l m x y, In x l -> In y m -> In (f x y) (all_pair f l m). Proof. induction l; simpl; intros; auto. apply in_or_app. destruct H; [left|right]; auto. subst x. apply in_map_iff. exists y; auto. Qed.
Theorem all_pair_spec2: forall f l m z, In z (all_pair f l m) -> exists x y, In x l /\ In y m /\ z=f x y. Proof. induction l; simpl; intros. destruct H. apply in_app_or in H. destruct H. apply in_map_iff in H. destruct H as [y [H1 H2]]. subst z. exists a. exists y; auto. destruct (IHl m z H) as [x [y [H1 [H2 H3]]]]. subst z. exists x. exists y; auto. Qed.
Definition maxf: forall (f:T->nat) l, {x|In x l & forall y, In y l->f y<=f x}+{l=nil}. induction l; [right|left]; auto. destruct IHl as [[x H1 H2]|H1]. destruct (le_lt_dec (f a) (f x)). exists x; auto. right; auto. intros. destruct H; auto. subst y; auto. exists a. left; auto. intros. destruct H; auto. subst y; auto. apply le_trans with (f x); auto. apply lt_le_weak; auto. subst l. exists a. left; auto. intros. destruct H. subst a; auto. destruct H. Defined.
Definition minf: forall (f:T->nat) l, {x|In x l & forall y, In y l->f x<=f y}+{l=nil}. induction l; [right|left]; auto. destruct IHl as [[x H1 H2]|H1]. destruct (le_lt_dec (f a) (f x)). exists a; auto. left; auto. intros. destruct H; auto. subst y; auto. apply le_trans with (f x); auto. exists x.  right; auto. intros. destruct H; auto. subst y; auto. apply lt_le_weak; auto. subst l. exists a. left; auto. intros. destruct H. subst a; auto. destruct H. Defined.

Inductive MapR (R:T->U->Prop) : list T -> list U -> Prop :=
|MapR_nil: MapR R nil nil
|MapR_cons: forall l m a b, MapR R l m -> R a b -> MapR R (a::l) (b::m)
.
Hint Constructors MapR.
Theorem MapR_length: forall R l m, MapR R l m -> length l = length m. Proof. intros. induction H; simpl; auto. Qed.
Theorem MapR_app: forall R l1 l2 m1 m2, MapR R l1 m1 -> MapR R l2 m2 -> MapR R (l1++l2) (m1++m2). Proof. intros. induction H; simpl; auto. Qed.
Theorem in_MapR_1: forall R l m x, MapR R l m -> In x l -> exists y, R x y /\ In y m. Proof. intros. revert H0. revert x. induction H; intros. destruct H0. destruct H1. subst x. exists b; split; [|left]; auto. destruct (IHMapR x H1) as [y [H2 H3]]. exists y; split; [|right]; auto. Qed.
Theorem in_MapR_2: forall R l m x, MapR R l m -> In x m -> exists y, R y x /\ In y l. Proof. intros. revert H0. revert x. induction H; intros. destruct H0. destruct H1. subst x. exists a; split; [|left]; auto. destruct (IHMapR x H1) as [y [H2 H3]]. exists y; split; [|right]; auto. Qed.
Theorem MapR_combine: forall R l m, MapR R l m -> forall x y, In (x,y) (combine l m) -> R x y. Proof. induction l; intros. inversion H0. inversion H. subst a0 l0 m. simpl in H0. destruct H0. inversion H0; subst a b; auto. apply IHl with m0; auto. Qed.
Theorem MapR_map: forall {V:Type} (f:V->T) (g:V->U) l (R:T->U->Prop), (forall x, In x l-> R (f x) (g x)) -> MapR R (map f l) (map g l). Proof. induction l; intros; simpl; auto. apply MapR_cons. apply IHl; auto. intros. apply H. right; auto. apply H. left; auto. Qed.
Theorem MapR_trans: forall (R1 R2:T->U->Prop) l m, (forall x y, In x l->In y m->R1 x y->R2 x y) -> MapR R1 l m -> MapR R2 l m. Proof. induction l; intros. inversion H0; auto. inversion H0. apply MapR_cons. apply IHl. intros. apply H; auto. right; auto. subst m; right; auto. auto. apply H; auto. left; auto. subst m; left; auto. Qed.
Definition MapR_build: forall (l:list T) (R:T->U->Prop) (H:forall x, In x l->{y:U|R x y}), {m:list U|MapR R l m}. induction l; intros. exists nil. auto. destruct (IHl R) as [m H0]. intros. apply H. right; auto. destruct (H a) as [y H1]. left; auto. exists (y::m); auto. Defined.
Definition MapR_build2: forall (l:list T) (R1 R2:T->U->Prop) (H:forall x, In x l->{y:U|R1 x y & R2 x y}), {m:list U|MapR (fun x y=>R1 x y/\R2 x y) l m}. induction l; intros. exists nil; auto. destruct (IHl R1 R2) as [m H0]. intros; apply H; right; auto. destruct (H a) as [b H1 H2]. left; auto. exists (b::m); auto. Defined.
Definition MapR_build': forall (R:T->U->Prop) (l:list T), (forall x, In x l->exists y, R x y) -> exists m, MapR R l m. Proof. induction l; intros. exists nil; auto. destruct IHl as [m H0]. intros; apply H; right; auto. destruct (H a) as [b H1]; auto. left; auto. exists (b::m); auto. Qed.
Theorem MapR_nth: forall (R:T->U->Prop) l m i dt du, i<length l -> MapR R l m -> R (nth i l dt) (nth i m du). Proof. induction l; intros. inversion H. inversion H0. subst a0 l0 m. destruct i. simpl; auto. simpl. apply IHl. simpl in H. apply le_S_n in H; auto. auto. Qed.
Theorem combine_MapR: forall (R:T->U->Prop) l m, length l=length m -> Forall (fun p=>R (fst p) (snd p)) (combine l m) -> MapR R l m. Proof. induction l; intros. destruct m; auto. inversion H. destruct m. inversion H. simpl in H0. inversion H0. apply MapR_cons; auto. Qed.

Variable T_eq_dec: forall x y:T, {x=y}+{x<>y}.

Hint Resolve equiv_refl equiv_sym equiv_trans.
Hint Constructors NoRDup.
(* PowerSet *)
Definition powerSet': forall l:list T, NoDup l -> {pl| forall m, incl m l <-> Exists (equiv m) pl & NoRDup (equiv (T:=T)) pl}. induction l; intros. exists (nil::nil); auto. intros; split; intros. destruct m. apply Exists_cons_hd; auto. absurd (In t nil); auto. apply H0; left; auto. inversion H0. intros y Hx. apply H2; auto. inversion H2. destruct IHl as [pl H0 H1]. inversion H; auto. exists (map (cons a) pl++pl); inversion H; subst x l0. intros; split; intros. assert (incl (remove T_eq_dec a m) l). intros x Hx. cut (In x m). intros. apply H2 in H3. destruct H3; auto. subst x. contradict Hx. apply remove_In. apply remove_In2 in Hx; auto. apply H0 in H3. apply Exists_exists in H3. destruct H3 as [m' [H6 H7]].
  apply Exists_exists. destruct (in_dec T_eq_dec a m) as [H3|H3]; [exists (a::m')|exists m']; split. apply in_or_app. left. apply in_map_iff. exists m'; auto. intros x; split; intros. apply remove_In3 with (a:=a) (T_eq_dec:=T_eq_dec) in H8. destruct H8; [left|right]; auto. apply H7; auto. destruct H8. subst x; auto. apply H7 in H8. apply remove_In2 in H8; auto. apply in_or_app. right; auto. rewrite remove_notIn in H7; auto. apply Exists_exists in H2. destruct H2 as [m' [H6 H7]]. apply in_app_or in H6. destruct H6. apply in_map_iff in H2. destruct H2 as [m'' [H8 H9]]. subst m'. intros x Hx. apply H7 in Hx. destruct Hx. subst x; left; auto. right. cut (incl m'' l); intros. apply H3; auto. apply H0. apply Exists_exists. exists m''; auto. intros x Hx. apply H7 in Hx. right. cut (incl m' l); intros. apply H3; auto. apply H0. apply Exists_exists. exists m'; auto.
  apply NoRDup_app; auto. cut (forall m, In m pl->~In a m). intros. clear -H2 H1. revert H2. induction pl; intros; auto. inversion H1. subst a0 l. simpl. apply NoRDup_cons; auto. apply IHpl; auto. intros. apply H2; right; auto. intros y Hy. apply in_map_iff in Hy. destruct Hy as [z [H5 H6]]. subst y. intros C. absurd (equiv x z); auto. intros y; split; intros. cut (In y (a::z)); intros. destruct H0; auto. subst y. contradict H. apply H2; left; auto. apply C; right; auto. cut (In y (a::z)); intros; auto. apply C in H0. destruct H0; auto. subst y. contradict H; apply H2; right; auto. right; auto. intros. contradict H4. cut (incl m l); intros. apply H3; auto. apply H0. apply Exists_exists. exists m; auto. intros. intros C. absurd (In a y). contradict H4. cut (incl y l); intros. apply H6; auto. apply H0. apply Exists_exists. exists y; auto. apply C. apply in_map_iff in H2. destruct H2 as [z [H6 H7]]. subst x. left; auto. Defined.
Definition powerSet: forall l:list T, {pl| forall m, incl m l <-> Exists (equiv m) pl & NoRDup (equiv (T:=T)) pl}. intros. destruct powerSet' with (l:=nodup T_eq_dec l) as [pl H H0]. apply NoDup_nodup. exists pl; auto. intros; split; intros. apply H. intros x Hx. apply nodup_In. auto. apply H in H1. intros x Hx. apply H1 in Hx. apply nodup_In in Hx; auto. Defined.
Definition in_powerSet: forall (l:list T) a, {pl| forall m, (incl m l/\In a m) <-> Exists (equiv m) pl}. intros. destruct powerSet with (l:=l) as [pl H1 H2]. exists (filter (dec2b (in_dec T_eq_dec a) )pl). intros; split; intros. destruct H. apply H1 in H. apply Exists_exists in H. destruct H as [x [H3 H4]]. apply Exists_exists. exists x; split; auto. apply filter_In. split; auto. apply dec2b_true. apply H4; auto. apply Exists_exists in H. destruct H as [x [H3 H4]]. apply filter_In in H3. destruct H3. apply dec2b_true in H0. split. apply H1. apply Exists_exists. exists x; auto. apply H4; auto. Defined.
Definition contain_powerSet: forall (l:list T) n, {pl| forall m, (incl m l/\ exists x, In x m /\ In x n) <-> Exists (equiv m) pl}. intros. induction n. exists nil. intros; split; intros. destruct H. destruct H0 as [x [_ H1]]. destruct H1. apply Exists_exists in H. destruct H as [x [H1 _]]. destruct H1. destruct IHn as [pl H]. destruct (in_powerSet l a) as [pl' H0]. exists (pl'++pl). intros; split; intros. destruct H1 as [H2 [x [H3 H4]]]. apply Exists_exists. destruct H4. subst x. assert (incl m l/\In a m); auto. apply H0 in H1. apply Exists_exists in H1. destruct H1 as [x [H4 H5]]. exists x; split; auto. apply in_or_app; auto. assert (incl m l/\ exists x, In x m/\In x n). split; auto. exists x; auto. apply H in H4. apply Exists_exists in H4. destruct H4 as [y [H5 H6]]. exists y; split; auto. apply in_or_app; auto. apply Exists_exists in H1. destruct H1 as [x [H2 H3]]. apply in_app_or in H2. destruct H2. assert (Exists (equiv m) pl'). apply Exists_exists. exists x; auto. apply H0 in H2. destruct H2. split; auto. exists a; split; auto. left; auto.
  assert (Exists (equiv m) pl). apply Exists_exists. exists x; auto. apply H in H2. destruct H2. destruct H4 as [y [H5 H6]]. split; auto. exists y; split; auto. right; auto. Defined.

Definition psSize (l:list T):= let (pl,_,_):=powerSet l in length pl.
Definition ps2i (l m:list T) : nat := let (pl,_,_):=powerSet l in match (findP_nth (equiv m) pl (fun x _=>equiv_dec T_eq_dec m x)) with inleft _ (existT _ i _) => i | inright _ => (length pl) end.
Definition i2ps (l:list T) (i:nat) : list T := let (pl,_,_):=powerSet l in nth i pl nil.

Theorem ps2i_spec1: forall l m, incl m l -> ps2i l m < psSize l. Proof. intros. unfold psSize. unfold ps2i. destruct (powerSet l) as [pl H1 H2]. destruct (findP_nth (equiv m) pl) as [[n [x H3 H4]]|H3]. apply nth_error_Some. rewrite H3. discriminate. apply H1 in H. apply Exists_exists in H. destruct H as [x [H4 H5]]. contradict H5; auto. Qed.
Theorem ps2i_spec2: forall l m1 m2, incl m1 l -> incl m2 l -> ps2i l m1 = ps2i l m2 -> equiv m1 m2. Proof. unfold ps2i. intros. destruct (powerSet l) as [pl H2 H3]. destruct (findP_nth (equiv m1) pl) as [[n1 [x1 H4 H5]]|H4].  destruct (findP_nth (equiv m2) pl) as [[n2 [x2 H6 H7]]|H6]. subst n2. rewrite H4 in H6. inversion H6. subst x2. apply equiv_trans with x1; auto. apply H2 in H0. apply Exists_exists in H0. destruct H0 as [x [H7 H8]]. contradict H8; auto. apply H2 in H. apply Exists_exists in H. destruct H as [x [H5 H6]]. contradict H6; auto. Qed.
Theorem ps2i_spec3: forall l m1 m2, equiv m1 m2 -> ps2i l m1 = ps2i l m2. Proof. unfold ps2i. intros. destruct (powerSet l) as [pl H1 H2]. destruct (findP_nth (equiv m1) pl) as [[n1 [x1 H4 H5]]|H4];  destruct (findP_nth (equiv m2) pl) as [[n2 [x2 H6 H7]]|H6]. assert (n1<length pl). apply nth_error_Some. rewrite H4; discriminate. assert (n2<length pl). apply nth_error_Some. rewrite H6. discriminate. apply NoRDup_nth with (R:=equiv (T:=T)) (l:=pl) (d:=nil); auto. rewrite nth_error_nth with (d:=nil) in H4; auto. rewrite nth_error_nth with (d:=nil) in H6; auto. inversion H4. inversion H6. subst x1 x2. apply equiv_trans with m1; auto. apply equiv_trans with m2; auto. absurd (equiv m2 x1); auto. apply H6. apply nth_error_In in H4; auto. apply equiv_trans with m1; auto. absurd (equiv m1 x2). apply H4. apply nth_error_In in H6; auto. apply equiv_trans with m2; auto. auto. Qed.
Theorem i2ps_spec1: forall l i, i < psSize l -> incl (i2ps l i) l. Proof. unfold psSize. unfold i2ps. intros. destruct (powerSet l) as [pl H1 H2]. intros x Hx. cut (incl (nth i pl nil) l); intros. apply H0; auto. apply H1. apply Exists_exists. exists (nth i pl nil); split; auto. apply nth_In; auto. Qed.
Theorem i2ps_spec2: forall l i, i < psSize l -> ps2i l (i2ps l i) = i. Proof. unfold psSize. unfold ps2i. unfold i2ps. intros. destruct (powerSet l) as [pl H1 H2]. destruct (findP_nth (equiv (nth i pl nil)) pl) as [[n [x H3 H4]]|H3]. apply NoRDup_nth with (R:=equiv (T:=T)) (l:=pl) (d:=nil). intros. apply equiv_sym; auto. auto. apply nth_error_Some. rewrite H3. discriminate. auto. rewrite nth_error_nth with (d:=nil) in H3; auto. inversion H3. subst x; auto. apply nth_error_Some. rewrite H3. discriminate. absurd (equiv (nth i pl nil) (nth i pl nil)). apply H3. apply nth_In; auto. apply equiv_refl. Qed.
Theorem i2ps_spec3: forall l m, incl m l -> equiv m (i2ps l (ps2i l m)). Proof. unfold i2ps. unfold ps2i. intros. destruct (powerSet l) as [pl H1 H2]. destruct (findP_nth (equiv m) pl) as [[n [x H3 H4]]|H3]. rewrite nth_error_nth with (d:=nil) in H3. inversion H3. subst x; auto. apply nth_error_Some. rewrite H3; discriminate. apply H1 in H. apply Exists_exists in H. destruct H as [x [H4 H5]]. apply H3 in H4. contradiction. Qed.

Variable U_eq_dec:forall x y:U, {x=y}+{x<>y}.
Definition inv_func: forall (f:T->U) l (d:T), (forall x y, In x l->In y l->f x=f y->x=y) -> {g:U->T|forall x, In x l->g (f x)=x & forall y, ~In y (map f l)->g y=d}. intros. exists (fun y=>match findP (fun x=>f x=y) l (fun x _=>U_eq_dec (f x) y) with inleft _ (exist2 _ _ f _ _) => f  | inright _ _ => d end). intros. destruct (findP (fun y=>f y=f x) l (fun y _=>U_eq_dec (f y) (f x))) as [[a H1 H2]|H1]; auto. absurd (f x=f x); auto. intros. destruct (findP (fun x=>f x=y) l (fun x _=>U_eq_dec (f x) y)) as [[a H1 H2]|H1]; auto.  contradict H0. subst y. apply in_map_iff. exists a; auto. Defined.

End ListType2.

Theorem MapR_refl: forall {T:Type} (R:T->T->Prop) (l:list T), (forall x, In x l -> R x x) -> MapR R l l. Proof. induction l; intros; auto. apply MapR_nil. apply MapR_cons; auto. apply IHl. intros; apply H. right; auto. apply H; left; auto. Qed.
Theorem MapR_map2: forall {T1 T2 U1 U2:Type} (R:T2->U2->Prop) (f:T1->T2) (g:U1->U2) l m, MapR (fun x y=>R (f x) (g y)) l m -> MapR R (map f l) (map g m). Proof. induction l; simpl; intros. inversion H; simpl; auto. apply MapR_nil. inversion H; simpl; auto. apply MapR_cons. apply IHl; auto. auto. Qed.
Theorem MapR_sym: forall {T U:Type} (R:T->U->Prop) l m, MapR R l m -> MapR (fun x y=>R y x) m l. Proof. intros. induction H. apply MapR_nil. apply MapR_cons; auto. Qed.

Definition splits: forall {T:Type} (l: list T), {pl| forall p, l=fst p++snd p <-> In p pl & NoDup pl}. induction l as [|a l]. exists ((nil,nil)::nil). intros; split; intros. destruct p. simpl in H. destruct l. destruct l0. left; auto. inversion H. inversion H. destruct H. subst p. auto. destruct H. apply NoDup_cons; auto. apply NoDup_nil. destruct IHl as [pl H1 Hn]. exists ((nil, a::l)::map (fun p=> (a::fst p, snd p)) pl). intros; split; intros. destruct p as [t u]. simpl in H. destruct t. left. simpl in H. subst u. auto. inversion H. subst a l. right. apply in_map_iff. exists (t0,u). split; auto. apply H1; auto. destruct H. subst p. auto. apply in_map_iff in H. destruct H as [[t u] [H2 H3]]. subst p. simpl. f_equal. apply H1 in H3. subst l; auto. apply NoDup_cons. intros C. apply in_map_iff in C. destruct C as [[x y] [H2 H3]]. inversion H2. apply NoDup_map; auto. intros. destruct x. destruct y. simpl in H2. inversion H2. auto. Defined.
Definition ubound_sig: forall (l:list nat), {a|forall x, In x l->x<a & forall b, (forall x, In x l->x<b) -> a<=b}. induction l. exists 0; intros. destruct H. apply le_O_n. destruct IHl as [m Ha Hb]. destruct (le_lt_dec m a). exists (S a); intros. destruct H. subst x; auto. apply lt_le_trans with m; auto. apply H. left; auto. exists m; intros; auto. destruct H; auto. subst x; auto. apply Hb. intros. apply H. right; auto. Defined.
Definition ubound (l:list nat): nat := let (n,_,_):= ubound_sig l in n.
Theorem ubound_Disjoint: forall l m, Disjoint l (map (plus (ubound l)) m). Proof. intros. unfold ubound. destruct (ubound_sig l) as [n H _]. intros x D. destruct D. absurd (x<n); auto. apply le_not_lt. apply in_map_iff in H1. destruct H1 as [y [H2 H3]]. subst x. auto. apply le_plus_l. Qed.

Hint Constructors Swap Perm Add NoDup Sorted ForallR NoRDup Tail Head MapR.
Hint Resolve in_eq in_cons Swap_sym Perm'_sym Perm'_refl Perm'_trans Swap_Perm'.
Hint Resolve Perm'_cons Perm'_cons_Add.
Hint Resolve Perm_In Perm_length Perm__Perm' Perm_refl Perm_sym Perm_cons.
Hint Resolve Add_insert Add_dual Perm_Add_inv Perm_trans Perm'__Perm.
Hint Resolve Perm_rev Perm_nil_eq Perm_one app_Add Perm_app_swap Perm_app Perm_app_rev NoDup_incl_Perm NoDup_incl_each_Perm count_occ_Add_eq count_occ_Add_neq Perm__count_occ count_occ__Perm.
Hint Resolve partition_Perm filter_app_Perm fold_right_Perm filter_Add1 filter_Add2 filter_Perm filter_Forall filter_None filter_ord filter_and.
Hint Resolve filter_app filter_NoDup filter_equiv dec2b_true dec2b_false Rpair_list Forall_imp Forall_incl.
Hint Resolve NoDup_incl_length NoDup_map_inv NoDup_map NoDup_flat_map NoDup_repeat NoDup_Perm NoDup_app_rev map_Add Perm_map Perm_map_inv filter_map flat_map_app Perm_flat_map map_repeat.
Hint Resolve incl_nil_l incl_l_nil remove_incl in_in_remove remove_In2 remove_In3 Tail_app Tail_app_rev Tail_In Disjoint_comm Disjoint_In1.
Hint Resolve count_occ_Add_eq count_occ_Add_neq Perm__count_occ count_occ__Perm nodup_Add1 nodup_Add2 nodup_Perm nodup_incl_min ForallR_Add_rev ForallR_Add ForallR_Perm NoRDup_Add_rev NoRDup_Add NoRDup_Perm NoRDup_app.
Hint Resolve Sorted_cons_rev Sorted_min_cons Sorted_Perm_uniq Sorted_app.
Hint Resolve all_pair_spec1 all_pair_spec2 ubound_Disjoint.
Hint Resolve MapR_app in_MapR_1 in_MapR_2 MapR_refl MapR_map MapR_map2 MapR_trans combine_MapR MapR_sym.
Hint Resolve incl_refl In_cons_l In_cons_r incl_cons incl_trans In_one.
Hint Resolve firstn_S skipn_S combine_app combine_cons maxl_le maxl_In Smaxl_lt Smaxl_lt2.


Require Export Ensembles.

Section PLANE.

Parameter Point : Set.

Axiom Oo Uu : Point.

Axiom DistinctOoUu : Oo <> Uu.

Definition Figure := Ensemble Point.

Definition SubFigure : Figure -> Figure -> Prop := Included Point.

Definition Unicity := fun (M: Point) (F : Figure) =>
	forall N : Point, F N -> M = N.

Inductive Superimposed (F1 F2 : Figure) : Prop :=
	 | SuperimposedDef :  SubFigure F1 F2 -> SubFigure F2 F1 -> Superimposed F1 F2.

End PLANE.


Inductive Exp_ : Type -> Type :=
| Lam : forall A, (A -> Exp_ A) -> Exp_ A
| App : forall A, Exp_ A -> Exp_ A -> Exp_ A
| Var : forall A, A -> Exp_ A.
Implicit Arguments Lam [A].
Implicit Arguments App [A].
Implicit Arguments Var [A].
Definition Exp := forall a, Exp_ a.

Inductive Ev : forall A B, Exp_ A -> Exp_ B :=
| eval_beta : forall A B (f : A -> Exp_ A) (t : Exp_ A),
  Ev A (Exp_ A) (App (Lam f) t) (f t).


Require Export projective_space_rank_axioms.
Require Export Omega.
Require Export matroids_properties.

Module RankProperties (DecPoints: FSetInterface.WS) (M: RankProjectiveSpace DecPoints).

Module Export Mat_Props := Matroid_Properties DecPoints M.

Module Export Matroid' := matroid_to_matroid' DecPoints M.

Export M.

(** We define the morphism to allow easier rewriting using setoids. *)

Lemma rk_compat:
  forall x x', Equal x x' ->
     rk x = rk x'.
Proof.
intros.
apply le_antisym;apply matroid2;firstorder.
Qed.

Add Morphism rk : rk_mor.
Proof.
 exact rk_compat.
Qed.

Lemma rk_singleton : forall p:Point, rk (singleton p)=1.
Proof.
intros.
assert (rk (singleton p)<= 1).
apply (rk_singleton_le);auto.
assert (rk (singleton p)>= 1).
apply (rk_singleton_ge);auto.
omega.
Qed.

Hint Resolve rk_couple_2 : rk.

Lemma rk_couple1 : forall p q:Point,~ p [==] q -> rk(couple p q)=2.
Proof.
intros.
assert (rk(couple p q)<=2).
apply (rk_couple_2).
assert (rk(couple p q)>=2).
apply (rk_couple_ge);auto.
omega.
Qed.

Lemma couple_rk2 : forall p q:Point, rk(couple p q)=1 -> p [==] q.
Proof.
intros.
elim (eq_point_dec p q);auto.
intro.
assert (rk(couple p q)=2).
apply rk_couple1;assumption.
rewrite H in H0.
assert False.
intuition.
intuition.
Qed.

Hint Resolve couple_rk2: rk.

Lemma rk_couple2 : forall p q:Point, p[==]q -> rk(couple p q)=1.
Proof.
intros.
setoid_replace (couple p q) with (singleton p).
apply (rk_singleton).
apply (couple_singleton_eq).
assumption.
Qed.

Lemma rk_couple_1 : forall p q, 1 <= rk (couple p q).
Proof.
intros.
elim (eq_point_dec p q).
intro.
rewrite rk_couple2.
omega.
assumption.
intro.
rewrite rk_couple1.
omega.
assumption.
Qed.

Hint Resolve rk_couple_1 : rk.

Lemma couple_rk1 : forall p q:Point, rk(couple p q)=2 -> ~ p [==] q.
Proof.
intros.
unfold not;intro.
assert (rk (couple p q) = 1).
setoid_replace (couple p q) with (singleton p).
apply rk_singleton.
apply (couple_singleton_eq).
assumption.
intuition.
Qed.

Lemma couple_rk_degen : forall p, rk (couple p p) = 2 -> False.
Proof.
intros.
assert (rk (couple p p) = 1).
setoid_replace (couple p p) with (singleton p).
apply rk_singleton.
fsetdecide.
intuition.
Qed.

Hint Resolve couple_rk_degen : rk.

Lemma eq_point_dec_rk : forall P Q,
{rk(couple P Q)=1}+{rk(couple P Q)=2}.
Proof.
intros.
elim (eq_point_dec P Q).
intro.
left.
setoid_replace P with Q.
apply rk_couple2.
reflexivity.
auto.
intro.
right.
apply rk_couple1;auto.
Qed.

Lemma base_points_distinct_1 : ~ P0 [==] P1.
Proof.
assert (T:=lower_dim).
unfold not;intro.
rewrite H in T.
setoid_replace (quadruple P1 P1 P2 P3) with (triple P1 P2 P3) in T by fsetdecide.
assert (rk (triple P1 P2 P3) <= 3).
apply rk_triple_le.
omega.
Qed.

Lemma base_points_distinct_2 : ~ P2 [==] P3.
Proof.
assert (T:=lower_dim).
unfold not;intro.
rewrite H in T.
setoid_replace (quadruple P0 P1 P3 P3) with (triple P0 P1 P3) in T by fsetdecide.
assert (rk (triple P0 P1 P3) <= 3).
apply rk_triple_le.
omega.
Qed.

Lemma rk_lemma_1 : forall A B P Q,
rk (couple A B) = 2 ->
rk (triple A B P) = 2 ->
rk (triple A B Q) = 2 ->
rk (quadruple A B P Q) = 2.
Proof.
intros.
assert (rk (union (triple A B P) (triple A B Q)) + rk (couple A B) <=
           rk (triple A B P) + rk (triple A B Q)).
apply (matroid3_useful (triple A B P) (triple A B Q) (couple A B)).
clear_all.
fsetdecide.

assert (rk (union (triple A B P) (triple A B Q)) <= 2).
omega.
setoid_replace (union (triple A B P) (triple A B Q)) with (quadruple A B P Q) in H3 by fsetdecide_no_hyps.
apply le_antisym.
auto.
cut (rk (couple A B) <= rk (quadruple A B P Q)).
omega.
apply matroid2.
fsetdecide_no_hyps.
Qed.

Ltac Collapse := match goal with
H: rk (couple ?A ?B) = 1 |- _ => let T := fresh in assert (T:=couple_rk2 A B H); clear H;subst
end.

Lemma col_trans : forall A B C D:Point,
rk (triple A C D)=2 -> rk (triple B C D)=2 -> rk (couple C D)=2 -> rk(triple A B C)<=2.
Proof.
intros A B C D HACD HBCD HCD.
elim (eq_point_dec_rk A B);intro.
Collapse.
rewrite H in *.
setoid_replace (triple B B C) with (couple B C).
apply rk_couple_2.
fsetdecide.
generalize (matroid3 (triple A C D) (triple B C D)).
rewrite HACD.
rewrite HBCD.
setoid_replace (inter (triple A  C D) (triple B C D)) with (couple C D).
rewrite HCD.
intros.
assert (rk (union (triple A C D) (triple B C D))<=2).
omega.
clear H.
assert (Hsubset : Subset (triple A B C) (union (triple A C D) (triple B C D))).
fsetdecide_no_hyps.
generalize (matroid2  (triple A B C) (union (triple A C D) (triple B C D)) Hsubset).
omega.

assert (~ (A [==] B)).
apply couple_rk1;auto.

clear HACD HBCD HCD b.
fsetdecide.
Qed.

Lemma rk_triple_ABC_couple_AB :  forall A B C, rk(triple A B C)=3 -> rk(couple A B)=2.
Proof.
intros A0 B0 C0 rABC0.
assert (rk(couple A0 B0)=1\/rk(couple A0 B0)=2).
assert (rk (couple A0 B0) <= 2).
apply (rk_couple_2 A0 B0).
assert (1 <= rk (couple A0 B0)).
apply (rk_couple_1 A0 B0).
omega.
elim H.
2:auto.
intros H'.
rewrite (couple_rk2 A0 B0 H') in rABC0.
setoid_replace (triple B0 B0 C0) with (couple B0 C0) in rABC0 by fsetdecide.
assert (rk (couple B0 C0) <= 2).
apply (rk_couple_2 B0 C0).
omega.
Qed.

Lemma rk_triple_ABC_couple_BC :  forall A B C, rk(triple A B C)=3 -> rk(couple B C)=2.
Proof.
intros.
eapply rk_triple_ABC_couple_AB with (C:=A).
setoid_replace (triple B C A) with (triple A B C) by fsetdecide.
assumption.
Qed.

Lemma rk_triple_ABC_couple_AC :  forall A B C, rk(triple A B C)=3 -> rk(couple A C)=2.
Proof.
intros.
eapply rk_triple_ABC_couple_AB with (C:=B).
setoid_replace (triple A C B) with (triple A B C) by fsetdecide.
assumption.
Qed.

Hint Resolve rk_triple_ABC_couple_AB rk_triple_ABC_couple_BC rk_triple_ABC_couple_AC : rk.

Lemma rk_triple_singleton :forall (x y z a:Point),
rk(triple x y z)=3 /\ rk(couple x a)=2 /\ rk(triple y z a)=2
-> rk(union (triple x y z) (singleton a))=3.
Proof.
intros a b c alpha H.
elim H;clear H;intros rabc H.
elim H;clear H;intros ranalpha rbcalpha.

assert (rab : rk (couple a b) =2).
eauto with rk.
assert (rac : rk (couple a c) =2).
eauto with rk.
assert (rbc : rk (couple b c) =2).
eauto with rk.

apply le_antisym.
(* <= *)
assert (T: rk (union (triple a b c) (triple b c alpha)) + rk (couple b c) <=
    rk (triple a b c) + rk (triple b c alpha)).
apply (matroid3_useful (triple a b c) (triple b c alpha) (couple b c)).
fsetdecide_no_hyps.
setoid_replace  (union (triple a b c) (triple b c alpha))
                 with (union (triple a b c) (singleton alpha)) in T by fsetdecide_no_hyps.
omega.

(* >= *)
assert (Hsubset : (Subset (triple a b c) (union (triple a b c) (singleton alpha)))) by fsetdecide_no_hyps.
generalize (matroid2 (triple a b c) (union (triple a b c) (singleton alpha)) Hsubset).
rewrite rabc.
auto.
Qed.

Hint Resolve  rk_triple_singleton : rk.

Lemma rk_couple_not_zero : forall A B, (rk (couple A B) = 0) -> False.
Proof.
unfold not; intros.
elim (eq_point_dec A B);intros.
generalize (rk_couple2 A B).
intuition.
generalize (rk_couple1 A B).
intuition.
Qed.

Hint Resolve rk_couple_not_zero : rk.

Ltac simplify_rk := match goal with
| H: rk (couple ?A ?B) = 1 |- _ =>
      let id := fresh in
           assert (id: A [==] B);
           try (apply (couple_rk2 A B H));
           subst;clear H
| H :rk (couple ?A ?B) = 0 |- _ =>
           assert False;
           try apply (rk_couple_not_zero A B);
           intuition
| H : rk (couple ?A ?A) = 2 |- _ =>
           assert False;
           try apply (couple_rk_degen A);
           intuition
 end.

Ltac smart_subst := repeat (progress subst); try simplify_rk.

Lemma sym : forall A B:Point, A<>B->B<>A.
Proof.
auto.
Qed.

Lemma L1beta_gen : forall A B C beta,
rk(triple A C beta) = 2  ->
rk (triple A B C) = 3 ->
rk(union (triple A B C) (singleton beta))=3.
Proof.
intros  A B C beta.
intro rACbeta.
intro rABC.
apply le_antisym.
assert (T : rk (union (triple A B C) (triple A C beta)) + rk (couple A C) <=
       rk (triple A B C) + rk (triple A C beta)).
apply (matroid3_useful (triple A B C) (triple A C beta) (couple A C)).
fsetdecide_no_hyps.
setoid_replace (union(triple A B C)(triple A C beta)) with (union(triple A B C)(singleton beta)) in T by fsetdecide_no_hyps.
assert (HrAC : rk (couple A C) = 2) by eauto with rk.
omega.

(*>=*)
assert( Hsubset : (Subset (triple A B C) (union (triple A B C) (singleton beta)))).
fsetdecide_no_hyps.
generalize (matroid2 (triple A B C) (union (triple A B C) (singleton beta)) Hsubset).
rewrite rABC.
auto.
Qed.

Lemma L1gamma_gen : forall A B C gamma,
rk (triple A B C) = 3 ->
rk (triple A B gamma) = 2 ->
rk(union (triple A B C) (singleton gamma))=3.
Proof.
intros.
setoid_replace (union (triple A B C) (singleton gamma))
with (union (triple A C B) (singleton gamma)) by fsetdecide_no_hyps.
apply L1beta_gen.
assumption.
setoid_replace (triple A B C) with (triple A C B) in H by fsetdecide_no_hyps.
assumption.
Qed.

Lemma coplanar : forall O A B C A' B' C' : Point,
rk (triple A B C ) = 3 ->
rk (couple A' B) = 2 ->
rk (couple C' B) = 2 ->
rk (couple A B') = 2 ->
rk (couple B' C) = 2 ->
rk (triple A' B' C' ) = 3 ->
rk (triple O B B')  = 2 ->
rk (union (couple O A) (triple C A' C')) = 2 ->
rk (union (triple A B C) (triple A' B' C')) <> 4.
Proof.
intros O A B C A' B' C'.
intro rABC.
intro rA'B.
intro rC'B.
intro rAB'.
intro rB'C.
intro rA'B'C'.
intro rOBB'.
intro rOACA'C'.
unfold not.
intro.
assert (T: rk (union (triple O B B') (union (couple O A) (triple C A' C'))) +
      rk (singleton O) <=
      rk (triple O B B') + rk (union (couple O A) (triple C A' C'))).
apply (matroid3_useful  (triple O B B') (union (couple O A) (triple C A' C')) (singleton O)).
fsetdecide.
rewrite rOBB' in T.
rewrite rOACA'C' in T.
rewrite rk_singleton in T.
assert (rk (union (triple A B C) (triple A' B' C')) <=
    rk (union (singleton O) (union (triple A B C) (triple A' B' C')))).
apply matroid2.
fsetdecide.
setoid_replace ((union (singleton O) (union (triple A B C) (triple A' B' C')))) with (union (triple O B B') (union (couple O A) (triple C A' C'))) in H0.
omega.
unfold Equal; split; fsetdecide_no_hyps.
Qed.

Lemma rk_quadruple_ABCD_couple_AB :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(couple A B)=2.
Proof.
intros A0 B0 C0 D0 rABCD0.
assert (rk(couple A0 B0)=1\/rk(couple A0 B0)=2).

assert (rk (couple A0 B0) <= 2).
apply (rk_couple_2 A0 B0).
assert (1 <= rk (couple A0 B0)).
apply (rk_couple_1 A0 B0).
omega.
elim H.
2:auto.
intros H'.
rewrite (couple_rk2 A0 B0 H') in rABCD0.
setoid_replace (add D0 (triple B0 B0 C0)) with (triple B0 C0 D0) in rABCD0 by fsetdecide_no_hyps.
assert (rk (triple B0 C0 D0) <= 3) by apply (rk_triple_le B0 C0 D0).
omega.
Qed.

Lemma rk_quadruple_ABCD_couple_AC :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(couple A C)=2.
Proof.
intros A0 B0 C0 D0 rABCD0.
eapply (rk_quadruple_ABCD_couple_AB A0 C0 B0 D0).
setoid_replace (add D0 (triple A0 C0 B0)) with (add D0 (triple A0 B0 C0)) by fsetdecide.
assumption.
Qed.

Lemma rk_quadruple_ABCD_couple_AD :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(couple A D)=2.
Proof.
intros A0 B0 C0 D0 rABCD0.
eapply (rk_quadruple_ABCD_couple_AB A0 D0 B0 C0).
setoid_replace (add C0 (triple A0 D0 B0)) with (add D0 (triple A0 B0 C0)) by fsetdecide_no_hyps.
assumption.
Qed.

Lemma rk_quadruple_ABCD_couple_BC :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(couple B C)=2.
Proof.
intros A0 B0 C0 D0 rABCD0.
eapply (rk_quadruple_ABCD_couple_AB B0 C0 D0 A0).
setoid_replace (add D0 (triple A0 B0 C0)) with (add A0 (triple B0 C0 D0)) in rABCD0 by fsetdecide_no_hyps.
assumption.
Qed.

Lemma rk_quadruple_ABCD_couple_BD :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(couple B D)=2.
Proof.
intros A0 B0 C0 D0 rABCD0.
eapply (rk_quadruple_ABCD_couple_AB B0 D0 C0 A0).
setoid_replace (add A0 (triple B0 D0 C0)) with (add D0 (triple A0 B0 C0)) by fsetdecide_no_hyps.
assumption.
Qed.

Lemma rk_quadruple_ABCD_couple_CD :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(couple C D)=2.
Proof.
intros A0 B0 C0 D0 rABCD0.
eapply (rk_quadruple_ABCD_couple_AB C0 D0 A0 B0).
setoid_replace (add B0 (triple C0 D0 A0)) with (add D0 (triple A0 B0 C0)) by fsetdecide_no_hyps.
assumption.
Qed.

Lemma rk_quadruple_ABCD_triple_ABC :
forall A B C D, rk(add D (triple A B C))>=4 -> rk(triple A B C)=3.
Proof.
intros A0 B0 C0 D0 rABCD0.
apply le_antisym.
apply rk_triple_le.
assert (rk (triple A0 B0 C0) <=
             rk (add D0 (triple A0 B0 C0)) <=
             rk (triple A0 B0 C0) + 1).
apply matroid2';auto.
intuition.
Qed.

Lemma intersecting_lines_rank_3 : forall A B C D I,
rk (triple A B I) <= 2 ->
rk (triple C D I) <= 2 ->
rk (union (singleton I) (quadruple A B C D)) <= 3.
Proof.
intros.
assert (rk (union (triple A B I) (triple C D I)) +
       rk (singleton I) <=
       rk (triple A B I) + rk (triple C D I)).
apply (matroid3_useful (triple A B I) (triple C D I) (singleton I)).
fsetdecide.
rewrite rk_singleton in H1.
setoid_replace (union (triple A B I) (triple C D I))
with (union (singleton I) (quadruple A B C D)) in H1.
omega.
unfold Equal; split; fsetdecide_no_hyps.
Qed.

(** Uniqueness of inter *)
Lemma uniq_inter :
forall A B C D M P,
rk(couple A B)=2 ->
rk(couple C D) = 2 ->
rk(triple A B M) <= 2 ->
rk(triple C D M) <= 2 ->
rk(triple A B P) <= 2 ->
rk(triple C D P) <= 2 ->
rk(quadruple A B C D) >= 3 ->
rk(couple M P) = 1.
Proof.
intros A B C D M P rAB rCD rABM rCDM rABP rCDP rABCD.
apply le_antisym.

assert (rk(add P (triple A B M))<=2).
generalize (matroid3 (triple A B M) (triple A B P)).
setoid_replace (union (triple A B M) (triple A B P))
with (add P (triple A B M)) by fsetdecide_no_hyps.
assert (rk (inter (triple A B M) (triple A B P))>=rk(couple A B)).
apply matroid2.
fsetdecide_no_hyps.
omega.
assert (rk(add P (triple C D M))<=2).
generalize (matroid3 (triple C D M) (triple C  D P)).
setoid_replace (union (triple C D M) (triple C D P))
with (add P (triple C D M)) by fsetdecide_no_hyps.
assert (rk (inter (triple C D M) (triple C D P))>=rk(couple C D)).
apply matroid2.
fsetdecide_no_hyps.
omega.
assert(rk(union (triple A B C) (triple D M P))>=3).
assert(rk (quadruple A B C D) <= 3).
assert (rk (union (singleton M) (quadruple A B C D)) <= 3).
apply (intersecting_lines_rank_3 A B C D M);auto.
assert (rk (quadruple A B C D) <=
       rk (union (singleton M) (quadruple A B C D))).
apply matroid2.
fsetdecide_no_hyps.
omega.
assert (rABCD' : rk (quadruple A B C D) = 3).
omega.
rewrite <- rABCD'.
apply matroid2.
fsetdecide_no_hyps.

generalize (matroid3 (add P (triple A B M))  (add P (triple C D M))).
setoid_replace (union (add P (triple A B M)) (add P (triple C D M))) with
(union (triple A B C) (triple D M P)) by (unfold Equal; split; fsetdecide_no_hyps).
assert (rk((inter (add P (triple A B M)) (add P (triple C D M))))>=rk(couple M P)).
apply matroid2.
fsetdecide_no_hyps.
omega.
apply rk_couple_1.
Qed.

Lemma uniq_inter_spec : forall gamma a b B,
rk (triple a b gamma) <= 2 ->
rk (triple a B gamma) <= 2 ->
rk (triple a b B) >= 3 ->
rk (couple a gamma) = 1.
Proof.
intros.
elim (eq_point_dec_rk a gamma);intro.
auto.
assert (rk (union (triple a b gamma) (triple a B gamma)) + rk (couple a gamma) <=
       rk (triple a b gamma) + rk (triple a B gamma)).
apply matroid3_useful.
fsetdecide_no_hyps.
rewrite b0 in H2.
assert (rk (quadruple a b B gamma) <= 2).
setoid_replace (quadruple a b B gamma) with  (union (triple a b gamma) (triple a B gamma)) by fsetdecide_no_hyps.
omega.
assert (rk (triple a b B)  <= rk (quadruple a b B gamma)).
apply matroid2.
fsetdecide_no_hyps.
omega.
Qed.

Lemma uniq_inter_spec_bis : forall gamma a b B,
rk (triple a b gamma) <= 2 ->
rk (triple a B gamma) <= 2 ->
rk (couple a gamma) = 1 \/  rk (triple a b B) <= 2.
Proof.
intros.
assert (rk (triple a b B) <= 2 \/ rk (triple a b B) >= 3).
omega.
elim H1;intro.
right; auto.
left.
eapply (uniq_inter_spec).
apply H.
apply H0.
auto.
Qed.

Lemma stays_in_plane : forall E a b x, rk(E)<=3 -> In a E -> In b E ->
rk(couple a b)=2->
rk(triple a b x)=2 ->
rk(add x E)<=3.
Proof.
intros E m n x.
intros.
generalize (matroid3 E (triple m n x)).
assert (rk (union E (triple m n x))>=rk (add x E)).
apply matroid2; fsetdecide_no_hyps.
assert (rk(inter E (triple m n x))>=rk(couple m n)).
apply matroid2.
clear H2 H3 H4; fsetdecide.
omega.
Qed.

Lemma stays_in_the_plane : forall M N P Q,
rk(triple M N P) = 3 -> rk(triple M N Q) = 2 -> rk(add Q (triple M N P)) = 3.
Proof.
intros M N P Q rMNP rMNQ.
assert (rk(couple M N) = 2).
eapply rk_triple_ABC_couple_AB.
eassumption.
apply le_antisym.
generalize (matroid3 (triple M N P) (triple M N Q)).
setoid_replace (union (triple M N P) (triple M N Q))
with (add Q (triple M N P)) by fsetdecide_no_hyps.
assert (rk(inter (triple M N P) (triple M N Q))>=rk(couple M N))
by (apply matroid2;fsetdecide_no_hyps).
omega.
rewrite <- rMNP.
apply matroid2;fsetdecide_no_hyps.
Qed.

(** How to remove a point from a flat of 4 points whose rank is 3 ? *)
Lemma rk2_3 : forall P Q R S,
rk(add S (triple P Q R))=3->
rk(triple P Q R)=2->
rk(couple P Q)=2 ->
rk(couple R S)=2 ->
rk(triple P Q S)=3.
Proof.
intros X Y Z T HXYZT HXYZ HXY HZT.
apply le_antisym.
apply rk_triple_le.
generalize (matroid3 (triple X Y Z) (triple X Y T)).
setoid_replace (union (triple X Y Z) (triple X Y T)) with (add T (triple X Y Z))
by fsetdecide_no_hyps.
rewrite HXYZT.
assert (rk  (inter (triple X Y Z) (triple X Y T))>=rk (couple X Y))
  by (apply matroid2; fsetdecide_no_hyps).
omega.
Qed.

(** changing one of the points defining a plane in a 3D figure *)
Lemma rk3_4 : forall A B C M P,
rk(add M (triple A B C)) = 3 ->
rk(triple B C M) = 3 ->
rk(add P (triple A B C)) >= 4 ->
rk(add P (triple M B C)) >= 4.
Proof.
intros A B C M P rABCM rBCM rABCP.
generalize (matroid3 (add P (triple M B C)) (add M (triple A B C))).
setoid_replace  (union (add P (triple M B C)) (add M (triple A B C))) with
(union (triple A B C) (couple M P)) by (unfold Equal; split; fsetdecide_no_hyps).
assert  (rk (inter (add  P (triple M B C)) (add M (triple A B C)))>= rk (triple B C M)).
apply matroid2; fsetdecide_no_hyps.
assert (rk(union (triple A B C) (couple M P)) >= rk(add P (triple A B C)))
by (apply matroid2;fsetdecide_no_hyps).
omega.
Qed.

Lemma rank_not_empty : forall E, (exists x, In x E) -> rk E > 0.
Proof.
intros.
elim H; intros x H1; clear H.
assert (Subset (singleton x) E) by fsetdecide.
assert (rk (singleton x) <= rk E) by (apply matroid2; fsetdecide).
rewrite rk_singleton in H0.
omega.
Qed.

Lemma double_flag : forall  x A B,
rk (add x A) <= 2 ->
rk (add x B) <= 2 ->
rk (add x (union A B)) <= 3.
Proof.
intros.
assert (rk (union (add x A) (add x B)) + rk (singleton x) <=
       rk (add x A) + rk (add x B)).
apply (matroid3_useful).
fsetdecide.
rewrite rk_singleton in H1.
setoid_replace (add x (union A B))  with (union (add x A) (add x B)) by fsetdecide.
omega.
Qed.

Lemma matroid3' :
 forall X y z, rk (add y X) = rk (add z X) -> rk (add z X) = rk X -> rk X =
  rk (union X (couple y z)).
Proof. exact matroid3'. Qed.

Lemma construction :
 forall n , forall E, rk E = n -> n<=3 -> exists P, rk (add P E) = n+1.
Proof.
intros.
assert (T:=lower_dim).
assert (rk (quadruple P0 P1 P2 P3) = 4).
apply le_antisym.
apply rk_quadruple_le.
auto.
clear H1.
assert (n=0 \/ n=1 \/ n=2 \/ n=3) by omega.

(** Case n=0 *)
intuition.
subst.
rewrite H2.
assert (rk (add P0 E) = 0 \/ rk (add P0 E) = 1).
assert (rk E <= rk (add P0 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P1 E) = 0 \/ rk (add P1 E) = 1).
assert (rk E <= rk (add P1 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P2 E) = 0 \/ rk (add P2 E) = 1).
assert (rk E <= rk (add P2 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P3 E) = 0 \/ rk (add P3 E) = 1).
assert (rk E <= rk (add P3 E) <= rk E + 1) by apply matroid2'.
omega.

elim H;intro;[idtac|firstorder];clear H.
elim H1;intro;[idtac|firstorder];clear H1.
elim H3;intro;[idtac|firstorder];clear H3.
elim H4;intro;[idtac|firstorder];clear H4.
assert (rk E = rk (union E (couple P0 P1))).
eapply matroid3'; congruence.

rewrite H2 in H4.
assert (rk (couple P0 P1) <= rk  (union E (couple P0 P1))).
apply matroid2;fsetdecide.
assert (rk (couple P0 P1) <= 0) by omega.
assert (rk (couple P0 P1) >= 1).
apply rk_couple_1.
cut False;intuition.

(** Case n=1 *)
subst.
rewrite H1.
assert (rk (add P0 E) = 1 \/ rk (add P0 E) = 2).
assert (rk E <= rk (add P0 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P1 E) = 1 \/ rk (add P1 E) = 2).
assert (rk E <= rk (add P1 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P2 E) = 1 \/ rk (add P2 E) = 2).
assert (rk E <= rk (add P2 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P3 E) = 1 \/ rk (add P3 E) = 2).
assert (rk E <= rk (add P3 E) <= rk E + 1) by apply matroid2'.
omega.
elim H;intro;[idtac|firstorder];clear H.
elim H3;intro;[idtac|firstorder];clear H3.
elim H2;intro;[idtac|firstorder];clear H2.
elim H4;intro;[idtac|firstorder];clear H4.
assert (rk E = rk (union E (couple P0 P1))).
eapply matroid3'; congruence.

assert (rk E = rk (union E (couple P2 P3))).
apply matroid3'; congruence.

assert (rk (union E (union (couple P0 P1) (couple P2 P3))) =rk E).
apply (matroid3'_gen E (couple P0 P1) (couple P2 P3));symmetry;auto.
rewrite H1 in H7.
assert (rk (quadruple P0 P1 P2 P3) <= rk (union E (union (couple P0 P1) (couple P2 P3)))).
apply (matroid2).
fsetdecide_no_hyps.
cut False;intuition.

subst.
rewrite H2.
assert (rk (add P0 E) = 2 \/ rk (add P0 E) = 3).
assert (rk E <= rk (add P0 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P1 E) = 2 \/ rk (add P1 E) = 3).
assert (rk E <= rk (add P1 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P2 E) = 2 \/ rk (add P2 E) = 3).
assert (rk E <= rk (add P2 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P3 E) = 2 \/ rk (add P3 E) = 3).
assert (rk E <= rk (add P3 E) <= rk E + 1) by apply matroid2'.
omega.
elim H;intro;[idtac|firstorder];clear H.
elim H1;intro;[idtac|firstorder];clear H1.
elim H3;intro;[idtac|firstorder];clear H3.
elim H4;intro;[idtac|firstorder];clear H4.

assert (rk E = rk (union E (couple P0 P1))).
eapply matroid3'; congruence.

assert (rk E = rk (union E (couple P2 P3))).
apply matroid3'; congruence.

assert (rk (union E (union (couple P0 P1) (couple P2 P3))) =rk E).
apply (matroid3'_gen E (couple P0 P1) (couple P2 P3));symmetry;auto.
rewrite H2 in H7.
assert (rk (quadruple P0 P1 P2 P3) <= rk (union E (union (couple P0 P1) (couple P2 P3)))).
apply (matroid2).
fsetdecide_no_hyps.
cut False;intuition.

subst.
rewrite H2.
assert (rk (add P0 E) = 3 \/ rk (add P0 E) = 4).
assert (rk E <= rk (add P0 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P1 E) = 3 \/ rk (add P1 E) = 4).
assert (rk E <= rk (add P1 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P2 E) = 3 \/ rk (add P2 E) = 4).
assert (rk E <= rk (add P2 E) <= rk E + 1) by apply matroid2'.
omega.
assert (rk (add P3 E) = 3 \/ rk (add P3 E) = 4).
assert (rk E <= rk (add P3 E) <= rk E + 1) by apply matroid2'.
omega.
elim H;intro;[idtac|firstorder];clear H.
elim H1;intro;[idtac|firstorder];clear H1.
elim H3;intro;[idtac|firstorder];clear H3.
elim H4;intro;[idtac|firstorder];clear H4.

assert (rk E = rk (union E (couple P0 P1))).
apply matroid3'; congruence.

assert (rk E = rk (union E (couple P2 P3))).
apply matroid3'; congruence.

assert (rk (union E (union (couple P0 P1) (couple P2 P3))) =rk E).
apply (matroid3'_gen E (couple P0 P1) (couple P2 P3));symmetry;auto.
rewrite H2 in H7.
assert (rk (quadruple P0 P1 P2 P3) <= rk (union E (union (couple P0 P1) (couple P2 P3)))).
apply (matroid2).
fsetdecide_no_hyps.
cut False;intuition.
Qed.

End RankProperties.


Require Import Problem.

Theorem solution : task.
Proof.
  unfold task.
  intros.
  remember (f true) as x; remember (f false) as y.
  destruct b; destruct x; destruct y.
  all: repeat (try rewrite <- Heqx; try rewrite <- Heqy); auto.
Qed.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.
From QuickChick Require Import QuickChick.
Inductive natural : Type := Succ : natural -> natural |  Zero : natural.
Derive Show for natural. Derive Arbitrary for natural.  Instance Dec_Eq_natural : Dec_Eq natural. Proof. dec_eq. Qed.
Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) : lst
           := match append_arg0, append_arg1 with
              | Nil, x => x
              | Cons x y, z => Cons x (append y z)
              end.

Fixpoint rev (rev_arg0 : lst) : lst
           := match rev_arg0 with
              | Nil => Nil
              | Cons x y => append (rev y) (Cons x Nil)
              end.

Fixpoint qreva (qreva_arg0 : lst) (qreva_arg1 : lst) : lst
           := match qreva_arg0, qreva_arg1 with
              | Nil, x => x
              | Cons z x, y => qreva x (Cons z y)
              end.

Fixpoint revflat (revflat_arg0 : tree) : lst
           := match revflat_arg0 with
              | Leaf => Nil
              | Node d l r => append (revflat l) (Cons d (revflat r))
              end.

Fixpoint qrevaflat (qrevaflat_arg0 : tree) (qrevaflat_arg1 : lst) : lst
           := match qrevaflat_arg0, qrevaflat_arg1 with
              | Leaf, x => x
              | Node d l r, x => qrevaflat l (Cons d (qrevaflat r x))
              end.

Theorem append_nil: forall (l: lst), append l Nil = l.
Proof.
   induction l.
   { simpl. f_equal. assumption. }
   { simpl. reflexivity. }
Qed.

Theorem append_assoc:
   forall (l1 l2 l3: lst), append l1 (append l2 l3) = append (append l1 l2) l3.
Proof.
   induction l1; induction l2; induction l3; try (simpl; reflexivity).
   { simpl. rewrite <- IHl1. f_equal. }
   { simpl. rewrite 2 append_nil. reflexivity. }
   { simpl. rewrite append_nil.  reflexivity. }
   { simpl. rewrite 2 append_nil. reflexivity. }
Qed.

Theorem qrevflat_append: forall (x : tree) (y: lst), append (revflat x) y = qrevaflat x y.
Proof.
   induction x; induction y; simpl; try reflexivity.
   { rewrite <- IHx1.
   rewrite <- append_assoc.
   f_equal.
   simpl.
   rewrite IHx2.
   reflexivity.
   }
   {
   rewrite append_nil.
   rewrite <- IHx1.
   f_equal.
   f_equal.
   rewrite <- IHx2.
   lfind. Admitted.