Library Subsets.Finite_family

This file is part of the Coq Numerical Analysis library
Copyright (C) Boldo, Clément, Martin, Mayero, Mouhcine
This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the COPYING file for more details.

Brief description

Support for finite families.

Description

Finite families are functions from some ordinal type 'I_n to any type E. For instance, they can represent vectors. But the present module only provides results related to the finite nature of ordinals, no algebraic structure is assumed on the support type E.

Additional notation

  • 'E^n is for 'I_n E, for any type E.

Support for operations on finite families

Naming rules:
  • functions having finite families as input and/or output have a name with suffix "F", eg notF, eqPF, castF and mapF;
  • predicates stating a universally quantified property have a name with suffix "AF", eg PAF, neqAF, iffAF;
  • predicates stating a existentially quantified property have a name with suffix "EF", eg PEF, eqEF;
  • functions involving a predicate on an ordinal type have a name with suffix "PF", eg eqPF, extendPF, filterPF.
Let E be any type. Let PE be a subset of E. Let x, x0, x1 and x2 be in E. Let A and B be families of n items of E, a.k.a. n-families (of E). Let A1 and A2 respectively be an n1-family and an n2-family.

Constructors

  • constF n x is the n-family with all items equal to x.
  • singleF x0 is the 1-family with only item x0.
  • coupleF x0 x1 is the 2-family with only items x0 and x1, in that order.
  • tripleF x0 x1 x2 is the 3-family with only items x0, x1 and x2, in that order.

Predicates

Let P be a predicate on 'I_n, ie a subset of 'I_n.
  • PAF P states that P i holds for all i.
  • PEF P states that there exists some i such that P i holds.
Let Q also be a predicate on 'I_n.
  • notF P is the complementary predicate of P, ie associating ¬ P i to each i.
  • andF P Q is the intersection predicate of P and Q, ie associating P i Q i to each i.
  • orF P Q is the union predicate of P and Q, ie associating P i Q i to each i.
  • impF P Q associates P i Q i to each i.
  • iffF P Q associates P i Q i to each i.
Let R be a binary relation on E.
  • brAF R A B states that R (A i) (B i) holds for all i.
  • brEF R A B states that there exists some i such that R (A i) (B i) holds.
  • eqAF and eqEF are the specializations of brAF and brEF for equality.
  • neqAF and neqEF are the specializations of brAF and brEF for the negation of equality.
  • same_funF is the specialization of brAF for extensional equality of functions.
  • eqF A x associates equality A i = x to each i.
  • neqF A x associates inequality A i x to each i.
  • inF x A states that x is some item of A.
  • inclF A PE states that all items of A belong to PE.
  • invalF A1 A2 states that all items of A1 appear in A2. Warning: in the presence of doubles in A1, we may have invalF A1 A2 with n2 < n1.
  • eqPF P A B states that A and B are equal when P holds.
  • neqPF P A B states that there exists some i such that A i and B i are distinct and P i holds.
  • eqxF A B i0 states that A and B are equal except for item i0.
  • neqxF A B i0 states that there exists some i distinct from i0 such that A i and B i are distinct.
  • eqx2F A B i0 i1 states that A and B are equal except for items i0 and i1.
  • neqx2F A B i0 i1 states that there exists some i distinct from i0 and i1 such that A i and B i are distinct.
Let P1 and P2 be predicates on 'I_n1 and 'I_n2. Let f be a function from 'I_n1 to 'I_n2.
  • extendPF f P1 P2 states that either ordinal i2 : 'I_n2 is in the range of f (ie, there exists some i1 such that f i1 = i2) and equality P1 i1 = P2 i2 holds, or ¬ P2 i2 holds.

Operators

Let f be a function from 'I_n1 to 'I_n2.
  • funF f A2 is the n1-family of values of A2 on f 'I_n1, in the same order.
  • unfunF f A1 x is the n2-family with values of A1 on f 'I_n1, in the same order, and x elsewhere.
Let P be a predicate on 'I_n.
  • maskPF P A x is the n-family with values of A when P holds and x otherwise, in the same order.
Let H be a proof of n1 = n2.
  • castF H A1 is the n2-family made of the items of A1, in the same order.
Let B be an n.+1-family.
  • widenF_S B is the n-family made of the items of B, in the same order, except the last one.
  • liftF_S B is the n-family made of the items of B, in the same order, except the first one.
Let H be a proof of n1 n2.
  • widenF H A2 is the n1-family made of the n1 first items of A2, in the same order.
Let A12 be an (n1+n2)-family.
  • firstF A12 is the n1-family made of the n1 first items of A12, in the same order.
  • lastF A12 is the n2-family made of the n2 last items of A12, in the same order.
  • concatF A1 A2 is the (n1+n2)-family with items of A1, then items of A2, in the same order.
  • insertF A x0 i0 is the n.+1-family made of the n items of A, in the same order, and x0 inserted as the i0-th item.
Let B be an n.+1-family.
  • skipF B i0 is the n-family made of the items of B, in the same order, except the i0-th.
Let H be a proof of i1 i0.
  • insert2F A x0 x1 H is the n.+2-family made of the n items of A, in the same order, x0 inserted as the i0-th item, and x1 inserted as the i1-th item.
Let C be an n.+2-family.
  • skip2F C H is the n-family made of the items of C, in the same order, except the i0-th and the i1-th.
  • replaceF A x0 i0 is the n-family made of the items of A, in the same order, except that the i0-th item is replaced by x0.
  • replace2F A x0 x1 i0 i1 is the n-family made of the items of A, in the same order, except that the i0-th item is replaced by x0, and the i1-th is replaced by x1.
Let p : 'I_[n].
  • permutF p A is the n-family made of items A (p 0), A (p 1),..., and A (p n-1).
  • revF A is the reversed n-family made of items A (n-1), A (n-2),..., A 1, A 0.
Let B be an n.+1-family.
  • moveF B i0 i1 is the n.+1-family made of items of B, in the same order, except that i0-th item is moved to i1-th slot.
  • transpF A i0 i1 is the n-family made of items of A, in the same order, except that i0-th and i1-th items are exchanged.
Let P be a predicate on 'I_n.
Let F be any type. Let f : E F and fi : 'I_n E F be functions.
  • mapF f A is the n-family made of the images by f of items of A, in the same order.
  • mapiF fi A is the n-family made of items f 0 (A 0), f 1 (A 1),..., and f (n-1) (A (n-1)).
Let G be any type. Let f : E F G be a function. Let A B be n-families.
  • map2F f A B is the n-family made of the images by f of items of A and B, in the same order.
Let f be an n-family of functions F G. Let g : E F. Let f : F G. Let g be an n-family of functions E F. Let f be an n-family of functions F G. Let g be an n-family of functions E F.

Lexicographic orders

Lexicographic orders are generalizations, and variants, of the alphabetical order in dictionaries to finite families of any type.
Let T be any type. Let R : T T Prop be an homogeneous binary relation on T. Let n : nat.
  • lex R is the binary relation defined for all x y : 'T^n.+1 by R (x i) (y i) for the first index j such that x j y j, and lex R x y for all x y : 'T^0 iff R is relfexive.
  • colex R is the binary relation defined for all x y : 'T^n.+1 by R (x i) (y i) for the last index j such that x j y j, ie words of the dictionary are sorted from their last letter, and colex R x y for all x y : 'T^0 iff R is relfexive.
  • symlex R is the converse of lex R, ie it is defined for all x y : 'T^n.+1 by R (y i) (x i) for the first index j such that x j y j.
  • revlex R is the converse of colex R, ie it is defined for all x y : 'T^n.+1 by R (y i) (x i) for the last index j such that x j y j.

About the API

Definitions and statements are mainly plain-Coq compatible (ie use of Prop instead of bool).

Used logic axioms

Usage

This module may be used through the import of Subsets.Subsets, Subsets.Subsets_wDep, Algebra.Algebra_wDep, Lebesgue.Lebesgue_p_wDep, or Lebesgue.Bochner.Bochner_wDep, where it is exported.

From Requisite Require Import stdlib.

From Requisite Require Import ssr_wMC.
From mathcomp Require Import seq path.

From Numbers Require Import Numbers_wDep.
From Subsets Require Import Subset Subset_dec Subset_charac.
From Subsets Require Import Function Function_sub Sub_type.
From Subsets Require Import Binary_relation ord_compl.

Notation "''' E ^ n" := ('I_n E)
  (at level 8, E at level 2, n at level 2, format "''' E ^ n").

Section FF_Def0a.

Context {n : nat}.
Variable P Q : 'Prop^n.

The prefix "P" stands for Prop, "A" for and "E" for .
Definition PAF : Prop := i, P i.
Definition PEF : Prop := i, P i.

Definition notF : 'Prop^n := fun i¬ P i.
Definition andF : 'Prop^n := fun iP i Q i.
Definition orF : 'Prop^n := fun iP i Q i.
Definition impF : 'Prop^n := fun iP i Q i.
Definition iffF : 'Prop^n := fun iP i Q i.

End FF_Def0a.

Section FF_Def0b.

Context {n : nat}.
Variable P : 'Prop^n.

Lemma PF_dec : { PAF P } + { PEF (notF P) }.
Proof.
destruct (classic_dec (PAF P));
    [left | right; apply not_all_ex_not_equiv]; easy.
Qed.

Lemma PF_dec_l : (H : PAF P), PF_dec = left H.
Proof.
intros H1; destruct PF_dec as [H2 | H2].
f_equal; apply proof_irrel.
contradict H1; apply not_all_ex_not_equiv; easy.
Qed.

Lemma PF_dec_r : (H : PEF (notF P)), PF_dec = right H.
Proof.
intros H1; destruct PF_dec as [H2 | H2].
contradict H2; apply not_all_ex_not_equiv; easy.
f_equal; apply proof_irrel.
Qed.

End FF_Def0b.

Section FF_Def1a.

Context {E : Type}.
Variable R : E E Prop.

Context {n : nat}.
Variable A B : 'E^n.

The prefix "br" stands for "binary relation".
Definition brAF : Prop := PAF (fun iR (A i) (B i)).
Definition brEF : Prop := PEF (fun iR (A i) (B i)).

End FF_Def1a.

Section FF_Def1b.

Context {E F : Type}.
Variable R : E E Prop.

Context {n : nat}.
Variable A B : 'E^n.

Definition brF_dec : {brAF R A B} + {brEF (complementary R) A B} :=
  PF_dec (fun iR (A i) (B i)).

Lemma brF_dec_l : (H : brAF R A B), brF_dec = left H.
Proof. intros; apply PF_dec_l. Qed.

Lemma brF_dec_r : (H : brEF (complementary R) A B), brF_dec = right H.
Proof. intros; apply PF_dec_r. Qed.

Definition eqAF : Prop := brAF eq A B.
Definition eqEF : Prop := brEF eq A B.

Definition neqAF : Prop := brAF neq A B.
Definition neqEF : Prop := brEF neq A B.

Variable f g : '(E F)^n.

Definition same_funF : Prop := brAF same_fun f g.

End FF_Def1b.

Section FF_Facts0a.

Context {E : Type}.
Context {n : nat}.

Variable A B : 'E^n.

Lemma extF : eqAF A B A = B.
Proof. intros; apply fun_ext; easy. Qed.

Lemma extF_rev : A = B eqAF A B.
Proof. intros H; rewrite H; easy. Qed.

Lemma extF_compat : i j, i = j A i = A j.
Proof. move=>>; apply f_equal. Qed.

Lemma nextF : neqEF A B A B.
Proof. intros H1 H2; rewrite H2 in H1; destruct H1; easy. Qed.

Lemma nextF_rev : A B neqEF A B.
Proof.
intros H1; apply not_all_ex_not_equiv; intros H2; apply H1, extF; easy.
Qed.

Lemma nextF_reg : i j, A i A j i j.
Proof. move=>>; apply contra_not, extF_compat. Qed.

End FF_Facts0a.

Section FF_Facts0b.

Context {E F : Type}.
Context {n : nat}.

Variable f g : '(E F)^n.

Lemma fun_extF : same_funF f g f = g.
Proof. intros H; apply extF; intro; apply fun_ext, H. Qed.

End FF_Facts0b.

Section FF_Facts0c.

Context {E : Type}.

Lemma arg_min_ex :
   {n} (B : 'E^n) (i : 'I_n), (j : 'I_n),
    (j i)%coq_nat B j = B i
     (k : 'I_n), (k < j)%coq_nat B i B k.
Proof.
intros n B i.
induction n.
destruct i as (k,Hk); contradict Hk; easy.
case (classic (B i = B ord0)); intros H.
ord0; repeat split; try easy.
simpl; auto with arith.
assert (V1: (i < n.+1)%coq_nat).
destruct i as (m,Hm); simpl.
apply /leP; easy.
assert (V2: nat_of_ord i O).
intros K; apply H.
f_equal; apply ord_inj; easy.
assert (V: (i.-1 < n)%nat).
apply /leP; now auto with zarith.
destruct (IHn (fun jB (lift ord0 j)) (Ordinal V)) as (k,(Hk1,(Hk2,Hk3))).
simpl in Hk1.
(lift ord0 k); split; try split.
unfold lift, bump; simpl; now auto with zarith arith.
rewrite Hk2; f_equal.
apply lift_m1; try easy.
intros j Hj.
case (le_lt_dec j 0); intros Hj2.
replace j with (@ord0 n); try easy.
apply ord_inj; auto with arith.
assert (V3:(j < n.+1)%coq_nat).
destruct j as (j',Hj'); simpl.
apply /leP; easy.
assert (V': (j.-1 < n)%nat).
apply /leP; auto with zarith.
specialize (Hk3 (Ordinal V')).
rewrite (lift_m1 i) in Hk3; try easy.
rewrite (lift_m1 j) in Hk3; try easy.
2: now auto with zarith.
apply Hk3.
unfold lift in Hj; unfold bump in Hj; simpl in Hj; simpl.
apply PeanoNat.lt_S_n. rewrite Nat.succ_pred_pos; easy.
Qed.

End FF_Facts0c.

Section FF_ops_Def1.

Context {E F G : Type}.

Definition constF n (x : E) : 'E^n := fun _x.

Definition singleF (x0 : E) : 'E^1 := constF 1 x0.

Definition coupleF (x0 x1 : E) : 'E^2 :=
  fun imatch (ord2_dec i) with
    | left _x0
    | right _x1
    end.

Definition tripleF (x0 x1 x2 : E) : 'E^3 :=
  fun imatch (ord3_dec i) with
    | inleft Hmatch H with
      | left _x0
      | right _x1
      end
    | inright _x2
    end.

Definition eqF {n} (A : 'E^n) x i : Prop := A i = x.
Definition neqF {n} (A : 'E^n) x i : Prop := A i x.

Definition inF {n} x (A : 'E^n) : Prop := i, x = A i.

Definition inclF {n} (A : 'E^n) (PE : E Prop) : Prop := i, PE (A i).

Definition invalF {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2) : Prop :=
  inclF A1 (inF^~ A2).

Definition iffAF {n} (P Q : 'Prop^n) := i, P i Q i.

Definition eqPF {n} (P : 'Prop^n) (A B : 'E^n) : Prop :=
   i, P i A i = B i.
Definition neqPF {n} (P : 'Prop^n) (A B : 'E^n) : Prop :=
   i, P i A i B i.

Definition eqxF {n} (A B : 'E^n) i0 : Prop := eqPF (fun ii i0) A B.
Definition neqxF {n} (A B : 'E^n) i0 : Prop := neqPF (fun ii i0) A B.

Definition eqx2F {n} (A B : 'E^n) i0 i1 : Prop :=
  eqPF (fun ii i0 i i1) A B.
Definition neqx2F {n} (A B : 'E^n) i0 i1 : Prop :=
  neqPF (fun ii i0 i i1) A B.

Definition extendPF {n1 n2} (f : 'I_{n1,n2})
    (P1 : 'Prop^n1) (P2 : 'Prop^n2) : Prop :=
   i2, ( i1, f i1 = i2 P1 i1 = P2 i2) (¬ Rg f i2 ¬ P2 i2).

Definition funF {n1 n2} (f : 'I_{n1,n2}) (A2 : 'E^n2) : 'E^n1 :=
  fun i1A2 (f i1).

Definition unfunF {n1 n2} (f : 'I_{n1,n2}) (A1 : 'E^n1) (x0 : E) : 'E^n2 :=
  fun i2match im_dec f i2 with
    | inleft H1A1 (proj1_sig H1)
    | inright _x0
    end.

Definition maskPF {n} (P : 'Prop^n) (A : 'E^n) (x0 : E) : 'E^n :=
  fun imatch (classic_dec (P i)) with
    | left _A i
    | right _x0
    end.

Definition castF {n1 n2} (H : n1 = n2) (A1 : 'E^n1) : 'E^n2 :=
  fun i2A1 (cast_ord (eq_sym H) i2).

Definition castF_fun
    {T : Type} {n1 n2} (H : n1 = n2) (f1 : 'E^n1 T) : 'E^n2 T :=
  fun A2f1 (castF (eq_sym H) A2).

Definition cast2F_fun {T1 T2 : Type} {n1 n2} (H : n1 = n2)
    (F1 : ('E^n1 T1) T2) : ('E^n2 T1) T2 :=
  fun f2F1 (castF_fun (eq_sym H) f2).

Definition castF_p1S {n} (A : 'E^(n + 1)) : 'E^n.+1 := castF (addn1 n) A.
Definition castF_Sp1 {n} (A : 'E^n.+1) : 'E^(n + 1) := castF (addn1_sym n) A.
Definition castF_1pS {n} (A : 'E^(1 + n)) : 'E^n.+1 := castF (add1n n) A.
Definition castF_S1p {n} (A : 'E^n.+1) : 'E^(1 + n) := castF (add1n_sym n) A.

Definition castF_ipn {n} (i0 : 'I_n.+1) (A : 'E^(i0 + (n - i0))) : 'E^n :=
  castF (eq_sym (ord_split i0)) A.
Definition castF_nip {n} (A : 'E^n) (i0 : 'I_n.+1) : 'E^(i0 + (n - i0)) :=
  castF (ord_split i0) A.

Definition castF_ipS {n} (i0 : 'I_n.+1) (A : 'E^(i0 + (n - i0).+1)) : 'E^n.+1 :=
  castF (eq_sym (ord_splitS i0)) A.
Definition castF_Sip {n} (A : 'E^n.+1) (i0 : 'I_n.+1) : 'E^(i0 + (n - i0).+1) :=
  castF (ord_splitS i0) A.

Definition castF_SpS {n} (i0 : 'I_n.+1) (A : 'E^(i0.+1 + (n - i0))) : 'E^n.+1 :=
  castF (eq_sym (ordS_splitS i0)) A.
Definition castF_SSp {n} (A : 'E^n.+1) (i0 : 'I_n.+1) : 'E^(i0.+1 + (n - i0)) :=
  castF (ordS_splitS i0) A.

Definition widenF_S {n} (A : 'E^n.+1) : 'E^n := fun iA (widen_S i).
Definition liftF_S {n} (A : 'E^n.+1) : 'E^n := fun iA (lift_S i).

Definition widenF {n1 n2} (H : n1 n2) (A2 : 'E^n2) : 'E^n1 :=
  fun i1A2 (widen_ord H i1).

Definition firstF {n1 n2} (A : 'E^(n1 + n2)) : 'E^n1 :=
  fun i1A (first_ord n2 i1).

Definition lastF {n1 n2} (A : 'E^(n1 + n2)) : 'E^n2 :=
  fun i2A (last_ord n1 i2).

Definition concatF {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2) : 'E^(n1 + n2) :=
  fun imatch (lt_dec i n1) with
    | left HA1 (concat_l_ord H)
    | right HA2 (concat_r_ord H)
    end.

Definition insertF {n} (A : 'E^n) x0 (i0 : 'I_n.+1) : 'E^n.+1 :=
  fun imatch (ord_eq_dec i i0) with
    | left _x0
    | right HA (insert_ord H)
    end.

Definition insert2F
    {n} (A : 'E^n) x0 x1 {i0 i1 : 'I_n.+2} (H : i1 i0) : 'E^n.+2 :=
  fun imatch (ord_eq_dec i i0) with
    | left _x0
    | right H0match (ord_eq_dec i i1) with
      | left _x1
      | right H1A (insert2_ord H H0 H1)
      end
    end.

Definition skipF {n} (A : 'E^n.+1) i0 : 'E^n := fun jA (skip_ord i0 j).

Definition skip2F {n} (A : 'E^n.+2) {i0 i1 : 'I_n.+2} (H : i1 i0) : 'E^n :=
  fun jA (skip2_ord H j).

Definition replaceF {n} (A : 'E^n) x0 i0 : 'E^n :=
  fun imatch (ord_eq_dec i i0) with
    | left _x0
    | right _A i
    end.

Definition replace2F {n} (A : 'E^n) x0 x1 i0 i1 : 'E^n :=
  replaceF (replaceF A x0 i0) x1 i1.

Definition permutF {n} (p : 'I_[n]) (A : 'E^n) : 'E^n := fun iA (p i).
Definition revF {n} (A : 'E^n) : 'E^n := permutF (@rev_ord n) A.
Definition moveF {n} (A : 'E^n.+1) (i0 i1 : 'I_n.+1) : 'E^n.+1 :=
  permutF (move_ord i0 i1) A.
Definition transpF {n} (A : 'E^n) i0 i1 : 'E^n := permutF (transp_ord i0 i1) A.

Definition filterPF {n} (P : 'Prop^n) (A : 'E^n) : 'E^(lenPF P) :=
  fun jA (filterP_ord j).

Definition splitPF {n} (P : 'Prop^n) (A : 'E^n) :=
  concatF (filterPF P A) (filterPF (fun i¬ P i) A).

Definition mapiF {n} f (A : 'E^n) : 'F^n := fun if i (A i).
Definition mapF {n} f (A : 'E^n) : 'F^n := mapiF (fun f) A.

Definition map2F {n} f (A : 'E^n) (B : 'F^n) : 'G^n := fun if (A i) (B i).

End FF_ops_Def1.

Section FF_ops_Def2.

Context {E F G : Type}.

Definition compF_l {n} (f : '(F G)^n) (g : E F) : '(E G)^n :=
  mapF (comp^~ g) f.

Definition compF_r {n} (f : F G) (g : '(E F)^n) : '(E G)^n :=
  mapF (comp f) g.

Definition compF {n} (f : '(F G)^n) (g : '(E F)^n) : '(E G)^n :=
  map2F comp f g.

End FF_ops_Def2.

Section FF_ops_Def2.

Context {E : Type}.

Definition filter_eqF_gen {F : Type} {n} (A : 'E^n) (x0 : E) (B : 'F^n) :=
  filterPF (eqF A x0) B.

Definition filter_eqF {n} (A : 'E^n) (x0 : E) := filter_eqF_gen A x0 A.

Definition filter_neqF_gen {F : Type} {n} (A : 'E^n) (x0 : E) (B : 'F^n) :=
  filterPF (neqF A x0) B.

Definition filter_neqF {n} (A : 'E^n) (x0 : E) := filter_neqF_gen A x0 A.

Definition split_eqF_gen {F : Type} {n} (A : 'E^n) (x0 : E) (B : 'F^n) :=
  splitPF (eqF A x0) B.

Definition split_eqF {n} (A : 'E^n) (x0 : E) := split_eqF_gen A x0 A.

End FF_ops_Def2.

Section FF_ops_Facts0.

Correctness lemmas.

Context {E : Type}.

Lemma constF_correct : n (x : E) i, constF n x i = x.
Proof. easy. Qed.

Lemma singleF_0 : (x0 : E) i, singleF x0 i = x0.
Proof. easy. Qed.

Lemma singleF_correct : (A : 'E^1) i, A = singleF (A i).
Proof. intros; apply extF; intro; rewrite 2!I_1_is_unit; easy. Qed.

Lemma constF_1 : (x : E), constF 1 x = singleF x.
Proof. easy. Qed.

Lemma coupleF_0 : (x0 x1 : E), coupleF x0 x1 ord0 = x0.
Proof. move=>>; unfold coupleF; destruct (ord2_dec _); easy. Qed.

Lemma coupleF_1 : (x0 x1 : E), coupleF x0 x1 ord_max = x1.
Proof. move=>>; unfold coupleF; destruct (ord2_dec _); easy. Qed.

Lemma coupleF_l :
   (x0 x1 : E) (i : 'I_2), i = ord0 coupleF x0 x1 i = x0.
Proof. move=>> ->; apply coupleF_0. Qed.

Lemma coupleF_r :
   (x0 x1 : E) (i : 'I_2), i = ord_max coupleF x0 x1 i = x1.
Proof. move=>> ->; apply coupleF_1. Qed.

Lemma coupleF_correct : (A : 'E^2), A = coupleF (A ord0) (A ord_max).
Proof.
intros A; unfold coupleF; apply extF; intros i.
destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi; easy.
Qed.

Lemma constF_2 : (x : E), constF 2 x = coupleF x x.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewrite coupleF_0; easy.
rewrite coupleF_1; easy.
Qed.

Lemma tripleF_0 : (x0 x1 x2 : E), tripleF x0 x1 x2 ord0 = x0.
Proof. move=>>; unfold tripleF; destruct (ord3_dec _) as [[|]|]; easy. Qed.

Lemma tripleF_1 : (x0 x1 x2 : E), tripleF x0 x1 x2 ord1 = x1.
Proof. move=>>; unfold tripleF; destruct (ord3_dec _) as [[|]|]; easy. Qed.

Lemma tripleF_2 : (x0 x1 x2 : E), tripleF x0 x1 x2 ord_max = x2.
Proof. move=>>; unfold tripleF; destruct (ord3_dec _) as [[|]|]; easy. Qed.

Lemma tripleF_l :
   (x0 x1 x2 : E) (i : 'I_3), i = ord0 tripleF x0 x1 x2 i = x0.
Proof. move=>> ->; apply tripleF_0. Qed.

Lemma tripleF_m :
   (x0 x1 x2 : E) (i : 'I_3), i = ord1 tripleF x0 x1 x2 i = x1.
Proof. move=>> ->; apply tripleF_1. Qed.

Lemma tripleF_r :
   (x0 x1 x2 : E) (i : 'I_3), i = ord_max tripleF x0 x1 x2 i = x2.
Proof. move=>> ->; apply tripleF_2. Qed.

Lemma tripleF_correct :
   (A : 'E^3), A = tripleF (A ord0) (A ord1) (A ord_max).
Proof.
intros A; unfold tripleF; apply extF; intros i.
destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi; easy.
Qed.

Lemma constF_3 : (x : E), constF 3 x = tripleF x x x.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewrite tripleF_0; easy.
rewrite tripleF_1; easy.
rewrite tripleF_2; easy.
Qed.

Lemma castF_eq_sym :
   {n1 n2} (H : n1 = n2) {A2 : 'E^n2},
    castF (eq_sym H) A2 = fun i1A2 (cast_ord H i1).
Proof. intros; unfold castF; rewrite eq_sym_involutive; easy. Qed.

Lemma concatF_correct_l :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2)
      (i : 'I_(n1 + n2)) (Hi : (i < n1)%coq_nat),
    concatF A1 A2 i = A1 (concat_l_ord Hi).
Proof.
intros n1 n2 A1 A2 i Hi; unfold concatF; destruct (lt_dec _ _); try easy.
f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_correct_r :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2)
      (i : 'I_(n1 + n2)) (Hi : ¬ (i < n1)%coq_nat),
    concatF A1 A2 i = A2 (concat_r_ord Hi).
Proof.
intros n1 n2 A1 A2 i Hi; unfold concatF; destruct (lt_dec _ _); try easy.
f_equal; apply ord_inj; easy.
Qed.

Lemma unfunF_correct_l :
   {n1 n2} {f : 'I_{n1,n2}} {A1 : 'E^n1} x0 i1 i2,
    injective f f i1 = i2 unfunF f A1 x0 i2 = A1 i1.
Proof.
moven1 n2 f A1 x0 i1 i2 Hf <-; unfold unfunF.
destruct (im_dec _ _) as [[j1 Hj1] | Hi1].
simpl; apply Hf in Hj1; rewrite Hj1; easy.
contradict Hi1; apply nonempty_is_not_empty; i1; easy.
Qed.

Lemma unfunF_correct_r :
   {n1 n2} {f : 'I_{n1,n2}} (A1 : 'E^n1) {x0} i2,
    ( i1, f i1 i2) unfunF f A1 x0 i2 = x0.
Proof.
moven1 n2 f A1 x0 i2 Hi2; unfold unfunF.
destruct (im_dec _ _) as [[i1 Hi1] | Hi1]; try easy.
contradict Hi2; apply not_all_not_ex_equiv; i1; easy.
Qed.

Lemma unfunF_correct :
   {n1 n2} {f : 'I_{n1,n2}} (A1 : 'E^n1) x0 i2,
    injective f
    ( i1, f i1 = i2 unfunF f A1 x0 i2 = A1 i1)
    ( i1, f i1 i2) unfunF f A1 x0 i2 = x0.
Proof.
intros n1 n2 f A1 x0 i2 Hf; destruct (im_dec f i2) as [[i1 Hi1] | Hi2].
left; i1; split; try apply unfunF_correct_l; easy.
right; split; [| apply unfunF_correct_r];
    intros i1 Hi1; apply (Hi2 i1); easy.
Qed.

Lemma maskPF_correct_l :
   {n} {P : 'Prop^n} {A : 'E^n} x0 i, P i maskPF P A x0 i = A i.
Proof. intros; unfold maskPF; destruct (classic_dec _); easy. Qed.

Lemma maskPF_correct_r :
   {n} {P : 'Prop^n} (A : 'E^n) {x0} i, ¬ P i maskPF P A x0 i = x0.
Proof. intros; unfold maskPF; destruct (classic_dec _); easy. Qed.

Lemma funF_unfunF :
   {n1 n2} {f : 'I_{n1,n2}} (x0 : E),
    injective f cancel ((unfunF f)^~ x0) (funF f).
Proof. move=>> Hf A1; apply extF; intro; apply unfunF_correct_l; easy. Qed.

Lemma unfunF_funF :
   {n1 n2} {f : 'I_{n1,n2}} x0 {A2 : 'E^n2},
    injective f unfunF f (funF f A2) x0 = maskPF (image f fullset) A2 x0.
Proof.
intros n1 n2 f x0 A2 Hf; apply extF; intros i2.
destruct (im_dec f i2) as [[i1 <-] | Hi2].
rewrite (unfunF_correct_l _ i1)// maskPF_correct_l//.
rewrite unfunF_correct_r// maskPF_correct_r//.
rewrite image_eq; apply all_not_not_ex; intros i1 Hi1; apply (Hi2 i1); easy.
Qed.

Lemma insertF_correct_l :
   {n} (A : 'E^n) x0 {i0 i}, i = i0 insertF A x0 i0 i = x0.
Proof. intros; unfold insertF; destruct (ord_eq_dec _ _); easy. Qed.

Lemma insertF_correct_r :
   {n} (A : 'E^n) x0 {i0 i} (H : i i0),
    insertF A x0 i0 i = A (insert_ord H).
Proof.
intros; unfold insertF; destruct (ord_eq_dec _ _); try easy.
f_equal; apply insert_ord_compat_P.
Qed.

Lemma insertF_correct_rl :
   {n} (A : 'E^n) x0 {i0 i : 'I_n.+1} (H : (i < i0)%coq_nat),
    insertF A x0 i0 i = A (narrow_S (ord_nmax_lt H)).
Proof.
intros n A x0 i0 i H; unfold insertF; destruct (ord_eq_dec _ _) as [Hi | Hi].
contradict H; rewrite Hi; apply Nat.nlt_ge; easy.
f_equal; rewrite -insert_ord_correct_l; apply insert_ord_compat_P.
Qed.

Lemma insertF_correct_rr :
   {n} (A : 'E^n) x0 {i0 i : 'I_n.+1} (H : (i0 < i)%coq_nat),
    insertF A x0 i0 i = A (lower_S (ord_n0_gt H)).
Proof.
intros n A x0 i0 i H; unfold insertF; destruct (ord_eq_dec _ _) as [Hi | Hi].
contradict H; rewrite Hi; apply Nat.nlt_ge; easy.
f_equal; rewrite -insert_ord_correct_r; apply insert_ord_compat_P.
Qed.

Lemma insertF_correct :
   {n} (A : 'E^n) x0 i0 i, insertF A x0 i0 (skip_ord i0 i) = A i.
Proof.
intros; rewrite (insertF_correct_r _ _ (skip_ord_correct_m _ _))
    insert_skip_ord; easy.
Qed.

Lemma insert2F_correct :
   {n} (A : 'E^n) x0 x1 {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H = insertF (insertF A x1 (insert_ord H)) x0 i0.
Proof.
intros n A x0 x1 i0 i1 H; apply extF; intros i; unfold insert2F, insertF.
destruct (ord_eq_dec _ _) as [Hi0 | Hi0]; try easy.
destruct (ord_eq_dec _ _) as [Hi1 | Hi1],
    (ord_eq_dec _ _) as [Hi1' | Hi1']; try easy.
contradict Hi1'; subst i1; apply insert_ord_compat_P.
contradict Hi1; apply (insert_ord_inj _ _ Hi1').
f_equal; unfold insert2_ord; apply insert_ord_compat_P.
Qed.

Lemma insert2F_equiv_def :
   {n} (A : 'E^n) x0 x1 {i0 i1} (H10 : i1 i0) (H01 : i0 i1),
    insert2F A x0 x1 H10 = insertF (insertF A x0 (insert_ord H01)) x1 i1.
Proof.
intros n A x0 x1 i0 i1 H10 H01; apply extF; intros i; unfold insert2F, insertF.
destruct (ord_eq_dec _ _) as [Hi0 | Hi0],
    (ord_eq_dec _ _) as [Hi1 | Hi1]; try easy.
contradict H10; rewrite -Hi0 -Hi1; easy.
1,2: destruct (ord_eq_dec _ _) as [Hi1' | Hi1']; try easy.
contradict Hi1'; subst i0; apply insert_ord_compat_P.
contradict Hi0; apply (insert_ord_inj _ _ Hi1').
f_equal; apply insert2_ord_eq_sym.
Qed.

Lemma insert2F_equiv_def_alt :
   {n} (A : 'E^n) x0 x1 {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H =
      insertF (insertF A x0 (insert_ord (not_eq_sym H))) x1 i1.
Proof. intros; apply insert2F_equiv_def. Qed.

Lemma skipF_correct_l :
   {n} {A : 'E^n.+1} (i0 : 'I_n.+1) {j : 'I_n},
    (j < i0)%coq_nat skipF A i0 j = widenF_S A j.
Proof. intros; unfold skipF; rewrite skip_ord_correct_l; easy. Qed.

Lemma skipF_correct_m :
   {n} {A : 'E^n.+1} (i0 : 'I_n.+1) (j : 'I_n),
    injective A skipF A i0 j A i0.
Proof.
intros n A i0 j HA; unfold skipF.
apply (contra_not (HA (skip_ord i0 j) i0)), skip_ord_correct_m.
Qed.

Lemma skipF_correct_r :
   {n} {A : 'E^n.+1} (i0 : 'I_n.+1) {j : 'I_n},
    ¬ (j < i0)%coq_nat skipF A i0 j = liftF_S A j.
Proof. intros; unfold skipF; rewrite skip_ord_correct_r; easy. Qed.

Lemma skipF_correct :
   {n} {A : 'E^n.+1} {i0 i : 'I_n.+1} (H : i i0),
    skipF A i0 (insert_ord H) = A i.
Proof. intros; unfold skipF; rewrite skip_insert_ord; easy. Qed.

Lemma skipF_correct_alt :
   {n} {A : 'E^n.+1} {i0 i : 'I_n.+1} {j : 'I_n},
    i i0 skip_ord i0 j = i skipF A i0 j = A i.
Proof. move=>> Hi /(skip_insert_ord_eq Hi) ->; apply skipF_correct. Qed.

Lemma skip2F_correct :
   {n} (A : 'E^n.+2) {i0 i1 : 'I_n.+2} (H : i1 i0),
    skip2F A H = skipF (skipF A i0) (insert_ord H).
Proof. easy. Qed.

Lemma skip2F_sym :
   {n} (A : 'E^n.+2) {i0 i1} {H10 : i1 i0} (H01 : i0 i1),
    skip2F A H10 = skip2F A H01.
Proof. intros; unfold skip2F; rewrite skip2_ord_sym; easy. Qed.

Lemma skip2F_sym_alt :
   {n} (A : 'E^n.+2) {i0 i1} {H : i1 i0},
    skip2F A H = skip2F A (not_eq_sym H).
Proof. intros; apply skip2F_sym. Qed.

Lemma skip2F_equiv_def :
   {n} {A : 'E^n.+2} {i0 i1} (H10 : i1 i0) (H01 : i0 i1),
    skip2F A H10 = skipF (skipF A i1) (insert_ord H01).
Proof. intros; rewrite -(skip2F_correct); apply skip2F_sym. Qed.

Lemma skip2F_equiv_def_alt :
   {n} {A : 'E^n.+2} {i0 i1} (H : i1 i0),
    skip2F A H = skipF (skipF A i1) (insert_ord (not_eq_sym H)).
Proof. intros; apply skip2F_equiv_def. Qed.

Lemma replaceF_correct_l :
   {n} (A : 'E^n) x0 {i0 i}, i = i0 replaceF A x0 i0 i = x0.
Proof. intros; unfold replaceF; destruct (ord_eq_dec _ _); easy. Qed.

Lemma replaceF_correct_r :
   {n} (A : 'E^n) x0 {i0 i}, i i0 replaceF A x0 i0 i = A i.
Proof. intros; unfold replaceF; destruct (ord_eq_dec _ _); easy. Qed.

Lemma replace2F_correct_l0 :
   {n} (A : 'E^n) x0 x1 {i0 i1 i},
    i1 i0 i = i0 replace2F A x0 x1 i0 i1 i = x0.
Proof.
move=>> Hi H0; rewrite H0; unfold replace2F.
rewrite replaceF_correct_r; try now apply not_eq_sym.
apply replaceF_correct_l; easy.
Qed.

Lemma replace2F_correct_l1 :
   {n} (A : 'E^n) x0 x1 i0 {i1 i},
    i = i1 replace2F A x0 x1 i0 i1 i = x1.
Proof. intros; unfold replace2F; apply replaceF_correct_l; easy. Qed.

Lemma replace2F_correct_r :
   {n} (A : 'E^n) x0 x1 {i0 i1 i},
    i i0 i i1 replace2F A x0 x1 i0 i1 i = A i.
Proof. intros; unfold replace2F; rewrite → 2!replaceF_correct_r; easy. Qed.

Lemma replace2F_correct_eq :
   {n} (A : 'E^n) x0 x1 {i0 i1},
    i1 = i0 replace2F A x0 x1 i0 i1 = replaceF A x1 i1.
Proof.
intros n A x0 x1 i0 i1 H; apply extF; intros i; unfold replace2F.
destruct (ord_eq_dec i i1) as [Hi | Hi].
rewrite → 2!replaceF_correct_l; easy.
rewrite <- H, 3!replaceF_correct_r; easy.
Qed.

Lemma replace2F_equiv_def :
   {n} (A : 'E^n) x0 x1 {i0 i1},
    i1 i0 replace2F A x0 x1 i0 i1 = replaceF (replaceF A x1 i1) x0 i0.
Proof.
intros n A x0 x1 i0 i1 Hi; apply extF; intro; unfold replace2F, replaceF.
destruct (ord_eq_dec _ _) as [Hi0 | Hi0]; try easy.
destruct (ord_eq_dec _ _) as [Hi1 | Hi1]; try easy.
rewrite -Hi0 -Hi1 in Hi; easy.
Qed.

Lemma permutF_correct : {n} p (A : 'E^n) i, permutF p A i = A (p i).
Proof. easy. Qed.

Lemma revF_correct : {n} (A : 'E^n) i, revF A i = A (rev_ord i).
Proof. easy. Qed.

Lemma moveF_correct_l :
   {n} (A : 'E^n.+1) {i0 i1 i}, i = i1 moveF A i0 i1 i = A i0.
Proof. intros; unfold moveF, permutF; rewrite move_ord_correct_l; easy. Qed.

Lemma moveF_correct_r :
   {n} (A : 'E^n.+1) {i0 i1 i} (H : i i1),
    moveF A i0 i1 i = A (skip_ord i0 (insert_ord H)).
Proof. intros; unfold moveF, permutF; rewrite move_ord_correct_r; easy. Qed.

Lemma transpF_correct_l0 :
   {n} (A : 'E^n) {i0 i1 i}, i = i0 transpF A i0 i1 i = A i1.
Proof.
intros; unfold transpF, permutF; rewrite transp_ord_correct_l0; easy.
Qed.

Lemma transpF_correct_l1 :
   {n} (A : 'E^n) {i0 i1 i}, i = i1 transpF A i0 i1 i = A i0.
Proof.
intros; unfold transpF, permutF; rewrite transp_ord_correct_l1; easy.
Qed.

Lemma transpF_correct_r :
   {n} (A : 'E^n) {i0 i1 i},
    i i0 i i1 transpF A i0 i1 i = A i.
Proof.
intros; unfold transpF, permutF; rewrite transp_ord_correct_r; easy.
Qed.

Context {F G : Type}.

Lemma mapF_correct :
   {n} (f : E F) (A : 'E^n), mapF f A = fun if (A i).
Proof. easy. Qed.

Lemma map2F_correct :
   {n} (f : E F G) (A : 'E^n) B, map2F f A B = fun if (A i) (B i).
Proof. easy. Qed.

Lemma compF_l_correct :
   {n} (f : '(F G)^n) (g : E F), compF_l f g = fun if i \o g.
Proof. easy. Qed.

Lemma compF_r_correct :
   {n} (f : F G) (g : '(E F)^n), compF_r f g = fun if \o g i.
Proof. easy. Qed.

Lemma compF_correct :
   {n} (f : '(F G)^n) (g : '(E F)^n), compF f g = fun if i \o g i.
Proof. easy. Qed.

End FF_ops_Facts0.

Section FF_0_Facts.

Lemma hat0F_is_nonempty : E : Type, inhabited 'E^0.
Proof. intros; apply fun_from_empty_is_nonempty, I_0_is_empty. Qed.

Context {E : Type}.

Lemma hat0F_unit : (A : 'E^0), unit_type A.
Proof. apply fun_from_empty_unit, I_0_is_empty. Qed.

Lemma hat0F_is_unit : is_unit_type 'E^0.
Proof. apply fun_from_empty_is_unit, I_0_is_empty. Qed.

Lemma choiceF :
   {n} (R : 'I_n E Prop),
    ( i, x, R i x) (A : 'E^n), i, R i (A i).
Proof.
intros n; induction n as [| n Hn]; intros R HR.
+ (fun_from_I_0 E); intros [i Hi]; easy.
+ destruct (HR ord0) as [x0 Hx0].
  pose (R1 := fun (i1 : 'I_n) xR (lift_S i1) x).
  assert (HR1 : (i : 'I_n.+1) (Hi : i ord0) x,
      R i x = R1 (lower_S Hi) x).
    intros i Hi x; unfold R1; rewrite lift_lower_S; easy.
  destruct (Hn R1) as [A1 HA1].
    intros i1; destruct (HR (lift_S i1)) as [x1 Hx1]; x1; easy.
  assert (HA1' : i j : 'I_n, i = j R1 i (A1 j)) by now intros; subst.
   (concatF (singleF x0) A1); intros i.
  destruct (lt_dec i 1) as [Hi | Hi].
  × assert (Hi' : i = ord0) by now apply ord0_lt_equiv.
    rewrite Hi' concatF_correct_l singleF_0; easy.
  × assert (Hi' : i ord0) by now apply ord_n0_nlt_equiv.
    rewrite concatF_correct_r HR1; apply HA1'.
    apply ord_inj; easy.
Qed.

End FF_0_Facts.

Section FF_constr_Facts.

Context {E : Type}.

Properties of constructors constF/singleF/coupleF.

Lemma unit_typeF :
   {n} (A : 'E^n) (O : E), is_unit_type E A = constF n O.
Proof.
intros n A O [O' HE]; apply extF; intros i; rewrite (HE (A i)) (HE O); easy.
Qed.

Lemma constF_eq : {n} (x y : E), x = y constF n x = constF n y.
Proof. move=>>; apply f_equal. Qed.

Lemma singleF_eq : (x0 y0 : E), x0 = y0 singleF x0 = singleF y0.
Proof. intros; f_equal; easy. Qed.

Lemma coupleF_eq :
   (x0 x1 y0 y1 : E), x0 = y0 x1 = y1 coupleF x0 x1 = coupleF y0 y1.
Proof. intros; f_equal; easy. Qed.

Lemma tripleF_eq :
   (x0 x1 x2 y0 y1 y2 : E),
    x0 = y0 x1 = y1 x2 = y2 tripleF x0 x1 x2 = tripleF y0 y1 y2.
Proof. intros; f_equal; easy. Qed.

Lemma constF_inj : n, injective (@constF E n.+1).
Proof.
moven x y /extF_rev H.
rewrite -(constF_correct n.+1 x ord0); rewrite H; apply constF_correct.
Qed.

Lemma constF1_surj : surjective (@constF E 1).
Proof.
intros y; (y ord0); apply extF; intros i;
    rewrite I_1_is_unit constF_correct; easy.
Qed.

Lemma singleF_inj : (x0 y0 : E), singleF x0 = singleF y0 x0 = y0.
Proof. intros; apply (constF_inj 0); easy. Qed.

Lemma coupleF_inj_l :
   (x0 x1 y0 y1 : E), coupleF x0 x1 = coupleF y0 y1 x0 = y0.
Proof.
intros x0 x1 y0 y1 H; erewrite <- (coupleF_0 x0 x1),
    <- (coupleF_0 y0 y1), H; easy.
Qed.

Lemma coupleF_inj_r :
   (x0 x1 y0 y1 : E), coupleF x0 x1 = coupleF y0 y1 x1 = y1.
Proof.
intros x0 x1 y0 y1 H; erewrite <- (coupleF_1 x0 x1),
    <- (coupleF_1 y0 y1), H; easy.
Qed.

Lemma coupleF_inj :
   (x0 x1 y0 y1 : E), coupleF x0 x1 = coupleF y0 y1 x0 = y0 x1 = y1.
Proof.
move=>> H; split; [eapply coupleF_inj_l | eapply coupleF_inj_r]; apply H.
Qed.

Lemma tripleF_inj_l :
   (x0 x1 x2 y0 y1 y2 : E),
    tripleF x0 x1 x2 = tripleF y0 y1 y2 x0 = y0.
Proof.
intros x0 x1 x2 y0 y1 y2 H;
    erewrite <- (tripleF_0 x0 x1 x2), <- (tripleF_0 y0 y1 y2), H; easy.
Qed.

Lemma tripleF_inj_m :
   (x0 x1 x2 y0 y1 y2 : E),
    tripleF x0 x1 x2 = tripleF y0 y1 y2 x1 = y1.
Proof.
intros x0 x1 x2 y0 y1 y2 H;
    erewrite <- (tripleF_1 x0 x1 x2), <- (tripleF_1 y0 y1 y2), H; easy.
Qed.

Lemma tripleF_inj_r :
   (x0 x1 x2 y0 y1 y2 : E),
    tripleF x0 x1 x2 = tripleF y0 y1 y2 x2 = y2.
Proof.
intros x0 x1 x2 y0 y1 y2 H;
    erewrite <- (tripleF_2 x0 x1 x2), <- (tripleF_2 y0 y1 y2), H; easy.
Qed.

Lemma tripleF_inj :
   (x0 x1 x2 y0 y1 y2 : E),
    tripleF x0 x1 x2 = tripleF y0 y1 y2 x0 = y0 x1 = y1 x2 = y2.
Proof.
move=>> H; repeat split;
    [eapply tripleF_inj_l | eapply tripleF_inj_m | eapply tripleF_inj_r];
    apply H.
Qed.

Lemma coupleF_diag : (x : E), coupleF x x = constF 2 x.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [H | H]; rewrite H;
    [rewrite coupleF_0 | rewrite coupleF_1]; easy.
Qed.

Lemma tripleF_diag : (x : E), tripleF x x x = constF 3 x.
Proof.
intros; apply extF; intros i; destruct (ord3_dec i) as [[H | H] | H]; rewrite H;
    [rewrite tripleF_0 | rewrite tripleF_1 | rewrite tripleF_2]; easy.
Qed.

End FF_constr_Facts.

Section FF_pred_Facts.

Context {E : Type}.

Properties of predicate inF.

Lemma inF_refl : {n} (A : 'E^n) i , inF (A i) A.
Proof. intros n A i; i; easy. Qed.

Lemma inF_monot :
   {n1 n2} x (A1 : 'E^n1) (A2 : 'E^n2), invalF A1 A2 inF x A1 inF x A2.
Proof.
move=>> HA [i1 Hi1]; destruct (HA i1) as [i2 Hi2];
    rewrite Hi1 Hi2; i2; easy.
Qed.

Lemma inF_not :
   {n} x (A : 'E^n), ¬ inF x A i, x A i.
Proof. intros; apply not_ex_all_not_equiv. Qed.

Lemma inF_constF : {n} (x : E), inF x (constF n.+1 x).
Proof. intros; ord0; easy. Qed.

Lemma inF_singleF : (x0 : E), inF x0 (singleF x0).
Proof. intros; apply inF_constF. Qed.

Lemma inF_coupleF_0 : (x0 x1 : E), inF x0 (coupleF x0 x1).
Proof. intros; ord0; rewrite coupleF_0; easy. Qed.

Lemma inF_coupleF_1 : (x0 x1 : E), inF x1 (coupleF x0 x1).
Proof. intros; ord_max; rewrite coupleF_1; easy. Qed.

Lemma inF_tripleF_0 : (x0 x1 x2 : E), inF x0 (tripleF x0 x1 x2).
Proof. intros; ord0; rewrite tripleF_0; easy. Qed.

Lemma inF_tripleF_1 : (x0 x1 x2 : E), inF x1 (tripleF x0 x1 x2).
Proof. intros; ord1; rewrite tripleF_1; easy. Qed.

Lemma inF_tripleF_2 : (x0 x1 x2 : E), inF x2 (tripleF x0 x1 x2).
Proof. intros; ord_max; rewrite tripleF_2; easy. Qed.

Properties of predicate inclF.

Lemma inclF_fullset : {n} (A : 'E^n), inclF A fullset.
Proof. easy. Qed.

Lemma inclF_nil : (PE : E Prop) (A : 'E^0), inclF A PE.
Proof. intros PE A [i Hi]; easy. Qed.

Lemma inclF_constF : (PE : E Prop) n x, PE x inclF (constF n x) PE.
Proof. intros PE n x Hx i; auto. Qed.

Lemma inclF_singleton_equiv :
   {n} x (A : 'E^n), inclF A (singleton x) A = constF n x.
Proof.
intros; split; intros HA.
apply extF; intro; rewrite HA; easy.
subst; apply inclF_constF; easy.
Qed.

Lemma inclF_singleF :
   (PE : E Prop) x0, PE x0 inclF (singleF x0) PE.
Proof. intros; apply inclF_constF; easy. Qed.

Lemma inclF_coupleF :
   (PE : E Prop) x0 x1, PE x0 PE x1 inclF (coupleF x0 x1) PE.
Proof. intros; intro; unfold coupleF; destruct (ord2_dec _); easy. Qed.

Lemma inclF_tripleF :
   (PE : E Prop) x0 x1 x2,
    PE x0 PE x1 PE x2 inclF (tripleF x0 x1 x2) PE.
Proof.
intros; intro; unfold tripleF; destruct (ord3_dec _) as [[K | K] | K]; easy.
Qed.

Lemma inclF_trans :
   {n} (A : 'E^n) x PE, inF x A inclF A PE PE x.
Proof. move=>> [i Hi]; rewrite Hi; easy. Qed.

Lemma inclF_monot_l :
   {n1 n2} PE (A1 : 'E^n1) (A2 : 'E^n2),
    invalF A2 A1 inclF A1 PE inclF A2 PE.
Proof. move=>> H H1 i2; destruct (H i2) as [i1 Hi1]; rewrite Hi1; easy. Qed.

Lemma inclF_monot_r :
   {n} PE1 PE2 (A : 'E^n), incl PE1 PE2 inclF A PE1 inclF A PE2.
Proof. move=>> H H1 i; auto. Qed.

Lemma inclF_image_equiv :
   {F : Type} (f : E F) (PE : E Prop) {n} (B : 'F^n),
    inclF B (image f PE) A, inclF A PE B = mapF f A.
Proof.
intros F f PE n B; split.
rewrite image_eq; intros HB; destruct (choiceF _ HB) as [A HA].
A; split; [ | apply extF]; intros i; apply HA.
move⇒ [A [HA1 /extF_rev HA2]] i; rewrite HA2; easy.
Qed.

Properties of predicate invalF.

Lemma invalF_refl : {n} (A : 'E^n), invalF A A.
Proof. move=>>; eexists; easy. Qed.

Lemma invalF_singleF_refl : {n} (A : 'E^n) i, invalF (singleF (A i)) A.
Proof. move=>>; rewrite singleF_0; eexists; easy. Qed.

Lemma invalF_trans :
   {n1 n2 n3} (A2 : 'E^n2) (A1 : 'E^n1) (A3 : 'E^n3),
    invalF A1 A2 invalF A2 A3 invalF A1 A3.
Proof.
move=>> H12 H23 i1; destruct (H12 i1) as [i2 Hi2], (H23 i2) as [i3 Hi3].
i3; rewrite Hi2; easy.
Qed.

Lemma invalF_fun :
   {n1 n2} {A1 : 'E^n1} {A2 : 'E^n2},
    invalF A1 A2 f, i1, A1 i1 = A2 (f i1).
Proof. move=>> HA; apply (choiceF _ HA). Qed.

Lemma invalF_fun_inj :
   {n1 n2} {A1 : 'E^n1} {A2 : 'E^n2} (f : 'I_n1 'I_n2),
    injective A1 invalF A1 A2 ( i1, A1 i1 = A2 (f i1)) injective f.
Proof.
move=>> HA1 HA Hf i1 j1 H1; apply HA1; do 2 rewrite Hf; f_equal; easy.
Qed.

Lemma invalF_le :
   {n1 n2} {A1 : 'E^n1} {A2 : 'E^n2},
    injective A1 invalF A1 A2 n1 n2.
Proof.
move=>> HA1 HA; destruct (invalF_fun HA) as [f Hf].
apply (inj_leq f), (invalF_fun_inj _ HA1 HA Hf).
Qed.

Lemma injF_monot :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2),
    n1 = n2 invalF A1 A2 injective A1 injective A2.
Proof.
intros n1' n A1 A2 Hn HA HA1; subst; destruct (invalF_fun HA) as [f Hf].
assert (Hf' : bijective f) by apply injF_bij, (invalF_fun_inj f HA1 HA Hf).
destruct Hf' as [g Hg1 Hg2].
assert (Hg' : injective g) by apply bij_inj, (Bijective Hg2 Hg1).
assert (Hg : i2, A2 i2 = A1 (g i2)) by (now intros; rewrite Hf Hg2).
move=>> H2; rewrite 2!Hg in H2; apply HA1 in H2.
apply Hg', H2.
Qed.

Lemma invalF_sym :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2),
    n1 = n2 injective A1 invalF A1 A2 invalF A2 A1.
Proof.
move=>> Hn HA1 HA; subst; destruct (invalF_fun HA) as [f Hf].
assert (Hf' : bijective f) by apply injF_bij, (invalF_fun_inj f HA1 HA Hf).
destruct Hf' as [g _ Hg]; intros i; (g i); rewrite Hf Hg; easy.
Qed.

Lemma injF_equiv :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2),
    n1 = n2 invalF A1 A2 invalF A2 A1 injective A1 injective A2.
Proof. intros; split; apply injF_monot; easy. Qed.

Lemma invalF_coupleF_sym :
   (x0 x1 : E), invalF (coupleF x0 x1) (coupleF x1 x0).
Proof.
intros; intro; unfold inF, coupleF at 1; destruct (ord2_dec _).
ord_max; rewrite coupleF_1; easy.
ord0; rewrite coupleF_0; easy.
Qed.

Lemma invalF_P :
   {P : E Prop} {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2),
    invalF A1 A2 ( i2, P (A2 i2)) i1, P (A1 i1).
Proof. move=>> /invalF_fun [f Hf] H2 i1; rewrite Hf; easy. Qed.

Properties of predicates iffAF.

Lemma iffAF_refl : {n} (P : 'Prop^n), iffAF P P.
Proof. easy. Qed.

Lemma iffAF_sym : {n} {P Q : 'Prop^n}, iffAF P Q iffAF Q P.
Proof. easy. Qed.

Lemma iffAF_trans :
   {n} (Q P R : 'Prop^n), iffAF P Q iffAF Q R iffAF P R.
Proof. move=>> HPQ HQR i; rewrite HPQ; auto. Qed.

Lemma iffAF_eq_sym :
   {n1 n2} (H : n1 = n2) {P1 : 'Prop^n1} {P2 : 'Prop^n2},
    iffAF P1 (castF (eq_sym H) P2) i1, P1 i1 P2 (cast_ord H i1).
Proof. move=>>; rewrite castF_eq_sym; easy. Qed.

Properties of predicates eqPF/neqPF.

Lemma eqPF_refl : {n} (P : 'Prop^n) (A : 'E^n), eqPF P A A.
Proof. easy. Qed.

Lemma eqPF_sym :
   {n} (P : 'Prop^n) (A B : 'E^n), eqPF P A B eqPF P B A.
Proof. move=>> H i Hi; symmetry; auto. Qed.

Lemma eqPF_trans :
   {n} (P : 'Prop^n) (B A C : 'E^n),
    eqPF P A B eqPF P B C eqPF P A C.
Proof. move=>> H1 H2 i Hi; rewrite H1; auto. Qed.

Lemma eqPF_compat : {n} (P : 'Prop^n) (A B : 'E^n), A = B eqPF P A B.
Proof. move=>> H; rewrite H; easy. Qed.

Lemma eqPF_reg :
   {n} (P : 'Prop^n) (A B : 'E^n),
    ( i, ¬ P i A i = B i) eqPF P A B A = B.
Proof.
intros n P A B H0 H1; apply extF; intros i;
    destruct (classic (P i)) as [Hi |]; try rewrite Hi; auto.
Qed.

Lemma eqPF_not_equiv :
   {n} (P : 'Prop^n) (A B : 'E^n), eqPF P A B ¬ neqPF P A B.
Proof.
intros; split.
intros H; apply all_not_not_ex; intros; rewrite -imp_and_equiv; apply H.
move⇒ /not_ex_all_not H i; apply imp_and_equiv, H.
Qed.

Lemma neqPF_not_equiv :
   {n} (P : 'Prop^n) (A B : 'E^n), neqPF P A B ¬ eqPF P A B.
Proof. intros; rewrite iff_not_r_equiv eqPF_not_equiv; easy. Qed.

Lemma neqPF_compat :
   {n} (P : 'Prop^n) (A B : 'E^n),
    A B ( i, ¬ P i A i B i) neqPF P A B.
Proof.
intros n P A B; rewrite contra_not_l_equiv;
    move⇒ /not_or_equiv [/not_ex_all_not_equiv H1 /eqPF_not_equiv H2].
apply (eqPF_reg P); [intros i; specialize (H1 i); tauto | easy].
Qed.

Lemma neqPF_reg : {n} (P : 'Prop^n) (A B : 'E^n), neqPF P A B A B.
Proof. move=>>; rewrite neqPF_not_equiv -contra_equiv; apply eqPF_compat. Qed.

Properties of predicates eqxF/neqxF/eqx2F/neqx2F.

Lemma eqxF_refl : {n} (A : 'E^n) i0, eqxF A A i0.
Proof. easy. Qed.

Lemma eqxF_sym : {n} (A B : 'E^n) i0, eqxF A B i0 eqxF B A i0.
Proof. move=>>; apply eqPF_sym. Qed.

Lemma eqxF_trans :
   {n} (B A C : 'E^n) i0, eqxF A B i0 eqxF B C i0 eqxF A C i0.
Proof. move=>>; apply eqPF_trans. Qed.

Lemma eqxF_compat : {n} {A B : 'E^n} i0, A = B eqxF A B i0.
Proof. move=>>; apply eqPF_compat. Qed.

Lemma eqxF_reg :
   {n} {A} (B : 'E^n) i0, A i0 = B i0 eqxF A B i0 A = B.
Proof. move=>> H; apply eqPF_reg; move=>> /NNPP ->; easy. Qed.

Lemma eqxF_not_equiv :
   {n} {A B : 'E^n} i0, eqxF A B i0 ¬ neqxF A B i0.
Proof. move=>>; apply eqPF_not_equiv. Qed.

Lemma neqxF_not_equiv :
   {n} {A B : 'E^n} i0, neqxF A B i0 ¬ eqxF A B i0.
Proof. move=>>; apply neqPF_not_equiv. Qed.

Lemma neqxF_compat :
   {n} {A B : 'E^n} i0, A B A i0 B i0 neqxF A B i0.
Proof.
moven A B i0 /(neqPF_compat (fun ii i0)) [[i [/NNPPHi2]] | H];
    [left | right]; easy.
Qed.

Lemma neqxF_reg : {n} {A B : 'E^n} i0, neqxF A B i0 A B.
Proof. move=>>; apply neqPF_reg. Qed.

Lemma eqx2F_refl : {n} (A : 'E^n) i0 i1, eqx2F A A i0 i1.
Proof. easy. Qed.

Lemma eqx2F_sym :
   {n} (A B : 'E^n) i0 i1, eqx2F A B i0 i1 eqx2F B A i0 i1.
Proof. move=>>; apply eqPF_sym. Qed.

Lemma eqx2F_trans :
   {n} (B A C : 'E^n) i0 i1,
    eqx2F A B i0 i1 eqx2F B C i0 i1 eqx2F A C i0 i1.
Proof. move=>>; apply eqPF_trans. Qed.

Lemma eqx2F_compat : {n} {A B : 'E^n} i0 i1, A = B eqx2F A B i0 i1.
Proof. move=>>; apply eqPF_compat. Qed.

Lemma eqx2F_reg :
   {n} {A} (B : 'E^n) i0 i1,
    A i0 = B i0 A i1 = B i1 eqx2F A B i0 i1 A = B.
Proof.
move=>> H0 H1; apply eqPF_reg; intro; move⇒ /not_or_equiv /NNPP [-> | ->]//.
Qed.

Lemma eqx2F_not_equiv :
   {n} {A B : 'E^n} i0 i1, eqx2F A B i0 i1 ¬ neqx2F A B i0 i1.
Proof. move=>>; apply eqPF_not_equiv. Qed.

Lemma neqx2F_not_equiv :
   {n} {A B : 'E^n} i0 i1, neqx2F A B i0 i1 ¬ eqx2F A B i0 i1.
Proof. move=>>; apply neqPF_not_equiv. Qed.

Lemma eqx2F_sym_i :
   {n} {A B : 'E^n} i0 i1, eqx2F A B i0 i1 eqx2F A B i1 i0.
Proof. move=>> H i Hi; apply H; easy. Qed.

Lemma neqx2F_sym_i :
   {n} {A B : 'E^n} i0 i1, neqx2F A B i0 i1 neqx2F A B i1 i0.
Proof. move=>> [i Hi]; i; easy. Qed.

End FF_pred_Facts.

Section FF_sub_Facts.

Context {E : Type}.
Context {PE : E Prop}.

Lemma in_subF : {n} (A_sub : '(sub PE)^n), inclF (mapF val A_sub) PE.
Proof. move=>>; apply in_sub. Qed.

Lemma mk_subF_eq :
   {n} (A_sub : '(sub PE)^n), A_sub = fun imk_sub (in_subF A_sub i).
Proof. intros; apply extF; intros i; apply val_inj; easy. Qed.

Lemma valF_eq :
   {n} (A : 'E^n) (HA : inclF A PE),
    A = mapF val (fun imk_sub_ PE _ (HA i)).
Proof. easy. Qed.

End FF_sub_Facts.

Section CastF_Facts.

Context {E : Type}.

Properties of operator castF/castF_fun/cast2F_fun.

Lemma castF_refl : {n} {H : n = n} (A : 'E^n), castF H A = A.
Proof.
intros; unfold castF; apply extF; intro; f_equal; apply ord_inj; easy.
Qed.

Lemma castF_id : {n} {H : n = n}, castF H = @id 'E^n.
Proof. intros; apply fun_ext; intro; apply castF_refl. Qed.

Lemma castF_fun_id :
   {T : Type} {n} {H : n = n}, castF_fun H = @id ('E^n T).
Proof. intros; unfold castF_fun; rewrite castF_id; easy. Qed.

Lemma cast2F_fun_id :
   {T1 T2 : Type} {n} {H : n = n},
    cast2F_fun H = @id (('E^n T1) T2).
Proof. intros; unfold cast2F_fun; rewrite castF_fun_id; easy. Qed.

Lemma eqAF_nil :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1) (A2 : 'E^n2),
    n1 = 0 n2 = 0 A2 = castF H A1.
Proof. move=>> [H | H]; subst; rewrite castF_id; apply hat0F_unit. Qed.

Lemma castF_trans :
   {n1 n2 n3}
      (H12 : n1 = n2) (H23 : n2 = n3) (H13 : n1 = n3) (A1 : 'E^n1),
    castF H23 (castF H12 A1) = castF H13 A1.
Proof.
intros; unfold castF; apply extF; intro; f_equal; apply ord_inj; easy.
Qed.

Lemma castF_comp :
   {n1 n2 n3} (H12 : n1 = n2) (H23 : n2 = n3) (A1 : 'E^n1),
    castF H23 (castF H12 A1) = castF (eq_trans H12 H23) A1.
Proof. intros; apply (castF_trans _ _ (eq_trans _ _)). Qed.

Lemma castF_can :
   {n1 n2} (H12 : n1 = n2) (H21 : n2 = n1),
    cancel (@castF E _ _ H12) (castF H21).
Proof. move=>>; rewrite castF_trans castF_id; easy. Qed.

Lemma castF_eq_l :
   {n1 n2} (H H' : n1 = n2) (A1 : 'E^n1), castF H A1 = castF H' A1.
Proof. intros; f_equal; easy. Qed.

Lemma castF_eq_r :
   {n1 n2} (H H' : n1 = n2) (A1 A'1 : 'E^n1),
    A1 = A'1 castF H A1 = castF H' A'1.
Proof. intros; f_equal; easy. Qed.

Lemma castF_eq_r_alt :
   {n1 n2 m} (H1 : n1 = m) (H2 : n2 = m) (A1 : 'E^n1) (A2 : 'E^n2),
    ( i1 i2, nat_of_ord i1 = nat_of_ord i2 A1 i1 = A2 i2)
    castF H1 A1 = castF H2 A2.
Proof. move=>> H; apply extF; intro; apply H; easy. Qed.

Lemma castF_eq :
   {n1 n2} (H : n1 = n2) {A1 : 'E^n1} i1 i2,
    nat_of_ord i1 = nat_of_ord i2 castF H A1 i2 = A1 i1.
Proof. intros; unfold castF; f_equal; apply ord_inj; easy. Qed.

Lemma castF_inj :
   {n1 n2} (H : n1 = n2) (A1 B1 : 'E^n1),
    castF H A1 = castF H B1 A1 = B1.
Proof.
intros n1 n2 H A1 B1; rewrite -{2}(castF_can H (eq_sym H) A1)
    -{2}(castF_can H (eq_sym H) B1).
apply castF_eq_r.
Qed.

Lemma castF_can_l :
   {n1 n2} (H : n1 = n2), cancel (castF (eq_sym H)) (@castF E _ _ H).
Proof. intros; apply castF_can. Qed.

Lemma castF_can_r :
   {n1 n2} (H : n1 = n2), cancel (@castF E _ _ H) (castF (eq_sym H)).
Proof. intros; apply castF_can. Qed.

Lemma castF_cast_ord :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1) i1,
    castF H A1 (cast_ord H i1) = A1 i1.
Proof. intros; unfold castF; rewrite cast_ordK; easy. Qed.

Lemma castF_surjF :
   {n1 n2} (H : n1 = n2) (A2 : 'E^n2),
     (A1 : 'E^n1), A2 = castF H A1.
Proof.
intros n1 n2 H A2; (fun i1A2 (cast_ord H i1)).
apply extF; intro; unfold castF; f_equal; rewrite cast_ordKV; easy.
Qed.

Lemma sortedF_castF :
   {leE : E E Prop} {n1 n2} (H : n1 = n2) {A : 'E^n1},
    sortedF leE A sortedF leE (castF H A).
Proof. move=>> HA i2 j2 H2; apply HA; easy. Qed.

Lemma sortedF_castF_rev :
   {leE : E E Prop} {n1 n2} (H : n1 = n2) {A : 'E^n1},
    sortedF leE (castF H A) sortedF leE A.
Proof.
intros leE n1 n2 H A HA i1 j1 H1;
    rewrite -(cast_ordK H i1) -(cast_ordK H j1); apply HA; easy.
Qed.

Lemma sortedF_castF_equiv :
   {leE : E E Prop} {n1 n2} (H : n1 = n2) {A : 'E^n1},
    sortedF leE A sortedF leE (castF H A).
Proof. intros; split; [apply sortedF_castF | apply sortedF_castF_rev]. Qed.

Lemma invalF_castF_l_equiv :
   {m1 m2 n} (Hm : m1 = m2) (Am : 'E^m1) (An : 'E^n),
    invalF (castF Hm Am) An invalF Am An.
Proof.
intros m1 m2 n Hm Am An; split; intros HA i.
destruct (HA (cast_ord Hm i)) as [j Hj];
    rewrite castF_cast_ord in Hj; j; easy.
destruct (HA (cast_ord (eq_sym Hm) i)) as [j Hj]; j; easy.
Qed.

Lemma invalF_castF_r_equiv :
   {m n1 n2} (Hn : n1 = n2) (Am : 'E^m) (An : 'E^n1),
    invalF Am (castF Hn An) invalF Am An.
Proof.
intros m n1 n2 Hn Am An; split; intros HA i; destruct (HA i) as [j Hj].
(cast_ord (eq_sym Hn) j); easy.
(cast_ord Hn j); rewrite castF_cast_ord; easy.
Qed.

Lemma invalF_castF_equiv :
   {m1 m2 n1 n2} (Hm : m1 = m2) (Hn : n1 = n2) (Am : 'E^m1) (An : 'E^n1),
    invalF (castF Hm Am) (castF Hn An) invalF Am An.
Proof. intros; rewrite invalF_castF_l_equiv invalF_castF_r_equiv; easy. Qed.

Lemma invalF_castF_l :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1), invalF (castF H A1) A1.
Proof. intros n1 n2 H A1 i2; (cast_ord (eq_sym H) i2); easy. Qed.

Lemma invalF_castF_r :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1), invalF A1 (castF H A1).
Proof.
intros n1 n2 H A1 i1; (cast_ord H i1).
rewrite castF_cast_ord; easy.
Qed.

Lemma castF_sym_equiv :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1) (A2 : 'E^n2),
    castF H A1 = A2 castF (eq_sym H) A2 = A1.
Proof.
intros n1 n2 H A1 A2; rewrite -{2}(castF_can H (eq_sym H) A1); split.
intros; subst; easy.
move⇒ /castF_inj; easy.
Qed.

Lemma castF_constF :
   {n1 n2} (H : n1 = n2) (x : E), castF H (constF n1 x) = constF n2 x.
Proof.
intros; apply extF; intro; unfold castF; rewrite 2!constF_correct; easy.
Qed.

Lemma castF_1 :
   {n} (H : n = 1) (A : 'E^1) i, castF (eq_sym H) A i = A ord0.
Proof.
intros; subst; rewrite I_1_is_unit; unfold castF; f_equal; apply ord_inj; easy.
Qed.

Lemma castF_p1S_Sp1 :
   {n} (A : 'E^n.+1), castF_p1S (castF_Sp1 A) = A.
Proof. intros; unfold castF_p1S, castF_Sp1; apply castF_can. Qed.

Lemma castF_Sp1_p1S :
   {n} (A : 'E^(n + 1)), castF_Sp1 (castF_p1S A) = A.
Proof. intros; unfold castF_p1S, castF_Sp1; apply castF_can. Qed.

Lemma castF_1pS_S1p : {n} (A : 'E^n.+1), castF_1pS (castF_S1p A) = A.
Proof. intros; unfold castF_1pS, castF_S1p; apply castF_can. Qed.

Lemma castF_S1p_1pS : {n} (A : 'E^(1 + n)), castF_S1p (castF_1pS A) = A.
Proof. intros; unfold castF_1pS, castF_S1p; apply castF_can. Qed.

End CastF_Facts.

Section Fun_ord.


Lemma injF_extend_bij_EX :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f),
    { p2 | bijective p2 i1, f i1 = widenF (injF_leq Hf) p2 i1 }.
Proof.
intros n1 n2 f Hf; induction n1 as [| n1 Hn1].
id; repeat split; [apply bij_id | now intros [i Hi]].
pose (f' := fun i1f (widen_S i1)).
assert (Hf' : injective f') by now movei1 j1 /Hf /widen_ord_inj.
destruct (Hn1 _ Hf') as [p2' [Hp2'a Hp2'b]]; clear Hn1.
pose (nn1 := widen_ord (injF_leq Hf) ord_max).
pose (p2 := fun i2transp_ord (p2' nn1) (f ord_max) (p2' i2)).
p2; repeat split.
pose (q2 := fun j2transp_ord nn1 (f_inv Hp2'a (f ord_max)) (f_inv Hp2'a j2)).
move: (bij_inj Hp2'a) ⇒ Hp2'c.
assert (Hq2a : cancel p2 q2).
  intros i2; unfold q2, p2.
  destruct (ord_eq2_dec (p2' i2) (p2' nn1) (f ord_max)) as [[H | H] | [Ha Hb]].
  rewrite (transp_ord_correct_l0 H) transp_ord_correct_l1//; apply Hp2'c; easy.
  rewrite (transp_ord_correct_l1 H) transp_ord_correct_l0.
  apply eq_sym, f_inv_eq_equiv; easy. apply f_inv_can_l.
  rewrite (transp_ord_correct_r Ha Hb) transp_ord_correct_r;
      rewrite f_inv_can_l; try easy.
  contradict Ha; subst; easy.
  contradict Hb; subst; rewrite f_inv_can_r; easy.
assert (Hq2b : cancel q2 p2).
  intros j2; unfold q2, p2.
  destruct (ord_eq2_dec j2 (p2' nn1) (f ord_max)) as [[H | H] | [Ha Hb]].
  rewrite H f_inv_can_l transp_ord_correct_l1// transp_ord_correct_l0//
      f_inv_can_r; easy.
  rewrite H transp_ord_correct_l0// transp_ord_correct_l1//.
  apply not_eq_sym, (f_inv_neq_equiv Hp2'a) in Ha;
      rewrite (transp_ord_correct_r (not_eq_sym Ha) _).
  apply f_inv_neq_equiv, not_eq_sym in Ha;
      rewrite f_inv_can_r transp_ord_correct_r//.
  contradict Hb; apply (f_inv_inj Hp2'a); easy.
apply (Bijective Hq2a Hq2b).
unfold p2, widenF in *; move: Hp2'a ⇒ /bij_equiv [Hp2'c _].
intros i1; destruct (ord_eq_dec i1 ord_max) as [Hi1 | Hi1].
rewrite Hi1 transp_ord_correct_l0// f_inv_can_r//.
rewrite -{1}(widen_narrow_S Hi1); fold (f' (narrow_S Hi1)); rewrite Hp2'b.
rewrite transp_ord_correct_r; try now f_equal; apply ord_inj.
contradict Hi1; apply Hp2'c, widen_ord_inj in Hi1; easy.
replace (widen_ord _ _) with (widen_ord (injF_leq Hf') (narrow_S Hi1));
    try now apply ord_inj.
rewrite -Hp2'b; unfold f'; rewrite widen_narrow_S.
contradict Hi1; apply Hf; easy.
Qed.

Lemma injF_restr_bij_EX :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f),
    { p1 : 'I_[n1] | bijective p1 incrF (f \o p1) }.
Proof.
intros n1 n2 f Hf; destruct n1 as [| n1].
(fun_from_I_0 'I_0); split;
    [apply fun_from_I_0_bij | intros [i Hi]; easy].
destruct n2 as [| n2];
    [move: (injF_le Hf) ⇒ Hn1; contradict Hn1;
      apply Nat.nle_gt, Nat.lt_0_succ |].
pose (lf := (map f (ord_enum n1.+1))).
assert (Hlf : i : 'I_n1.+1, nth ord0 lf i = f i)
    by now intros i; rewrite (nth_map ord0);
      [rewrite nth_ord_enum | rewrite size_ord_enum].
destruct (sort_perm_EX ord_leq_antisym ord_leq_trans ord_leq_total ord0 lf)
    as [p1 Hp1a Hp1b].
assert (Hn1 : size lf = n1.+1) by now rewrite size_map size_ord_enum.
rewrite Hn1 in p1, Hp1a, Hp1b.
pose (lf' := map (fun i1nth ord0 lf (p1 i1)) (ord_enum n1.+1)).
assert (Hlf'a : size lf' = n1.+1) by now rewrite size_map size_ord_enum.
assert (Hlf'b : lf' = map (f \o p1) (ord_enum n1.+1)).
  apply (@eq_from_nth _ ord0); [rewrite !size_map; easy |].
  intros i Hi; rewrite Hlf'a in Hi; rewrite !(nth_map ord0).
  rewrite nth_ord_enum; easy.
  1,2,3: rewrite size_ord_enum; easy.
p1; split; [apply injF_bij; easy | apply incrF_equiv].
intros i1 Hj1; rewrite !comp_correct; pose (j1 := Ordinal Hj1); fold j1.
assert (H : i1 < j1) by easy.
apply /ltP; destruct (proj1 ltn_equiv H) as [H1 H2].
apply leq_neq_ltn;
    [| apply ord_neq_compat, (inj_contra Hf), (inj_contra Hp1a), ord_neq; easy].
assert (Hi1a : i1 < n1.+1) by now destruct i1.
assert (Hj1a : j1 < n1.+1) by now destruct j1.
assert (Hj1b : j1 < size lf') by now rewrite Hlf'a.
move: (sort_sorted ord_leq_total lf); rewrite Hp1b; simpl; fold lf'.
move⇒ /(sortedP ord0) ⇒ H3; specialize (H3 (nat_of_ord i1) Hj1b); move: H3.
replace i1.+1 with (nat_of_ord j1) by easy.
rewrite Hlf'b !(nth_map ord0); [| rewrite size_ord_enum; easy..].
rewrite !comp_correct !nth_ord_enum; easy.
Qed.

End Fun_ord.

Section FunF_Facts.

Context {E : Type}.

Properties of operators funF/unfunF/maskPF.

Lemma funF_equiv :
   {n1 n2} (f : 'I_{n1,n2}) (A1 : 'E^n1) (A2 : 'E^n2),
    funF f A2 = A1 ( i1 i2, i2 = f i1 A2 i2 = A1 i1).
Proof.
intros; split; intros HA. intros; subst; easy.
apply extF; intros i1; apply (HA i1 (f i1)); easy.
Qed.

Lemma funF_neqF :
   {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0},
    funF f (neqF A2 x0) = neqF (funF f A2) x0.
Proof. easy. Qed.

Lemma funF_comp :
   {n1 n2 n3} {f12 : 'I_{n1,n2}} {f23 : 'I_{n2,n3}} (A3 : 'E^n3),
    funF (f23 \o f12) A3 = funF f12 (funF f23 A3).
Proof. easy. Qed.

Lemma unfunF_nil :
   {n} (f : 'I_{0,n}) (A : 'E^0) x0, unfunF f A x0 = (fun x0).
Proof.
intros n f A x0; apply extF; intros i; unfold unfunF.
destruct (im_dec f i) as [[[j Hj1] Hj2] | Hi]; easy.
Qed.

Lemma unfunF_ub :
   {n1 n2} (f : 'I_{n1,n2}) (A1 : 'E^n1) x0,
    injective f invalF A1 (unfunF f A1 x0).
Proof. move=>> Hf i1; eexists; rewrite (unfunF_correct_l _ i1) //. Qed.

Lemma unfunF_castF :
   {n1 p1 n2} (H1 : n1 = p1) (f : 'I_{n1,n2}) (A1 : 'E^n1) x0,
    injective f unfunF (castF H1 f) (castF H1 A1) x0 = unfunF f A1 x0.
Proof.
intros n1 p1 n2 H1 f A1 x0 Hf; apply extF; intros i2; unfold unfunF.
destruct (im_dec (castF H1 f) i2) as [[k1 Hk1] | Hi2],
    (im_dec f i2) as [[j1 Hj1] | Hi2']; simpl; [| exfalso.. | easy].
unfold castF; rewrite (Hf (cast_ord (eq_sym H1) k1) j1)// Hj1//.
contradict Hi2'. 2: contradict Hi2.
1,2: subst; rewrite castF_id; apply not_all_not_ex_equiv; eexists; easy.
Qed.

Lemma unfunF_eq :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f),
     p, injective p (A1 : 'E^n1) x0,
      unfunF f A1 x0 =
        permutF p
          (castF (injF_plus_minus_r Hf) (concatF A1 (constF (n2 - n1) x0))).
Proof.
intros n1 n2 f Hf; destruct (injF_extend_bij_EX Hf) as [p [Hp1 Hp2]].
(f_inv Hp1); split; [apply bij_inj, f_inv_bij |].
intros A1 x0; apply extF; intros i2.
destruct (im_dec f i2) as [[i1 Hi1] | Hi2]; unfold permutF, castF.
rewrite (unfunF_correct_l _ i1)// -Hi1 Hp2 f_inv_can_l.
assert (Hi1' : (cast_ord (eq_sym (injF_plus_minus_r Hf))
    (widen_ord (m:=n2) (injF_leq Hf) i1) < n1)%coq_nat)
    by now simpl; apply /ltP.
rewrite concatF_correct_l; f_equal; apply ord_inj; easy.
rewrite unfunF_correct_r; [| intros i1 Hi1; apply (Hi2 i1); easy].
assert (¬ (cast_ord (eq_sym (injF_plus_minus_r Hf))
    (f_inv Hp1 i2) < n1)%coq_nat).
  simpl; contradict Hi2; move: Hi2 ⇒ /ltP Hi2.
  apply not_all_not_ex_equiv; (Ordinal Hi2).
  rewrite Hp2; unfold widenF, widen_ord; simpl.
  rewrite -{3}(f_inv_can_r Hp1 i2).
  f_equal; apply ord_inj; easy.
rewrite concatF_correct_r; easy.
Qed.

Lemma unfunF_neqF :
   {n1 n2} {f : 'I_{n1,n2}} {A1 : 'E^n1} {x0},
    injective f unfunF f (neqF A1 x0) False = neqF (unfunF f A1 x0) x0.
Proof.
intros n1 n2 f A1 x0 Hf; apply extF; intros i2; unfold neqF;
    destruct (unfunF_correct A1 x0 i2 Hf) as [[i1 [<- ->]] | [Hi2 ->]].
rewrite (unfunF_correct_l _ i1); easy.
rewrite unfunF_correct_r; [apply prop_ext |]; easy.
Qed.

End FunF_Facts.

Section ExtendPF_Facts.

Context {E : Type}.

Properties of predicate extendPF.

Lemma extendPF_refl : {n} (P : 'Prop^n), extendPF id P P.
Proof. intros n P i; left; i; easy. Qed.

Lemma extendPF_funF :
   {n1 n2} {f : 'I_{n1,n2}} {P2 : 'Prop^n2},
    injective f incl P2 (Rg f) extendPF f (funF f P2) P2.
Proof.
moven1 n2 f P2 Hf /compl_monot HP2 i2;
    destruct (im_dec f i2) as [[i1 <-] | Hi2].
left; i1; easy.
right; split; [| apply HP2; unfold compl]; rewrite Rg_compl; easy.
Qed.

Lemma extendPF_funF_rev :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2},
    injective f extendPF f P1 P2 P1 = funF f P2 incl P2 (Rg f).
Proof.
intros n1 n2 f P1 P2 Hf HP; split.
apply extF; intros i1; destruct (HP (f i1)) as [[i1' [Hi1'a Hi1'b]] | [Hi1 _]].
apply Hf in Hi1'a; subst; easy.
contradict Hi1; easy.
apply incl_compl_equiv; unfold compl.
intros i2 Hi2. destruct (HP i2) as [[i1 [Hi1 _]] | Hi2'];
    [contradict Hi2; subst |]; easy.
Qed.

Lemma extendPF_funF_equiv :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2},
    injective f extendPF f P1 P2 P1 = funF f P2 incl P2 (Rg f).
Proof.
intros; split; [apply extendPF_funF_rev |
    intros [HP1 HP2]; subst; apply extendPF_funF]; easy.
Qed.

Lemma extendPF_funF_neqF :
   {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0},
    injective f incl (neqF A2 x0) (Rg f)
    extendPF f (neqF (funF f A2) x0) (neqF A2 x0).
Proof. move=>> Hf HA2; rewrite -funF_neqF; apply (extendPF_funF Hf HA2). Qed.

Lemma extendPF_funF_neqF_rev :
   {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0},
    injective f
    extendPF f (neqF (funF f A2) x0) (neqF A2 x0) incl (neqF A2 x0) (Rg f).
Proof. move=>> Hf /(extendPF_funF_rev Hf) HA2; easy. Qed.

Lemma extendPF_funF_neqF_equiv :
   {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0},
    injective f
    extendPF f (neqF (funF f A2) x0) (neqF A2 x0)
    incl (neqF A2 x0) (Rg f).
Proof.
move=>> Hf; rewrite (extendPF_funF_equiv Hf).
assert (H : P Q : Prop, P P Q Q) by tauto.
apply H, eq_sym, funF_neqF.
Qed.

Lemma extendPF_unfunF :
   {n1 n2} {f : 'I_{n1,n2}} (P1 : 'Prop^n1),
    injective f extendPF f P1 (unfunF f P1 False).
Proof.
intros n1 n2 f P1 Hf i2; destruct (unfunF_correct P1 False i2 Hf)
    as [[i1 [<- ->]] | [H1 ->]].
left; i1; easy.
right; split; [rewrite Rg_compl |]; easy.
Qed.

Lemma extendPF_unfunF_rev :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2},
    injective f extendPF f P1 P2 P2 = unfunF f P1 False.
Proof.
move=>> Hf HP; apply extF; intros i2;
    destruct (HP i2) as [[i1 [<- <-]] | [Hi2a Hi2b]].
rewrite (unfunF_correct_l _ i1); easy.
rewrite unfunF_correct_r; [apply boolp.notTE | rewrite -Rg_compl]; easy.
Qed.

Lemma extendPF_unfunF_equiv :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2},
    injective f extendPF f P1 P2 P2 = unfunF f P1 False.
Proof.
intros; split; [apply extendPF_unfunF_rev |
    intros; subst; apply extendPF_unfunF]; easy.
Qed.

Lemma extendPF_unfunF_neqF :
   {n1 n2} {f : 'I_{n1,n2}} (A1 : 'E^n1) x0,
    injective f
    extendPF f (neqF A1 x0) (neqF (unfunF f A1 x0) x0).
Proof.
move=>> Hf; apply (extendPF_unfunF_equiv Hf), eq_sym, (unfunF_neqF Hf).
Qed.

Lemma extendPF_permutF :
   {n} {p : 'I_[n]} (P : 'Prop^n),
    injective p extendPF p (permutF p P) P.
Proof.
move=>> Hp i; left; (f_inv (injF_bij Hp) i); split; [| unfold permutF];
    rewrite f_inv_can_r; easy.
Qed.

Lemma extendPF_incrF :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f)
      {P1 : 'Prop^n1} {P2 : 'Prop^n2} (HP : extendPF f P1 P2),
    let q1 := proj1_sig (injF_restr_bij_EX Hf) in
    extendPF (f \o q1) (permutF q1 P1) P2.
Proof.
intros n1 n2 f Hf P1 P2 HP q1.
pose (Hq1a := proj1 (proj2_sig (injF_restr_bij_EX Hf))).
pose (Hq1b := proj2 (proj2_sig (injF_restr_bij_EX Hf))).
pose (p1 := f_inv Hq1a); fold q1 in Hq1a, Hq1b.
apply extendPF_unfunF_equiv; [apply (incrF_inj Hq1b) |].
rewrite (extendPF_unfunF_rev Hf HP); apply extF; intros i2.
destruct (im_dec f i2) as [[k1 <-] | Hi2].
unfold permutF.
rewrite -{2}(f_inv_can_r Hq1a k1) -(comp_correct q1 f); fold p1.
rewrite (unfunF_correct_l _ k1)//
    (unfunF_correct_l _ (p1 k1) _ (incrF_inj Hq1b))//.
unfold p1; rewrite f_inv_can_r; easy.
rewrite !unfunF_correct_r//; intros k1; contradict Hi2.
rewrite not_all_not_ex_equiv; (q1 k1); auto.
Qed.

End ExtendPF_Facts.

Section WidenF_S_liftF_S_Facts1.

Properties of operators widenF_S/liftF_S/widenF.

Context {E : Type}.

Lemma PAF_ind_l :
   {n} {P : 'Prop^n.+1}, P ord0 PAF (liftF_S P) PAF P.
Proof.
intros n P H0 H1 i; destruct (ord_eq_dec i ord0) as [-> | Hi]; [easy |].
rewrite -(lift_lower_S Hi); apply H1.
Qed.

Lemma PAF_ind_r :
   {n} {P : 'Prop^n.+1}, PAF (widenF_S P) P ord_max PAF P.
Proof.
intros n P H0 H1 i; destruct (ord_eq_dec i ord_max) as [-> | Hi]; [easy |].
rewrite -(widen_narrow_S Hi); apply H0.
Qed.

Lemma widenF_S_invalF :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2),
    invalF A1 A2 invalF (widenF_S A1) A2.
Proof. unfold widenF_S; easy. Qed.

Lemma liftF_S_invalF :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2),
    invalF A1 A2 invalF (liftF_S A1) A2.
Proof. unfold liftF_S; easy. Qed.

Lemma widenF_S_0 : {n} (A : 'E^n.+2), widenF_S A ord0 = A ord0.
Proof. intros; unfold widenF_S; rewrite widen_S_0; easy. Qed.

Lemma widenF_S_max :
   {n} (A : 'E^n.+2), widenF_S A ord_max = A ord_pred_max.
Proof. intros; unfold widenF_S; rewrite widen_S_max; easy. Qed.

Lemma liftF_S_0 : {n} (A : 'E^n.+2), liftF_S A ord0 = A ord1.
Proof. intros; unfold liftF_S; rewrite lift_S_0; easy. Qed.

Lemma liftF_S_max : {n} (A : 'E^n.+2), liftF_S A ord_max = A ord_max.
Proof. intros; unfold liftF_S; rewrite lift_S_max; easy. Qed.

Lemma widenF_narrow_S :
   {n} (A : 'E^n.+1) {i} (H : i ord_max),
    widenF_S A (narrow_S H) = A i.
Proof. intros; unfold widenF_S; rewrite widen_narrow_S; easy. Qed.

Lemma liftF_lower_S :
   {n} (A : 'E^n.+1) {i} (H : i ord0), liftF_S A (lower_S H) = A i.
Proof. intros; unfold liftF_S; rewrite lift_lower_S; easy. Qed.

Lemma widenF_S_reg :
   {n} (A B : 'E^n.+1), widenF_S A = widenF_S B eqxF A B ord_max.
Proof.
move=>> H i Hi; rewrite -!(widenF_narrow_S _ Hi); apply (extF_rev _ _ H).
Qed.

Lemma widenF_S_compat :
   {n} (A B : 'E^n.+1), eqxF A B ord_max widenF_S A = widenF_S B.
Proof. move=>> H; apply extF; intro; apply H, widen_S_not_last. Qed.

Lemma eqxFn_equiv :
   {n} (A B : 'E^n.+1), eqxF A B ord_max widenF_S A = widenF_S B.
Proof. intros; split; [apply widenF_S_compat | apply widenF_S_reg]. Qed.

Lemma widenF_S_neqxF_compat :
   {n} (A B : 'E^n.+1), neqxF A B ord_max widenF_S A widenF_S B.
Proof.
move=>>; rewrite contra_not_r_equiv -eqxF_not_equiv; apply widenF_S_reg.
Qed.

Lemma widenF_S_neqxF_reg :
   {n} (A B : 'E^n.+1), widenF_S A widenF_S B neqxF A B ord_max.
Proof.
move=>>; rewrite contra_not_l_equiv -eqxF_not_equiv; apply widenF_S_compat.
Qed.

Lemma neqxFn_equiv :
   {n} (A B : 'E^n.+1), neqxF A B ord_max widenF_S A widenF_S B.
Proof.
intros; split; [apply widenF_S_neqxF_compat | apply widenF_S_neqxF_reg].
Qed.

Lemma liftF_S_reg :
   {n} (A B : 'E^n.+1), liftF_S A = liftF_S B eqxF A B ord0.
Proof.
move=>> H i Hi; rewrite -!(liftF_lower_S _ Hi); apply (extF_rev _ _ H).
Qed.

Lemma liftF_S_compat :
   {n} (A B : 'E^n.+1), eqxF A B ord0 liftF_S A = liftF_S B.
Proof. move=>> H; apply extF; intro; apply H, lift_S_not_first. Qed.

Lemma eqxF0_equiv :
   {n} (A B : 'E^n.+1), eqxF A B ord0 liftF_S A = liftF_S B.
Proof. intros; split; [apply liftF_S_compat | apply liftF_S_reg]. Qed.

Lemma liftF_S_neqxF_compat :
   {n} (A B : 'E^n.+1), neqxF A B ord0 liftF_S A liftF_S B.
Proof.
move=>>; rewrite contra_not_r_equiv -eqxF_not_equiv; apply liftF_S_reg.
Qed.

Lemma liftF_S_neqxF_reg :
   {n} (A B : 'E^n.+1), liftF_S A liftF_S B neqxF A B ord0.
Proof.
move=>>; rewrite contra_not_l_equiv -eqxF_not_equiv; apply liftF_S_compat.
Qed.

Lemma neqxF0_equiv :
   {n} (A B : 'E^n.+1), neqxF A B ord0 liftF_S A liftF_S B.
Proof.
intros; split; [apply liftF_S_neqxF_compat | apply liftF_S_neqxF_reg].
Qed.

Lemma castF_widenF_S :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1.+1),
    castF H (widenF_S A1) = widenF_S (castF (eq_S _ _ H) A1).
Proof.
intros n1 n2 H A1; apply extF; intros i2.
unfold widenF_S, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma widenF_S_castF :
   {n1 n2} (H : n1.+1 = n2.+1) (A1 : 'E^n1.+1),
    widenF_S (castF H A1) = castF (eq_add_S _ _ H) (widenF_S A1).
Proof. intros; rewrite castF_widenF_S; f_equal; apply castF_eq_l. Qed.

Lemma castF_liftF_S :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1.+1),
    castF H (liftF_S A1) = liftF_S (castF (eq_S _ _ H) A1).
Proof.
intros n1 n2 H A1; apply extF; intros i2.
unfold liftF_S, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma liftF_S_castF :
   {n1 n2} (H : n1.+1 = n2.+1) (A1 : 'E^n1.+1),
    liftF_S (castF H A1) = castF (eq_add_S _ _ H) (liftF_S A1).
Proof. intros; rewrite castF_liftF_S; f_equal; apply castF_eq_l. Qed.

Lemma widenF_S_concatF :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2.+1),
    widenF_S (castF (addnS n1 n2) (concatF A1 A2)) = concatF A1 (widenF_S A2).
Proof.
intros n1 n2 A1 A2; apply extF; intros i; unfold widenF_S, widen_S, castF.
destruct (lt_dec i n1) as [Hi | Hi].
rewrite 2!concatF_correct_l; f_equal; apply ord_inj; easy.
rewrite 2!concatF_correct_r; f_equal; apply ord_inj; easy.
Qed.

Lemma liftF_S_concatF :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2),
    liftF_S (castF (addSn n1 n2) (concatF A1 A2)) = concatF (liftF_S A1) A2.
Proof.
intros n1 n2 A1 A2; apply extF; intros i; unfold liftF_S, lift_S, castF.
destruct (lt_dec i n1) as [Hi | Hi].
rewrite concatF_correct_l; auto with arith.
intros; rewrite concatF_correct_l; f_equal; apply ord_inj; easy.
rewrite concatF_correct_r; auto with arith.
intros; rewrite concatF_correct_r; f_equal; apply ord_inj; easy.
Qed.

Lemma widenF_0_alt :
   {n1 n2} (H : n1 n2.+1) (H0 : 0 < n1) {A2 : 'E^n2.+1},
    widenF H A2 (Ordinal H0) = A2 ord0.
Proof. intros; unfold widenF; f_equal; apply ord_inj; easy. Qed.

Lemma widenF_0 :
   {n1 n2} (H : n1.+1 n2.+1) {A2 : 'E^n2.+1},
    widenF H A2 ord0 = A2 ord0.
Proof. intros; rewrite -(widenF_0_alt H (ltn0Sn n1)); easy. Qed.

Lemma widenF_max :
   {n1 n2} (H : n1.+1 n2.+1) {A2 : 'E^n2.+1},
    widenF H A2 ord_max = A2 (Ordinal H).
Proof. intros; unfold widenF; f_equal; apply ord_inj; easy. Qed.

Lemma widenF_nil :
   {n} (A : 'E^n) (x0 : E), widenF (leq_ord ord0) A = (fun x0).
Proof. intros; apply extF; intros [i Hi]; easy. Qed.

Lemma widenF_full : {n} {A : 'E^n}, widenF (leq_ord ord_max) A = A.
Proof.
unfold widenF; intros; apply extF; intro; f_equal; apply ord_inj; easy.
Qed.

Lemma widenF_liftF_S :
   {n1 n2} (H : n1 n2) (A2 : 'E^n2.+1),
    widenF H (liftF_S A2) = liftF_S (widenF (leqS H) A2).
Proof.
intros; apply extF; intro;
    unfold widenF, liftF_S; f_equal; apply ord_inj; easy.
Qed.

Lemma liftF_S_widenF :
   {n1 n2} (H : n1.+1 n2.+1) (A2 : 'E^n2.+1),
    liftF_S (widenF H A2) = widenF (leqS_rev H) (liftF_S A2).
Proof.
intros; apply extF; intro;
    unfold widenF, liftF_S; f_equal; apply ord_inj; easy.
Qed.

Lemma widenF_firstF_eq :
   {n} (A : 'E^n) (j : 'I_n.+1),
    widenF (leq_ord j) A = firstF (castF_nip A j).
Proof.
intros; unfold firstF, castF_nip, castF, widenF.
apply extF; intro; f_equal; apply ord_inj; easy.
Qed.

Lemma liftF_S_charac :
   {n} (P : 'Prop^n.+1), liftF_S (charac P) = charac (liftF_S P).
Proof.
intros n P; apply extF; intros i; destruct (in_dec (liftF_S P) i) as [Hi | Hi].
rewrite (charac_is_1 _ _ Hi); apply charac_is_1; easy.
rewrite (charac_is_0 _ _ Hi); apply charac_is_0; easy.
Qed.

Lemma widenF_S_charac :
   {n} (P : 'Prop^n.+1), widenF_S (charac P) = charac (widenF_S P).
Proof.
intros n P; apply extF; intros i;
    destruct (in_dec (widenF_S P) i) as [Hi | Hi].
rewrite (charac_is_1 _ _ Hi); apply charac_is_1; easy.
rewrite (charac_is_0 _ _ Hi); apply charac_is_0; easy.
Qed.

Context {E1 E2 : Type}.

Lemma widenF_S_mapF :
   (f : E1 E2) {n} (A1 : 'E1^n.+1),
    widenF_S (mapF f A1) = mapF f (widenF_S A1).
Proof. easy. Qed.

Lemma liftF_S_mapF :
   (f : E1 E2) {n} (A1 : 'E1^n.+1),
    liftF_S (mapF f A1) = mapF f (liftF_S A1).
Proof. easy. Qed.

End WidenF_S_liftF_S_Facts1.

Section WidenF_S_liftF_S_Facts2a.

Context {E : Type}.
Context {P : E Prop}.

Context {n1 n2 : nat}.
Hypothesis H : n1 n2.

Lemma widenF_P_compat :
   {A2 : 'E^n2} (j2 : 'I_n2.+1),
    ( (i2 : 'I_j2), P (widenF (leq_ord j2) A2 i2))
     (i1 : 'I_n1), i1 < j2 P (widenF H A2 i1).
Proof.
intros A2 j2 HA2 i1 Hi1.
replace (widenF _ _ _) with (widenF (leq_ord j2) A2 (Ordinal Hi1)); [easy |].
unfold widenF; f_equal; apply ord_inj; easy.
Qed.

End WidenF_S_liftF_S_Facts2a.

Section WidenF_S_liftF_S_Facts2b.

Context {E : Type}.
Context {P : E Prop}.

Context {n1 n2 : nat}.
Hypothesis H : n1 n2.

Lemma widenF_0_P_compat :
   {A2 : 'E^n2.+1} {j2 : 'I_n2.+2} (Hj2 : j2 ord0),
    ( (i2 : 'I_j2), P (widenF (leq_ord j2) A2 i2)) P (A2 ord0).
Proof.
intros A2 j2 Hj2 HA2; rewrite -(widenF_0 (ltn0Sn n2)).
apply (widenF_P_compat _ j2 HA2); clear E P A2 HA2.
apply ord_n0_gtn_equiv; easy.
Qed.

Lemma widenF_liftF_S_P_compat :
   {A2 : 'E^n2.+1} {j2 : 'I_n2.+2} (Hj2 : j2 ord0),
    ( (i2 : 'I_j2), P (widenF (leq_ord j2) A2 i2))
     (i1 : 'I_n1), i1 < lower_S Hj2 P (widenF H (liftF_S A2) i1).
Proof.
intros A2 j2 Hj2a HA2; apply widenF_P_compat; intros i1.
assert (Hi1 : lift_S i1 < j2).
  rewrite lift_S_correct; destruct i1 as [i1 Hi1]; simpl.
  move: Hi1; rewrite lower_S_correct; apply ltnP_gtnS.
  move: Hj2a; move⇒ /ord_neq_compat; easy.
replace (widenF _ _ _) with (widenF (leq_ord j2) A2 (Ordinal Hi1)); [easy |].
unfold widenF, liftF_S; f_equal; apply ord_inj; easy.
Qed.

End WidenF_S_liftF_S_Facts2b.

Section FirstF_lastF_Facts.

Context {E : Type}.

Properties of operators firstF/lastF.

Lemma firstF_compat :
   {n1 n2} (A B : 'E^(n1 + n2)),
    ( i : 'I_(n1 + n2), (i < n1)%coq_nat A i = B i)
    firstF A = firstF B.
Proof.
intros n1 n2 A B H; apply extF; intros [i Hi]; apply H; apply /ltP; easy.
Qed.

Lemma lastF_compat :
   {n1 n2} (A B : 'E^(n1 + n2)),
    ( i : 'I_(n1 + n2), (n1 i)%coq_nat A i = B i)
    lastF A = lastF B.
Proof.
intros n1 n2 A B H; apply extF; intro; apply H; apply /leP; apply leq_addr.
Qed.

Lemma firstF_0 : {n1 n2} (A : 'E^(n1.+1 + n2)), firstF A ord0 = A ord0.
Proof. intros; unfold firstF; f_equal; apply ord_inj; easy. Qed.

Lemma lastF_max :
   {n1 n2} (A : 'E^(n1 + n2.+1)),
    lastF A ord_max = castF (addnS n1 n2) A ord_max.
Proof. intros; unfold lastF, castF; f_equal; apply ord_inj; easy. Qed.

Lemma firstF_castF :
   {p} m1 m2 {n1} n2 (H1 : m1 = n1) (Hm : p = m1 + m2) (Hn : p = n1 + n2)
      (A : 'E^p),
    firstF (castF Hn A) = castF H1 (firstF (castF Hm A)).
Proof.
intros; apply extF; intro; unfold firstF, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma lastF_castF :
   {p} m1 m2 n1 {n2} (H2 : m2 = n2) (Hm : p = m1 + m2) (Hn : p = n1 + n2)
      (A : 'E^p),
    lastF (castF Hn A) = castF H2 (lastF (castF Hm A)).
Proof.
intros p m1 m2 n1 n2 H2 Hm Hn A; apply extF; intro; unfold lastF, castF.
f_equal; apply ord_inj; simpl; subst; f_equal; apply addn_inj_l in Hn; easy.
Qed.

Lemma firstF_Sp1 :
   {n} (A : 'E^n.+1), firstF (castF_Sp1 A) = widenF_S A.
Proof.
intros; apply extF; intro; unfold firstF, castF_Sp1, castF, widenF_S;
    f_equal; apply ord_inj; easy.
Qed.

Lemma lastF_Sp1 :
   {n} (A : 'E^n.+1), lastF (castF_Sp1 A) = singleF (A ord_max).
Proof.
intros; apply extF; intro; rewrite I_1_is_unit singleF_0.
unfold lastF, castF_Sp1, castF; f_equal; apply ord_inj; apply addn0.
Qed.

Lemma firstF_S1p :
   {n} (A : 'E^n.+1), firstF (castF_S1p A) = singleF (A ord0).
Proof.
intros; apply extF; intro; rewrite I_1_is_unit singleF_0.
unfold firstF, castF_S1p, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma lastF_S1p : {n} (A : 'E^n.+1), lastF (castF_S1p A) = liftF_S A.
Proof.
intros; apply extF; intro; unfold lastF, castF_S1p, castF, liftF_S;
    f_equal; apply ord_inj; auto with arith.
Qed.

Lemma firstF_ord_splitS :
   {n} (A : 'E^n.+1) i0,
    firstF (castF (ord_splitS i0) A) =
    widenF_S (firstF (castF (ordS_splitS i0) A)).
Proof.
intros; apply extF; intro; unfold firstF, widenF_S, castF;
    f_equal; apply ord_inj; easy.
Qed.

Lemma firstF_ordS_splitS_last :
   {n} (A : 'E^n.+1) i0,
    firstF (castF (ordS_splitS i0) A) ord_max = A i0.
Proof. intros; unfold firstF, castF; f_equal; apply ord_inj; easy. Qed.

Lemma lastF_ord_splitS_first :
   {n} (A : 'E^n.+1) i0, lastF (castF (ord_splitS i0) A) ord0 = A i0.
Proof. intros; unfold lastF, castF; f_equal; apply ord_inj; apply addn0. Qed.

Lemma lastF_ordS_splitS :
   {n} (A : 'E^n.+1) i0,
    lastF (castF (ordS_splitS i0) A) =
    liftF_S (lastF (castF (ord_splitS i0) A)).
Proof.
intros; apply extF; intro; unfold lastF, liftF_S, castF;
    f_equal; apply ord_inj; simpl.
rewrite bump_r; try apply addSnnS; auto with arith.
Qed.

Lemma firstF2 :
   {n1 n2 n3} (A : 'E^((n1 + n2) + n3)),
    firstF (firstF A) = firstF (castF (eq_sym (addnA n1 n2 n3)) A).
Proof.
intros; apply extF; intro; unfold firstF, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma lastF2 :
   {n1 n2 n3} (A : 'E^(n1 + (n2 + n3))),
    lastF (lastF A) = lastF (castF (addnA n1 n2 n3) A).
Proof.
intros; apply extF; intro; unfold lastF, castF; f_equal; apply ord_inj, addnA.
Qed.

Lemma liftF_S_firstF :
   {n1 n2} (A : 'E^(n1.+1 + n2)),
    liftF_S (firstF A) = firstF (liftF_S (castF (addSn n1 n2) A)).
Proof.
intros; apply extF; intro;
    unfold liftF_S, firstF, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma widenF_S_lastF :
   {n1 n2} (A : 'E^(n1 + n2.+1)),
    widenF_S (lastF A) = lastF (widenF_S (castF (addnS n1 n2) A)).
Proof.
intros; apply extF; intro;
    unfold widenF_S, lastF, castF; f_equal; apply ord_inj; easy.
Qed.

Lemma firstF_concatF :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2), firstF (concatF A1 A2) = A1.
Proof.
intros n1 n2 A1 A2; apply extF; intros i1; unfold firstF, concatF.
destruct (lt_dec _ _) as [Hi1 | Hi1].
rewrite concat_l_first; easy.
contradict Hi1; apply /ltP; simpl; easy.
Qed.

Lemma lastF_concatF :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2), lastF (concatF A1 A2) = A2.
Proof.
intros n1 n2 A1 A2; apply extF; intros i2; unfold lastF, concatF.
destruct (lt_dec _ _) as [Hi2 | Hi2].
contradict Hi2; apply Nat.le_ngt; apply /leP; simpl; apply leq_addr.
rewrite concat_r_last; easy.
Qed.

Lemma concatF_splitF :
   {n1 n2} (A : 'E^(n1 + n2)), A = concatF (firstF A) (lastF A).
Proof.
intros n1 n2 A; apply extF; intros i.
destruct (lt_dec i n1) as [Hi | Hi]; [unfold firstF | unfold lastF].
rewrite concatF_correct_l; f_equal; apply ord_inj; easy.
rewrite concatF_correct_r; f_equal; apply ord_inj; simpl.
symmetry; apply subnKC; apply /leP; auto with zarith.
Qed.

Lemma concatF_splitF_S1p :
   {n} (A : 'E^n.+1),
    A = castF_1pS (concatF (singleF (A ord0)) (liftF_S A)).
Proof.
intros; rewrite -firstF_S1p -lastF_S1p -concatF_splitF castF_1pS_S1p; easy.
Qed.

Lemma concatF_splitF_S1p' :
   {n} (A : 'E^n.+1),
    concatF (singleF (A ord0)) (liftF_S A) = castF_S1p A.
Proof. intros n A; rewrite {3}(concatF_splitF_S1p A) castF_S1p_1pS; easy. Qed.

Lemma concatF_splitF_Sp1 :
   {n} (A : 'E^n.+1),
    A = castF_p1S (concatF (widenF_S A) (singleF (A ord_max))).
Proof.
intros; rewrite -firstF_Sp1 -lastF_Sp1 -concatF_splitF castF_p1S_Sp1; easy.
Qed.

Lemma concatF_splitF_Sp1' :
   {n} (A : 'E^n.+1),
    concatF (widenF_S A) (singleF (A ord_max)) = castF_Sp1 A.
Proof. intros n A; rewrite {3}(concatF_splitF_Sp1 A) castF_Sp1_p1S; easy. Qed.

Lemma splitF_compat :
   {n1 n2} (A B : 'E^(n1 + n2)),
    A = B firstF A = firstF B lastF A = lastF B.
Proof. intros; split; f_equal; easy. Qed.

Lemma splitF_reg :
   {n1 n2} (A B : 'E^(n1 + n2)),
    firstF A = firstF B lastF A = lastF B A = B.
Proof.
intros n1 n2 A B H1 H2; rewrite (concatF_splitF A) H1 H2 -concatF_splitF; easy.
Qed.

Lemma extF_splitF :
   {n n1 n2} (H : n = n1 + n2) (A B : 'E^n),
    firstF (castF H A) = firstF (castF H B)
    lastF (castF H A) = lastF (castF H B)
    A = B.
Proof. intros n n1 n2 H A B Hf Hl; apply (castF_inj H), splitF_reg; easy. Qed.

Lemma extF_ind_l :
{n} (A B : 'E^n.+1),
    A ord0 = B ord0 liftF_S A = liftF_S B A = B.
Proof. intros; apply extF_liftF_S; easy. Qed.

Lemma extF_ind_r :
{n} (A B : 'E^n.+1),
    widenF_S A = widenF_S B A ord_max = B ord_max A = B.
Proof. intros; apply extF_widenF_S; easy. Qed.

Lemma firstF_insertF :
   {n} (A : 'E^n) x0 i0,
    firstF (castF (ord_splitS i0) (insertF A x0 i0)) =
    firstF (castF (ord_split i0) A).
Proof.
intros n A x0 i0; apply extF; intros [i Hi]; unfold firstF, castF;
    rewrite insertF_correct_rl; try now apply /ltP.
intros; f_equal; apply ord_inj; easy.
Qed.

Lemma lastF_insertF :
   {n} (A : 'E^n) x0 i0,
    lastF (castF (ordS_splitS i0) (insertF A x0 i0)) =
    lastF (castF (ord_split i0) A).
Proof.
intros n A x0 i0; apply extF; intros [i Hi]; unfold lastF, castF;
    rewrite insertF_correct_rr; try now (apply /ltP; apply ltn_addr).
intros; f_equal; apply ord_inj; simpl; rewrite <- addnBAC, subn1; easy.
Qed.

Lemma firstF_skipF :
   {n} (A : 'E^n.+1) i0,
    firstF (castF (ord_split i0) (skipF A i0)) =
    firstF (castF (ord_splitS i0) A).
Proof.
intros n A i0; apply extF; intros i; unfold firstF, skipF, castF;
    f_equal; apply ord_inj; simpl.
apply bump_l; destruct i; apply /ltP; easy.
Qed.

Lemma lastF_skipF :
   {n} (A : 'E^n.+1) i0,
    lastF (castF (ord_split i0) (skipF A i0)) =
    lastF (castF (ordS_splitS i0) A).
Proof.
intros; apply extF; intro; unfold lastF, skipF, castF;
    f_equal; apply ord_inj; simpl.
apply bump_r, Nat.le_add_r.
Qed.

Lemma firstF_replaceF :
   {n} (A : 'E^n) x0 i0,
    firstF (castF (ord_split_pred i0) (replaceF A x0 i0)) =
    firstF (castF (ord_split_pred i0) A).
Proof.
intros n A x0 [i0 Hi0]; apply extF; intros [i Hi]; unfold firstF, castF;
    rewrite replaceF_correct_r; try easy.
apply ord_neq; simpl in *; contradict Hi; rewrite Hi.
move⇒ /ltP H; auto with zarith.
Qed.

Lemma lastF_replaceF :
   {n} (A : 'E^n) x0 i0,
    lastF (castF (ordS_split i0) (replaceF A x0 i0)) =
    lastF (castF (ordS_split i0) A).
Proof.
intros n A x0 [i0 Hi0]; apply extF; intros [i Hi]; unfold lastF, castF;
    rewrite replaceF_correct_r; try easy.
apply ord_neq; simpl; rewrite -plusE; auto with zarith.
Qed.

End FirstF_lastF_Facts.

Section ConcatF_Facts.

Context {E : Type}.

Properties of operator concatF.

Lemma concatF_eq :
   {n1 n2} (A1 B1 : 'E^n1) (A2 B2 : 'E^n2),
    A1 = B1 A2 = B2 concatF A1 A2 = concatF B1 B2.
Proof. intros; f_equal; easy. Qed.

Lemma concatF_inj_l :
   {n1 n2} (A1 B1 : 'E^n1) (A2 B2 : 'E^n2),
    concatF A1 A2 = concatF B1 B2 A1 = B1.
Proof.
intros n1 n2 A1 B1 A2 B2 H.
rewrite -(firstF_concatF A1 A2) -(firstF_concatF B1 B2); rewrite H; easy.
Qed.

Lemma concatF_inj_r :
   {n1 n2} (A1 B1 : 'E^n1) (A2 B2 : 'E^n2),
    concatF A1 A2 = concatF B1 B2 A2 = B2.
Proof.
intros n1 n2 A1 B1 A2 B2 H.
rewrite -(lastF_concatF A1 A2) -(lastF_concatF B1 B2); rewrite H; easy.
Qed.

Lemma concatF_inj :
   {n1 n2} (A1 B1 : 'E^n1) (A2 B2 : 'E^n2),
    concatF A1 A2 = concatF B1 B2 A1 = B1 A2 = B2.
Proof.
intros n1 n2 A1 B1 A2 B2 H; split;
    [apply (concatF_inj_l _ _ A2 B2) | apply (concatF_inj_r A1 B1)]; easy.
Qed.

Lemma concatF_nextF_compat_l :
   {n1 n2} {A1 B1 : 'E^n1} (A2 B2 : 'E^n2),
    A1 B1 concatF A1 A2 concatF B1 B2.
Proof.
intros n1 n2 A1 B1 A2 B2 H; contradict H.
destruct (concatF_inj _ _ _ _ H); easy.
Qed.

Lemma concatF_nextF_compat_r :
   {n1 n2} (A1 B1 : 'E^n1) {A2 B2 : 'E^n2},
    A2 B2 concatF A1 A2 concatF B1 B2.
Proof.
intros n1 n2 A1 B1 A2 B2 H; contradict H.
destruct (concatF_inj _ _ _ _ H); easy.
Qed.

Lemma concatF_nextF_reg :
   {n1 n2} {A1 B1 : 'E^n1} {A2 B2 : 'E^n2},
    concatF A1 A2 concatF B1 B2 A1 B1 A2 B2.
Proof.
move=>> H; apply not_and_or; contradict H; apply concatF_eq; easy.
Qed.

Lemma concatF_nextF_equiv :
   {n1 n2} {A1 B1 : 'E^n1} {A2 B2 : 'E^n2},
    concatF A1 A2 concatF B1 B2 A1 B1 A2 B2.
Proof.
intros; split; [apply concatF_nextF_reg | intros [H | H]];
    [apply concatF_nextF_compat_l | apply concatF_nextF_compat_r]; easy.
Qed.

Lemma concatF_nil_l :
   {n2} (A1 : 'E^0) (A2 : 'E^n2), concatF A1 A2 = A2.
Proof.
intros n2 A1 A2; unfold concatF; apply extF; intro.
destruct (lt_dec _ _); try easy.
f_equal; apply ord_inj; simpl; auto with arith.
Qed.

Lemma concatF_nil_l' :
   {n1 n2} (H : n1 = 0) (A1 : 'E^n1) (A2 : 'E^n2),
    concatF A1 A2 = castF (eq_sym (nat_plus_0_l H)) A2.
Proof.
intros; subst; rewrite concatF_nil_l; apply extF; intro.
unfold castF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_nil_r :
   {n1} (A1 : 'E^n1) (A2 : 'E^0),
    concatF A1 A2 = castF (addn0_sym n1) A1.
Proof.
intros n1 A1 A2; unfold concatF, castF; apply extF; intros i.
destruct (lt_dec _ _) as [Hi | Hi].
f_equal; apply ord_inj; auto with arith.
contradict Hi; destruct i; simpl; apply /ltP; rewrite (addn0_sym n1); easy.
Qed.

Lemma concatF_nil_r' :
   {n1 n2} (H : n2 = 0) (A1 : 'E^n1) (A2 : 'E^n2),
    concatF A1 A2 = castF (eq_sym (nat_plus_0_r H)) A1.
Proof.
intros; subst; rewrite concatF_nil_r; apply extF; intro.
unfold castF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_first :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2),
    castF (addSn n1 n2) (concatF A1 A2) ord0 = A1 ord0.
Proof.
intros n1 n2 A1 A2; rewrite -{2}(firstF_concatF A1 A2).
unfold castF, firstF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_last :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2.+1),
    castF (addnS n1 n2) (concatF A1 A2) ord_max = A2 ord_max.
Proof.
intros n1 n2 A1 A2; rewrite -{2}(lastF_concatF A1 A2).
unfold castF, lastF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_constF :
   {n1 n2} (x : E),
    concatF (constF n1 x) (constF n2 x) = constF (n1 + n2) x.
Proof.
intros; apply extF; intros i; destruct (lt_dec i n1).
rewrite concatF_correct_l; easy.
rewrite concatF_correct_r; easy.
Qed.

Lemma concatF_singleF_2 :
   (x0 x1 : E), concatF (singleF x0) (singleF x1) = coupleF x0 x1.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi;
    [rewrite coupleF_0 | rewrite coupleF_1]; easy.
Qed.

Lemma concatF_singleF_1_2 :
   (x0 x1 x2 : E),
    concatF (singleF x0) (concatF (singleF x1) (singleF x2)) =
        tripleF x0 x1 x2.
Proof.
intros; apply extF; intros i; destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi;
    [rewrite tripleF_0 | rewrite tripleF_1 | rewrite tripleF_2]; easy.
Qed.

Lemma concatF_singleF_2_1 :
   (x0 x1 x2 : E),
    concatF (concatF (singleF x0) (singleF x1)) (singleF x2) =
        tripleF x0 x1 x2.
Proof.
intros; apply extF; intros i; destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi;
    [rewrite tripleF_0 | rewrite tripleF_1 | rewrite tripleF_2]; easy.
Qed.

Lemma concatF_singleF_coupleF :
   (x0 x1 x2 : E), concatF (singleF x0) (coupleF x1 x2) = tripleF x0 x1 x2.
Proof. intros; rewrite -concatF_singleF_1_2 concatF_singleF_2; easy. Qed.

Lemma concatF_coupleF_singleF :
   (x0 x1 x2 : E), concatF (coupleF x0 x1) (singleF x2) = tripleF x0 x1 x2.
Proof. intros; rewrite -concatF_singleF_2_1 concatF_singleF_2; easy. Qed.

Lemma concatF_ub_l :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2), invalF A1 (concatF A1 A2).
Proof.
intros n1 n2 A1 A2 i1; eexists; rewrite -{1}(firstF_concatF A1 A2); easy.
Qed.

Lemma concatF_ub_r :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2), invalF A2 (concatF A1 A2).
Proof.
intros n1 n2 A1 A2 i2; eexists; rewrite -{1}(lastF_concatF A1 A2); easy.
Qed.

Lemma concatF_lub_invalF :
   {n1 n2 n} (A1 : 'E^n1) (A2 : 'E^n2) (A : 'E^n),
    invalF A1 A invalF A2 A invalF (concatF A1 A2) A.
Proof.
intros n1 n2 n A1 A2 A HA1 HA2 i; destruct (lt_dec i n1).
rewrite concatF_correct_l; apply HA1.
rewrite concatF_correct_r; apply HA2.
Qed.

Lemma concatF_lub_inclF :
   {n1 n2} PE (A1 : 'E^n1) (A2 : 'E^n2),
    inclF A1 PE inclF A2 PE inclF (concatF A1 A2) PE.
Proof.
intros n1 n2 PE A1 A2 H1 H2 i; destruct (lt_dec i n1).
rewrite concatF_correct_l; easy.
rewrite concatF_correct_r; easy.
Qed.

Lemma concatF_inclF_reg_l :
   {n1 n2} {PE} {A1 : 'E^n1} (A2 : 'E^n2),
    inclF (concatF A1 A2) PE inclF A1 PE.
Proof.
intros n1 n2 PE A1 A2 H i1; rewrite -(firstF_concatF A1 A2); apply H.
Qed.

Lemma concatF_inclF_reg_r :
   {n1 n2} {PE} (A1 : 'E^n1) {A2 : 'E^n2},
    inclF (concatF A1 A2) PE inclF A2 PE.
Proof.
intros n1 n2 PE A1 A2 H i2; rewrite -(lastF_concatF A1 A2); apply H.
Qed.

Lemma concatF_inclF_equiv :
   {n1 n2} {PE} (A1 : 'E^n1) (A2 : 'E^n2),
    inclF (concatF A1 A2) PE inclF A1 PE inclF A2 PE.
Proof.
intros; split; intros H.
split; [apply (concatF_inclF_reg_l _ H) | apply (concatF_inclF_reg_r _ H)].
apply concatF_lub_inclF; easy.
Qed.

Lemma concatFP :
   (P : E Prop) {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2),
    ( i, P (concatF A1 A2 i))
    ( i1, P (A1 i1)) ( i2, P (A2 i2)).
Proof.
intros P n1 n2 A1 A2; split; intros HA; [split | ]; intros i.
destruct (lt_dec (first_ord n2 i) n1) as [Hi | Hi].
specialize (HA (first_ord n2 i)).
rewrite (concatF_correct_l _ _ _ Hi) concat_l_first in HA; easy.
contradict Hi; destruct i as [i Hi]; apply /ltP; easy.
destruct (lt_dec (last_ord n1 i) n1) as [Hi | Hi].
contradict Hi; destruct i as [i Hi]; apply Nat.nlt_ge; apply /leP; apply leq_addr.
specialize (HA (last_ord n1 i)).
rewrite (concatF_correct_r _ _ _ Hi) concat_r_last in HA; easy.
destruct HA as [HA1 Ha2], (lt_dec i n1) as [Hi | Hi].
rewrite concatF_correct_l; easy.
rewrite concatF_correct_r; easy.
Qed.

Lemma concatF_castF :
   {n1 n2 m1 m2} (H1 : n1 = m1) (H2 : n2 = m2) (A1 : 'E^n1) (A2 : 'E^n2),
    concatF (castF H1 A1) (castF H2 A2) =
      castF (f_equal2_plus _ _ _ _ H1 H2) (concatF A1 A2).
Proof.
intros; subst; apply extF; intro.
rewrite !castF_id; unfold castF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_castF_l :
   {n1 m1 n2} (H1 : n1 = m1) (A1 : 'E^n1) (A2 : 'E^n2),
    concatF (castF H1 A1) A2 =
      castF (f_equal (Nat.add^~ n2) H1) (concatF A1 A2).
Proof.
intros; subst; apply extF; intro.
rewrite castF_id; unfold castF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_castF_r :
   {n1 n2 m2} (H2 : n2 = m2) (A1 : 'E^n1) (A2 : 'E^n2),
    concatF A1 (castF H2 A2) = castF (f_equal (Nat.add n1) H2) (concatF A1 A2).
Proof.
intros; subst; apply extF; intro.
rewrite castF_id; unfold castF; f_equal; apply ord_inj; easy.
Qed.

Lemma concatF_assoc_r :
   {n1 n2 n3} (A1 : 'E^n1) (A2 : 'E^n2) (A3 : 'E^n3),
    concatF A1 (concatF A2 A3) =
        castF (eq_sym (Nat.add_assoc n1 n2 n3)) (concatF (concatF A1 A2) A3).
Proof.
intros n1 n2 n3 A1 A2 A3; apply extF; intros i; unfold castF.
destruct (lt_dec i n1) as [Hi1|Hi1].
rewrite concatF_correct_l; try easy.
rewrite concatF_correct_l; try easy.
simpl; auto with arith.
intros K1.
rewrite concatF_correct_l; try easy.
f_equal; apply ord_inj; easy.
rewrite concatF_correct_r; try easy.
destruct (lt_dec i (n1+n2)%coq_nat) as [Hi2|Hi2].
rewrite concatF_correct_l; try easy.
simpl; rewrite -minusE; auto with zarith.
intros K1.
rewrite concatF_correct_l; try easy.
rewrite concatF_correct_r; try easy.
f_equal; apply ord_inj; easy.
rewrite concatF_correct_r; try easy.
simpl; rewrite -minusE; auto with zarith.
intros K1.
rewrite concatF_correct_r; try easy.
f_equal; apply ord_inj; simpl.
repeat rewrite -minusE.
apply eq_sym, Nat.sub_add_distr.
Qed.

Lemma concatF_assoc_l :
   {n1 n2 n3} (A1 : 'E^n1) (A2 : 'E^n2) (A3 : 'E^n3),
    concatF (concatF A1 A2) A3 =
      castF (Nat.add_assoc n1 n2 n3) (concatF A1 (concatF A2 A3)).
Proof. intros; rewrite concatF_assoc_r castF_can; easy. Qed.

Lemma concatF_castF_eq :
   {n1 m1 n2 m2 l} (A1:'E^n1) (B1:'E^m1) (A2:'E^n2) (B2:'E^m2)
    (H1 : n1+m1= l) (H2:n2+m2=l) (H3: n1 = n2) (H4: m1 = m2),
    castF H3 A1 = A2 castF H4 B1 = B2
    castF H1 (concatF A1 B1) = castF H2 (concatF A2 B2).
Proof.
intros n1 m1 n2 m2 l A1 B1 A2 B2 H1 H2 H3 H4 M1 M2.
apply extF; intros i; unfold castF.
destruct (lt_dec i n1) as [Hi|Hi].
rewrite 2!concatF_correct_l; try easy.
simpl; rewrite -H3; auto with arith.
intros K1.
rewrite -M1; unfold castF.
f_equal; apply ord_inj; simpl; easy.
rewrite 2!concatF_correct_r; try easy.
simpl; rewrite -H3; auto with arith.
intros K1.
rewrite -M2; unfold castF.
f_equal; apply ord_inj; simpl; rewrite H3; easy.
Qed.

End ConcatF_Facts.

Section InsertF_Facts.

Context {E : Type}.

Properties of operators insertF/insert2F.

Lemma insertF_eq_gen :
   {n} (A B : 'E^n) x0 y0 i0 j0,
    A = B x0 = y0 i0 = j0 insertF A x0 i0 = insertF B y0 j0.
Proof. intros; f_equal; easy. Qed.

Lemma insertF_eq :
   {n} (A B : 'E^n) x0 y0 i0,
    A = B x0 = y0 insertF A x0 i0 = insertF B y0 i0.
Proof. intros; f_equal; easy. Qed.

Lemma insertF_inj_l :
   {n} (A B : 'E^n) x0 y0 i0,
    insertF A x0 i0 = insertF B y0 i0 A = B.
Proof.
moven A B x0 y0 i0 /extF_rev H; apply extF; intros i;
    specialize (H (lift i0 i));
    destruct (lt_dec (lift i0 i) i0) as [Hi' | Hi'].
rewrite 2!insertF_correct_rl in H; replace (narrow_S _) with i in H; try easy.
apply ord_inj; rewrite narrow_S_correct lift_l; try easy.
apply lift_lt_l; easy.
apply Nat.nlt_ge in Hi'; destruct (le_lt_eq_dec _ _ Hi') as [Hi'' | Hi''].
rewrite 2!insertF_correct_rr in H; replace (lower_S _) with i in H; try easy.
apply ord_inj; rewrite lower_S_correct lift_r; try easy.
apply lift_lt_r; easy.
contradict Hi''; apply lift_m.
Qed.

Lemma insertF_inj_r :
   {n} (A B : 'E^n) x0 y0 i0,
    insertF A x0 i0 = insertF B y0 i0 x0 = y0.
Proof.
moven A B x0 y0 i0 /extF_rev H; specialize (H i0); simpl in H.
rewrite → 2!insertF_correct_l in H; easy.
Qed.

Lemma insertF_inj :
   {n} (A B : 'E^n) x0 y0 i0,
    insertF A x0 i0 = insertF B y0 i0 A = B x0 = y0.
Proof.
move=>> H; split; [eapply insertF_inj_l | eapply insertF_inj_r]; apply H.
Qed.

Lemma insertF_nextF_compat_l :
   {n} {A B : 'E^n} x0 y0 i0,
    A B insertF A x0 i0 insertF B y0 i0.
Proof. move=>> H; contradict H; apply insertF_inj in H; easy. Qed.

Lemma insertF_nextF_compat_r :
   {n} (A B : 'E^n) {x0 y0} i0,
    x0 y0 insertF A x0 i0 insertF B y0 i0.
Proof. move=>> H; contradict H; apply insertF_inj in H; easy. Qed.

Lemma insertF_nextF_reg :
   {n} {A B : 'E^n} {x0 y0} i0,
    insertF A x0 i0 insertF B y0 i0 A B x0 y0.
Proof.
move=>> H; apply not_and_or; contradict H; apply insertF_eq; easy.
Qed.

Lemma insertF_nextF_equiv :
   {n} {A B : 'E^n} {x0 y0} i0,
    insertF A x0 i0 insertF B y0 i0 A B x0 y0.
Proof.
intros; split; [apply insertF_nextF_reg | intros [H | H]];
    [apply insertF_nextF_compat_l | apply insertF_nextF_compat_r]; easy.
Qed.

Lemma insertF_constF :
   {n} (x : E) i0, insertF (constF n x) x i0 = constF n.+1 x.
Proof.
intros n x i0; apply extF; intros i; destruct (ord_eq_dec i i0).
rewriteinsertF_correct_l, constF_correct; easy.
rewrite insertF_correct_r 2!constF_correct; easy.
Qed.

Lemma insertF_singleF_0 :
   (x0 x1 : E), insertF (singleF x1) x0 ord0 = coupleF x0 x1.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewrite coupleF_0; try apply insertF_correct_l; easy.
rewrite coupleF_1; try rewrite insertF_correct_rr; try apply /ltP; easy.
Qed.

Lemma insertF_singleF_1 :
   (x0 x1 : E), insertF (singleF x0) x1 ord_max = coupleF x0 x1.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewrite coupleF_0; try rewrite insertF_correct_rl; try apply /ltP; easy.
rewrite coupleF_1; try apply insertF_correct_l; easy.
Qed.

Lemma insertF_coupleF_0 :
   (x0 x1 x2 : E), insertF (coupleF x1 x2) x0 ord0 = tripleF x0 x1 x2.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewrite tripleF_0; try apply insertF_correct_l; easy.
rewrite tripleF_1 insertF_correct_rr (extF_compat _ _ ord0);
    [apply coupleF_0 | apply ord_inj; easy].
rewrite tripleF_2 insertF_correct_rr; [now apply /ltP |].
intros; erewrite extF_compat; [apply coupleF_1 | apply ord_inj]; easy.
Qed.

Lemma insertF_coupleF_1 :
   (x0 x1 x2 : E), insertF (coupleF x0 x2) x1 ord1 = tripleF x0 x1 x2.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewrite tripleF_0 insertF_correct_rl (extF_compat _ _ ord0);
    [apply coupleF_0 | apply ord_inj; easy].
rewrite tripleF_1; try apply insertF_correct_l; easy.
rewrite tripleF_2 insertF_correct_rr (extF_compat _ _ ord_max);
    [apply coupleF_1 | apply ord_inj; easy].
Qed.

Lemma insertF_coupleF_2 :
   (x0 x1 x2 : E), insertF (coupleF x0 x1) x2 ord_max = tripleF x0 x1 x2.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewrite tripleF_0; try easy; rewrite insertF_correct_rl; [now apply /ltP |].
intros; erewrite extF_compat; [apply coupleF_0 | apply ord_inj]; easy.
rewrite tripleF_1 insertF_correct_rl (extF_compat _ _ ord_max);
    [apply coupleF_1 | apply ord_inj; easy].
rewrite tripleF_2; try apply insertF_correct_l; easy.
Qed.

Lemma insertF_monot_inclF :
   (PE : E Prop) {n} (A : 'E^n) x0 i0,
    inclF A PE PE x0 inclF (insertF A x0 i0) PE.
Proof.
intros PE n A x0 i0 HA Hx0 i; destruct (ord_eq_dec i i0) as [Hi | Hi].
rewrite insertF_correct_l; easy.
rewrite insertF_correct_r; auto.
Qed.

Lemma insertF_monot_invalF_l :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2) x0 i0,
    invalF A1 A2 inF x0 A2 invalF (insertF A1 x0 i0) A2.
Proof.
intros n1 n2 A1 A2 x0 i0 HA [i2 Hi2] i1;
    destruct (ord_eq_dec i1 i0) as [Hi1 | Hi1].
i2; rewrite Hi2; apply insertF_correct_l; easy.
destruct (HA (insert_ord Hi1)) as [k2 Hk2].
k2; rewrite -Hk2; apply insertF_correct_r.
Qed.

Lemma insertF_monot_invalF_r :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2) x0 i0,
    invalF A1 A2 invalF A1 (insertF A2 x0 i0).
Proof.
intros n1 n2 A1 A2 x0 i0 HA i1; destruct (HA i1) as [j2 Hj2].
(skip_ord i0 j2); rewrite insertF_correct; easy.
Qed.

Lemma insertF_concatF_0 :
   {n} (A : 'E^n) x0,
    insertF A x0 ord0 = castF_1pS (concatF (singleF x0) A).
Proof.
intros; unfold castF_1pS; rewrite castF_id.
apply extF; intros i; destruct (ord_eq_dec i ord0) as [Hi | Hi].
rewrite Hi insertF_correct_l// concatF_correct_l; easy.
assert (Hi' : ¬ (cast_ord (eq_sym (add1n n)) i < 1)%coq_nat)
    by now rewrite cast_ord_id; apply ord_n0_nlt_equiv.
rewrite insertF_correct_r insert_concat_r_ord_0 concatF_correct_r.
f_equal; apply ord_inj; easy.
Qed.

Lemma insertF_concatF_max :
   {n} (A : 'E^n) x0,
    insertF A x0 ord_max = castF_p1S (concatF A (singleF x0)).
Proof.
intros n A x0; unfold castF_p1S, castF.
apply extF; intros i; destruct (ord_eq_dec i ord_max) as [Hi | Hi].
rewrite Hi insertF_correct_l// concatF_correct_r singleF_0; easy.
assert (Hi' : (cast_ord (eq_sym (addn1 n)) i < n)%coq_nat)
    by now apply ord_nmax_lt_equiv.
rewrite insertF_correct_r insert_concat_l_ord_max concatF_correct_l; easy.
Qed.

Lemma insertF_concatF_l :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2) x0 {i0 : 'I_(n1 + n2).+1}
      (H : (i0 n1)%coq_nat),
    insertF (concatF A1 A2) x0 i0 =
      concatF (insertF A1 x0 (@concat_l_ord n1.+1 n2 _ (nat_le_ltS H))) A2.
Proof.
intros n1 n2 A1 A2 x0 i0 H;
    apply extF; intros i; destruct (lt_dec i n1.+1) as [Hi1 | Hi1].
rewrite concatF_correct_l.
destruct (nat_lt_eq_gt_dec i i0) as [[Hi0 | Hi0] | Hi0].
rewrite 2!insertF_correct_rl concatF_correct_l; try simpl; auto with zarith.
intros; f_equal; apply ord_inj; easy.
rewrite → 2!insertF_correct_l; try apply ord_inj; easy.
assert (Hi1' : (lower_S (ord_n0_gt Hi0) < n1)%coq_nat)
    by (simpl; rewrite -minusE; auto with zarith).
rewrite 2!insertF_correct_rr concatF_correct_l.
f_equal; apply ord_inj; easy.
assert (H0a : (i0 < i)%coq_nat) by auto with zarith.
assert (H0b : i i0) by (apply ord_neq; auto with zarith).
assert (H' : ¬ (insert_ord H0b < n1)%coq_nat).
  rewrite insert_ord_correct_r; simpl; rewrite -minusE; auto with zarith.
rewrite insertF_correct_r 2!concatF_correct_r.
f_equal; apply ord_inj; simpl; rewrite insert_ord_correct_r; simpl.
rewrite -subnDA add1n; easy.
Qed.

Lemma insertF_concatF_r :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2) x0 {i0 : 'I_(n1 + n2).+1}
      (H : ¬ (cast_ord (eq_sym (addnS n1 n2)) i0 < n1)%coq_nat),
    insertF (concatF A1 A2) x0 i0 =
      castF (addnS n1 n2) (concatF A1 (insertF A2 x0 (concat_r_ord H))).
Proof.
intros n1 n2 A1 A2 x0 i0 H; unfold castF;
    apply extF; intros i; destruct (lt_dec i n1) as [Hi1 | Hi1].
assert (H0 : (i < i0)%coq_nat) by (simpl in H; auto with zarith).
rewrite insertF_correct_rl 2!concatF_correct_l; f_equal; apply ord_inj; easy.
rewrite concatF_correct_r.
destruct (nat_lt_eq_gt_dec i (cast_ord (eq_sym (addnS _ _)) i0))
    as [[Hi0 | Hi0] | Hi0].
rewrite 2!insertF_correct_rl;
    try (simpl in *; rewrite -minusE; auto with zarith arith).
intros; rewrite concatF_correct_r; f_equal; apply ord_inj; easy.
rewrite → 2!insertF_correct_l; try apply ord_inj; simpl; try rewrite Hi0; easy.
assert (Hi1' : ¬ (lower_S (ord_n0_gt Hi0) < n1)%coq_nat)
    by (simpl; rewrite -minusE; auto with zarith).
rewrite 2!insertF_correct_rr;
    try (simpl in *; rewrite -minusE; auto with zarith).
intros; rewrite concatF_correct_r; f_equal; apply ord_inj; simpl.
rewrite -minusE; auto with zarith.
Qed.

Lemma insert2F_sym :
   {n} (A : 'E^n) {x0 x1} {i0 i1} {H10 : i1 i0} (H01 : i0 i1),
    insert2F A x0 x1 H10 = insert2F A x1 x0 H01.
Proof.
intros; rewrite insert2F_correct (insert2F_equiv_def _ _).
do 2 f_equal; apply insert_ord_compat_P.
Qed.

Lemma insert2F_sym_alt :
   {n} (A : 'E^n) {x0 x1} {i0 i1} {H : i1 i0},
    insert2F A x0 x1 H = insert2F A x1 x0 (not_eq_sym H).
Proof. intros; apply insert2F_sym. Qed.

Lemma insert2F_eq_P :
   {n} (A : 'E^n) x0 x1 {i0 i1} (H H' : i1 i0),
    insert2F A x0 x1 H = insert2F A x0 x1 H'.
Proof. intros; rewrite 2!insert2F_correct insert_ord_compat_P; easy. Qed.

Lemma insert2F_eq_gen :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1 j0 j1}
      (Hi : i1 i0) (Hj : j1 j0),
    A = B x0 = y0 x1 = y1 i0 = j0 i1 = j1
    insert2F A x0 x1 Hi = insert2F B y0 y1 Hj.
Proof. intros; subst; apply insert2F_eq_P. Qed.

Lemma insert2F_eq :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1} (H : i1 i0),
    A = B x0 = y0 x1 = y1
    insert2F A x0 x1 H = insert2F B y0 y1 H.
Proof. intros; apply insert2F_eq_gen; easy. Qed.

Lemma insert2F_inj_l :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H = insert2F B y0 y1 H A = B.
Proof.
move=>> H; rewrite 2!insert2F_correct in H; apply insertF_inj_l in H.
eapply insertF_inj_l, H.
Qed.

Lemma insert2F_inj_r0 :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H = insert2F B y0 y1 H x0 = y0.
Proof.
move=>> H; rewrite 2!insert2F_correct in H; eapply insertF_inj_r, H.
Qed.

Lemma insert2F_inj_r1 :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H = insert2F B y0 y1 H x1 = y1.
Proof.
move=>> H; rewrite 2!insert2F_correct in H; apply insertF_inj_l in H.
eapply insertF_inj_r, H.
Qed.

Lemma insert2F_inj :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H = insert2F B y0 y1 H A = B x0 = y0 x1 = y1.
Proof.
move=>> H; repeat split;
    [eapply insert2F_inj_l | eapply insert2F_inj_r0 | eapply insert2F_inj_r1];
    apply H.
Qed.

Lemma insert2F_nextF_compat_l :
   {n} {A B : 'E^n} x0 x1 y0 y1 {i0 i1} (H : i1 i0),
    A B insert2F A x0 x1 H insert2F B y0 y1 H.
Proof. move=>> H; contradict H; apply insert2F_inj in H; easy. Qed.

Lemma insert2F_nextF_compat_r0 :
   {n} (A B : 'E^n) {x0} x1 {y0} y1 {i0 i1} (H : i1 i0),
    x0 y0 insert2F A x0 x1 H insert2F B y0 y1 H.
Proof. move=>> H; contradict H; apply insert2F_inj_r0 in H; easy. Qed.

Lemma insert2F_nextF_compat_r1 :
   {n} (A B : 'E^n) x0 {x1} y0 {y1} {i0 i1} (H : i1 i0),
    x1 y1 insert2F A x0 x1 H insert2F B y0 y1 H.
Proof. move=>> H; contradict H; apply insert2F_inj_r1 in H; easy. Qed.

Lemma insert2F_nextF_reg :
   {n} {A B : 'E^n} {x0 x1 y0 y1} {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H insert2F B y0 y1 H A B x0 y0 x1 y1.
Proof.
move=>> H; apply not_and3_equiv; contradict H; apply insert2F_eq; easy.
Qed.

Lemma insert2F_nextF_equiv :
   {n} {A B : 'E^n} {x0 x1 y0 y1} {i0 i1} (H : i1 i0),
    insert2F A x0 x1 H insert2F B y0 y1 H A B x0 y0 x1 y1.
Proof.
intros; split; [apply insert2F_nextF_reg | intros [H1 | [H1 | H1]]];
    [apply insert2F_nextF_compat_l |
     apply insert2F_nextF_compat_r0 | apply insert2F_nextF_compat_r1]; easy.
Qed.

Lemma insert2F_singleF_01 :
   (x0 x1 x2 : E),
    insert2F (singleF x2) x0 x1 ord_1_not_0 = tripleF x0 x1 x2.
Proof.
intros; rewrite insert2F_correct; replace (insert_ord _) with (@ord0 1).
rewrite insertF_singleF_0 insertF_coupleF_0; easy.
rewrite (insert_ord_correct_r _ ord_lt_0_1); apply ord_inj; easy.
Qed.

Lemma insert2F_singleF_02 :
   (x0 x1 x2 : E),
    insert2F (singleF x1) x0 x2 ord_max_not_0 = tripleF x0 x1 x2.
Proof.
intros; rewrite insert2F_correct; replace (insert_ord _) with (@ord_max 1).
rewrite insertF_singleF_1 insertF_coupleF_0; easy.
rewrite (insert_ord_correct_r _ ord_lt_0_max); apply ord_inj; easy.
Qed.

Lemma insert2F_singleF_12 :
   (x0 x1 x2 : E),
    insert2F (singleF x0) x1 x2 ord_max_not_1 = tripleF x0 x1 x2.
Proof.
intros; rewrite insert2F_correct; replace (insert_ord _) with (@ord_max 1).
rewrite insertF_singleF_1 insertF_coupleF_1; easy.
rewrite (insert_ord_correct_r _ ord_lt_1_max); apply ord_inj; easy.
Qed.

End InsertF_Facts.

Section SkipF_Facts.

Context {E : Type}.

Properties of operators skipF/skip2F.

Lemma skipF_constF :
   {n} (x : E) i0, skipF (constF n.+1 x) i0 = constF n x.
Proof. easy. Qed.

Lemma skipF_concatF :
   {n} (A : 'E^n.+1) i0,
    castF (ord_split i0) (skipF A i0) =
      concatF (firstF (castF (ord_splitS i0) A))
              (lastF (castF (ordS_splitS i0) A)).
Proof.
intros; rewrite (concatF_splitF (castF _ (skipF _ _))).
rewrite firstF_skipF lastF_skipF; easy.
Qed.

Lemma skipF_compat_gen :
   {n} (A B : 'E^n.+1) i0 j0,
    eqxF A B i0 i0 = j0 skipF A i0 = skipF B j0.
Proof.
intros n A B i0 j0 H Hi; rewrite -Hi.
apply (castF_inj (ord_split i0)); rewrite 2!skipF_concatF.
apply concatF_eq; [apply firstF_compat | apply lastF_compat];
    intros; apply H; [apply ord_lt_neq | apply ord_lt_neq_sym]; easy.
Qed.

Lemma skipF_compat :
   {n} (A B : 'E^n.+1) i0, eqxF A B i0 skipF A i0 = skipF B i0.
Proof. intros; apply skipF_compat_gen; easy. Qed.

Lemma skipF_reg :
   {n} (A B : 'E^n.+1) i0, skipF A i0 = skipF B i0 eqxF A B i0.
Proof. move=>> /extF_rev H i Hi; rewrite -(skip_insert_ord Hi); apply H. Qed.

Lemma eqxF_equiv :
   {n} (A B : 'E^n.+1) i0, eqxF A B i0 skipF A i0 = skipF B i0.
Proof. intros; split. intros; apply skipF_compat; easy. apply skipF_reg. Qed.

Lemma skipF_neqxF_compat :
   {n} {A B : 'E^n.+1} {i0}, neqxF A B i0 skipF A i0 skipF B i0.
Proof.
move=>>; rewrite contra_not_r_equiv -eqxF_not_equiv; apply skipF_reg.
Qed.

Lemma skipF_neqxF_reg :
   {n} {A B : 'E^n.+1} {i0}, skipF A i0 skipF B i0 neqxF A B i0.
Proof.
move=>>; rewrite contra_not_l_equiv -eqxF_not_equiv eqxF_equiv; easy.
Qed.

Lemma neqxF_equiv :
   {n} {A B : 'E^n.+1} {i0}, neqxF A B i0 skipF A i0 skipF B i0.
Proof.
intros; split. intros; apply skipF_neqxF_compat; easy. apply skipF_neqxF_reg.
Qed.

Lemma PAF_ind_skipF :
   {n} {P : 'Prop^n.+1} {i0}, P i0 PAF (skipF P i0) PAF P.
Proof.
intros n P i0 H0 H1 i; destruct (ord_eq_dec i i0) as [-> | Hi]; [easy |].
rewrite -(skip_insert_ord Hi); apply H1.
Qed.

Lemma extF_skipF :
   {n} {A B : 'E^n.+1} i0,
    A i0 = B i0 skipF A i0 = skipF B i0 A = B.
Proof. move=>>; rewrite -eqxF_equiv; apply eqxF_reg. Qed.

Lemma extF_skipF_equiv :
   {n} {A B : 'E^n.+1} i0,
    A = B A i0 = B i0 skipF A i0 = skipF B i0.
Proof.
intros n A B i0; split; intros H; [subst | apply (extF_skipF i0)]; easy.
Qed.

Lemma nextF_skipF :
   {n} {A B : 'E^n.+1} i0,
    A B A i0 B i0 skipF A i0 skipF B i0.
Proof.
move=>>; rewrite -not_and_equiv -contra_equiv;
    move⇒ [H1 H2]; move: H1 H2; apply extF_skipF.
Qed.

Lemma nextF_skipF_equiv :
   {n} {A B : 'E^n.+1} i0,
    A B A i0 B i0 skipF A i0 skipF B i0.
Proof.
move=>>; rewrite -not_and_equiv -iff_not_equiv; apply extF_skipF_equiv.
Qed.

Lemma eq_decF : eq_dec E n, eq_dec 'E^n.
Proof.
intros H n A B; induction n.
left; rewrite (hat0F_unit A B); easy.
destruct (H (A ord0) (B ord0)) as [H1 | H1].
destruct (IHn (skipF A ord0) (skipF B ord0)) as [H2 | H2].
left; apply extF_skipF with ord0; easy.
right; contradict H2; subst; easy.
right; contradict H1; subst; easy.
Qed.

Lemma skipF_inj :
   {n} (A : 'E^n.+1) i0, injective A injective (skipF A i0).
Proof. move=>> HA j1 j2 /HA; apply skip_ord_inj. Qed.

Lemma skipF_invalF :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2.+1) i1 i2,
    injective A1 A1 i1 = A2 i2
    invalF A1 A2 invalF (skipF A1 i1) (skipF A2 i2).
Proof.
intros n1 n2 A1 A2 i1 i2 HA1 HAi HA j1.
destruct (HA (skip_ord i1 j1)) as [j2 Hj2a].
assert (Hj2b : j2 i2).
  intros Hj2b; apply (skip_ord_correct_m i1 j1), HA1.
  rewrite HAi -Hj2b; easy.
(insert_ord Hj2b); rewrite skipF_correct; easy.
Qed.

Lemma skipF_invalF_rev :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2.+1) i1 i2,
    A1 i1 = A2 i2 invalF (skipF A1 i1) (skipF A2 i2) invalF A1 A2.
Proof.
intros n1 n2 A1 A2 i1 i2 HAi HA j1.
destruct (ord_eq_dec j1 i1) as [Hj1 | Hj1].
i2; rewrite Hj1; easy.
destruct (HA (insert_ord Hj1)) as [j2 Hj2]; rewrite skipF_correct in Hj2.
(skip_ord i2 j2); easy.
Qed.

Lemma skipF_invalF_equiv :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2.+1) i1 i2,
    injective A1 A1 i1 = A2 i2
    invalF (skipF A1 i1) (skipF A2 i2) invalF A1 A2.
Proof.
move=>> HA1 Hi; split; [apply skipF_invalF_rev | apply skipF_invalF]; easy.
Qed.

Lemma skipF_2l :
   (A : 'E^2), skipF A ord0 = singleF (A ord_max).
Proof.
intros; apply extF; intro;
    rewrite I_1_is_unit singleF_0 skipF_correct_r; [| easy].
rewrite liftF_S_0 ord2_1_max; easy.
Qed.

Lemma skipF_2l0 : (A : 'E^2), skipF A ord0 ord0 = A ord_max.
Proof. intros; rewrite skipF_2l; easy. Qed.

Lemma skipF_2r :
   (A : 'E^2), skipF A ord_max = singleF (A ord0).
Proof.
intros; apply extF; intro;
    rewrite I_1_is_unit singleF_0 skipF_correct_l; try now apply /ltP.
apply widenF_S_0.
Qed.

Lemma skipF_2r0 : (A : 'E^2), skipF A ord_max ord0 = A ord0.
Proof. intros; rewrite skipF_2r; easy. Qed.

Lemma skipF_3l :
   (A : 'E^3), skipF A ord0 = coupleF (A ord1) (A ord_max).
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewrite coupleF_0 skipF_correct_r; [apply liftF_S_0 | easy].
rewrite coupleF_1 skipF_correct_r; [apply liftF_S_max | easy].
Qed.

Lemma skipF_3l0 : (A : 'E^3), skipF A ord0 ord0 = A ord1.
Proof. intros; rewrite skipF_3l coupleF_0; easy. Qed.

Lemma skipF_3l1 : (A : 'E^3), skipF A ord0 ord_max = A ord_max.
Proof. intros; rewrite skipF_3l coupleF_1; easy. Qed.

Lemma skipF_3m :
   (A : 'E^3), skipF A ord1 = coupleF (A ord0) (A ord_max).
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewrite coupleF_0 skipF_correct_l; [apply widenF_S_0 | now apply /ltP].
rewrite coupleF_1 skipF_correct_r; [apply liftF_S_max | now apply /ltP].
Qed.

Lemma skipF_3m0 : (A : 'E^3), skipF A ord1 ord0 = A ord0.
Proof. intros; rewrite skipF_3m coupleF_0; easy. Qed.

Lemma skipF_3m1 : (A : 'E^3), skipF A ord1 ord_max = A ord_max.
Proof. intros; rewrite skipF_3m coupleF_1; easy. Qed.

Lemma skipF_3r :
   (A : 'E^3), skipF A ord_max = coupleF (A ord0) (A ord1).
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewrite coupleF_0 skipF_correct_l; [apply widenF_S_0 | now apply /ltP].
rewrite coupleF_1 skipF_correct_l;
    [rewrite widenF_S_max ord3_1_pred_max | apply /ltP]; easy.
Qed.

Lemma skipF_3r0 : (A : 'E^3), skipF A ord_max ord0 = A ord0.
Proof. intros; rewrite skipF_3r coupleF_0; easy. Qed.

Lemma skipF_3r1 : (A : 'E^3), skipF A ord_max ord_max = A ord1.
Proof. intros; rewrite skipF_3r coupleF_1; easy. Qed.

Lemma skipF_coupleF_l :
   (x0 x1 : E), skipF (coupleF x0 x1) ord0 = singleF x1.
Proof. intros; rewrite skipF_2l coupleF_1; easy. Qed.

Lemma skipF_coupleF_r :
   (x0 x1 : E), skipF (coupleF x0 x1) ord_max = singleF x0.
Proof. intros; rewrite skipF_2r coupleF_0; easy. Qed.

Lemma skipF_tripleF_l :
   (x0 x1 x2 : E), skipF (tripleF x0 x1 x2) ord0 = coupleF x1 x2.
Proof. intros; rewrite skipF_3l tripleF_1 tripleF_2; easy. Qed.

Lemma skipF_tripleF_m :
   (x0 x1 x2 : E), skipF (tripleF x0 x1 x2) ord1 = coupleF x0 x2.
Proof. intros; rewrite skipF_3m tripleF_0 tripleF_2; easy. Qed.

Lemma skipF_tripleF_r :
   (x0 x1 x2 : E), skipF (tripleF x0 x1 x2) ord_max = coupleF x0 x1.
Proof. intros; rewrite skipF_3r tripleF_0 tripleF_1; easy. Qed.

Lemma skipF_not_inF :
   {n} (A : 'E^n.+1) i0, injective A ¬ inF (A i0) (skipF A i0).
Proof.
intros n A i0 HA [j Hj]; destruct (lt_dec j i0) as [H | H].
rewrite skipF_correct_l in Hj; try easy.
apply HA in Hj; rewrite Hj in H; contradict H; apply Nat.lt_irrefl.
rewrite skipF_correct_r in Hj; try easy.
apply HA in Hj; rewrite Hj in H; contradict H; auto.
Qed.

Lemma skipF_monot_l :
   {n1 n2} (A1 : 'E^n1.+1) (A2 : 'E^n2) i,
    invalF A1 A2 invalF (skipF A1 i) A2.
Proof.
intros n1 n2 A1 A2 i HA i1; destruct (HA (skip_ord i i1)) as [j2 Hj2].
j2; easy.
Qed.

Lemma skipF_monot_r :
   {n1 n2} (A1 : 'E^n1) (A2 : 'E^n2.+1) i,
    invalF A1 (skipF A2 i) invalF A1 A2.
Proof.
intros n1 n2 A1 A2 i HA i1; destruct (HA i1) as [j2 Hj2].
(skip_ord i j2); easy.
Qed.

Lemma skipF_insertF :
   {n} (A : 'E^n) x0 i0, skipF (insertF A x0 i0) i0 = A.
Proof.
intros n A x0 i0; apply extF; intros i; destruct (lt_dec i i0) as [Hi | Hi].
rewrite skipF_correct_l; try easy; unfold widenF_S.
rewrite insertF_correct_rl narrow_widen_S; easy.
assert (Hia : (i0 < lift_S i)%coq_nat)
    by (rewrite lift_S_correct; auto with zarith).
rewrite skipF_correct_r; try easy; unfold liftF_S.
rewrite insertF_correct_rr lower_lift_S; easy.
Qed.

Lemma insertF_skipF :
   {n} (A : 'E^n.+1) i0, insertF (skipF A i0) (A i0) i0 = A.
Proof.
intros n A i0; apply extF; intros i.
destruct (nat_lt_eq_gt_dec i0 i) as [[H0 | H0] | H0].
2: apply ord_inj in H0; rewrite -H0 insertF_correct_l; easy.
assert (H0' : ¬ (lower_S (ord_n0_gt H0) < i0)%coq_nat).
  rewrite lower_S_correct; auto with zarith.
rewrite insertF_correct_rr skipF_correct_r; try easy; apply liftF_lower_S.
assert (H0' : (narrow_S (ord_nmax_lt H0) < i0)%coq_nat)
    by now rewrite narrow_S_correct.
rewrite insertF_correct_rl skipF_correct_l; try easy; apply widenF_narrow_S.
Qed.

Lemma widenF_S_insertF_max :
   {n} (A : 'E^n) x, widenF_S (insertF A x ord_max) = A.
Proof.
intros; apply extF; intro; rewrite -(skipF_correct_l ord_max);
    [rewrite skipF_insertF | apply /ltP]; easy.
Qed.

Lemma insertF_max_widenF_S :
   {n} (A : 'E^n.+1), insertF (widenF_S A) (A ord_max) ord_max = A.
Proof.
intros; apply extF; intros i; destruct (ord_eq_dec i ord_max) as [Hi | Hi].
rewrite Hi insertF_correct_l; easy.
apply widenF_S_reg; try rewrite widenF_S_insertF_max; easy.
Qed.

Lemma liftF_S_insertF_0 :
   {n} (A : 'E^n) x, liftF_S (insertF A x ord0) = A.
Proof.
intros; apply extF; intro; rewrite -(skipF_correct_r ord0);
    [rewrite skipF_insertF | apply /ltP]; easy.
Qed.

Lemma insertF_0_liftF_S :
   {n} (A : 'E^n.+1), insertF (liftF_S A) (A ord0) ord0 = A.
Proof.
intros; apply extF; intros i; destruct (ord_eq_dec i ord0) as [Hi | Hi].
rewrite Hi insertF_correct_l; easy.
apply liftF_S_reg; try rewrite liftF_S_insertF_0; easy.
Qed.

Lemma insertF_skipF_comm :
   {n} (A : 'E^n.+1) x1 {j0 j1 i0 i1},
    i0 = skip_ord i1 j0 i1 = skip_ord i0 j1
    insertF (skipF A j0) x1 j1 = skipF (insertF A x1 i1) i0.
Proof.
intros n A x1 j0 j1 i0 i1 Hi0 Hi1; apply extF; intros j.
unfold insertF, skipF.
destruct (ord_eq_dec j j1) as [Hj1 | Hj1],
    (ord_eq_dec (skip_ord i0 j) i1) as [Hji | Hji]; try easy.
contradict Hji; rewrite Hj1; easy.
contradict Hj1; apply (skip_ord_inj i0); rewrite Hji; easy.
rewrite (skip_insert_ord_gen _ _ _ Hi0 Hi1); easy.
Qed.

Lemma skipF_insertF_comm :
   {n} (A : 'E^n.+1) x0 {i0 i1} (Hi : i1 i0),
    let j1 := insert_ord Hi in
    let j0 := insert_ord (not_eq_sym Hi) in
    skipF (insertF A x0 i0) i1 = insertF (skipF A j1) x0 j0.
Proof.
intros n A x0 i0 i1 Hi j1 j0.
assert (Hi0 : i0 = skip_ord i1 j0) by now unfold j0; rewrite skip_insert_ord.
assert (Hi1 : i1 = skip_ord i0 j1) by now unfold j1; rewrite skip_insert_ord.
rewrite (insertF_skipF_comm _ _ Hi1 Hi0); easy.
Qed.

Lemma skipF_ex :
   {n} x0 (A : 'E^n) i0, B, B i0 = x0 skipF B i0 = A.
Proof.
intros n x0 A i0; (insertF A x0 i0); split.
rewrite insertF_correct_l; easy.
apply skipF_insertF.
Qed.

Lemma skipF_uniq :
   {n} x0 (A : 'E^n) i0, ! B, B i0 = x0 skipF B i0 = A.
Proof.
intros n x0 A i0; destruct (skipF_ex x0 A i0) as [B HB].
B; split; try easy.
intros C [HC0 HC1]; apply (extF_skipF i0); [rewrite HC0 | rewrite HC1]; easy.
Qed.

Lemma skipF_first : {n} (A : 'E^n.+1), skipF A ord0 = liftF_S A.
Proof. intros; apply extF; intro; apply skipF_correct_r; easy. Qed.

Lemma skipF_last : {n} (A : 'E^n.+1), skipF A ord_max = widenF_S A.
Proof. intros; apply extF; intro; apply skipF_correct_l; apply /ltP; easy. Qed.

Lemma skip2F_compat_P :
   {n} (A : 'E^n.+2) {i0 i1} {H : i1 i0} (H' : i1 i0),
    skip2F A H = skip2F A H'.
Proof. intros; unfold skip2F; rewrite skip2_ord_compat_P; easy. Qed.

Lemma skip2F_compat_lt :
   {n} (A B : 'E^n.+2) {i0 i1 : 'I_n.+2} (H : (i0 < i1)%coq_nat),
    eqx2F A B i0 i1 skip2F A (ord_lt_neq_sym H) = skip2F B (ord_lt_neq_sym H).
Proof.
intros n A B i0 i1 Hi H;
    rewrite 2!skip2F_correct; apply skipF_compat; try easy.
intros j Hj1; destruct (lt_dec j i0) as [Hj2 | Hj2].
rewrite → 2!skipF_correct_l; try easy; apply H; split.
contradict Hj2; apply Nat.nlt_ge; rewrite -Hj2; simpl; easy.
rewrite -(skip_ord_correct_l i0); try easy.
contradict Hj1; apply (skip_ord_inj i0); rewrite skip_insert_ord; easy.
rewrite → 2!skipF_correct_r; try easy; apply H; split.
contradict Hj2; rewrite -Hj2; simpl; rewrite bump_r; auto with arith.
rewrite -(skip_ord_correct_r i0); try easy.
contradict Hj1; apply (skip_ord_inj i0); rewrite skip_insert_ord; easy.
Qed.

Lemma skip2F_compat_gen :
   {n} (A B : 'E^n.+2) {i0 i1 j0 j1} (Hi : i1 i0) (Hj : j1 j0),
    eqx2F A B i0 i1 i0 = j0 i1 = j1 skip2F A Hi = skip2F B Hj.
Proof.
intros n A B i0 i1 j0 j1 Hi Hj H Hi0 Hi1; subst j0 j1.
destruct (nat_lt_eq_gt_dec i1 i0) as [[Hia | Hia] | Hia].
2: contradict Hi; apply ord_inj, eq_sym; easy.
rewrite 2!(skip2F_sym _ (ord_lt_neq_sym Hia)).
apply skip2F_compat_lt, eqx2F_sym_i; easy.
rewrite 2!(skip2F_compat_P _ (ord_lt_neq_sym Hia)).
apply skip2F_compat_lt; easy.
Qed.

Lemma skip2F_compat :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    eqx2F A B i0 i1 skip2F A H = skip2F B H.
Proof. intros; apply skip2F_compat_gen; easy. Qed.

Lemma skip2F_reg :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    skip2F A H = skip2F B H eqx2F A B i0 i1.
Proof.
move=>> /extF_rev H i [H0 H1]; rewrite -(skip2_insert2_ord _ H0 H1); apply H.
Qed.

Lemma eqx2F_equiv :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    eqx2F A B i0 i1 skip2F A H = skip2F B H.
Proof. intros; split. intros; apply skip2F_compat; easy. apply skip2F_reg. Qed.

Lemma skip2F_neqx2F_compat :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    neqx2F A B i0 i1 skip2F A H skip2F B H.
Proof.
move=>>; rewrite contra_not_r_equiv -eqx2F_not_equiv; apply skip2F_reg.
Qed.

Lemma skip2F_neqx2F_reg :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    skip2F A H skip2F B H neqx2F A B i0 i1.
Proof.
move=>>; rewrite contra_not_l_equiv -eqx2F_not_equiv -eqx2F_equiv; easy.
Qed.

Lemma neqx2F_equiv :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    neqx2F A B i0 i1 skip2F A H skip2F B H.
Proof.
intros; split. intros; apply skip2F_neqx2F_compat; easy. apply skip2F_neqx2F_reg.
Qed.

Lemma skip2F_tripleF_01 :
   (A : 'E^3), skip2F A ord_1_not_0 = singleF (A ord_max).
Proof.
intros; apply extF; intro;
    rewrite I_1_is_unit singleF_0 skip2F_correct skipF_correct_r.
rewrite liftF_S_0 skipF_3l ord2_1_max coupleF_1; easy.
rewrite (insert_ord_correct_r _ ord_lt_0_1); easy.
Qed.

Lemma skip2F_tripleF_02 :
   (A : 'E^3), skip2F A ord_max_not_0 = singleF (A ord1).
Proof.
intros; apply extF; intro;
    rewrite I_1_is_unit singleF_0 skip2F_correct skipF_correct_l.
rewrite widenF_S_0 skipF_3l coupleF_0; easy.
rewrite (insert_ord_correct_r _ ord_lt_0_max) lower_S_correct;
    apply ord_lt_0_pred_max.
Qed.

Lemma skip2F_tripleF_12 :
   (A : 'E^3), skip2F A ord_max_not_1 = singleF (A ord0).
Proof.
intros; apply extF; intro;
    rewrite I_1_is_unit singleF_0 skip2F_correct skipF_correct_l.
rewrite widenF_S_0 skipF_3m coupleF_0; easy.
rewrite (insert_ord_correct_r _ ord_lt_1_max) lower_S_correct;
    apply ord_lt_0_pred_max.
Qed.

Lemma PAF_ind_skip2F :
   {n} {P : 'Prop^n.+2} {i0 i1} (H : i1 i0),
    P i0 P i1 PAF (skip2F P H) PAF P.
Proof.
intros n P i0 i1 Hi H0 H1 H2; rewrite skip2F_correct in H2.
rewrite -(skip_insert_ord Hi) in H1.
apply: (PAF_ind_skipF H0) (PAF_ind_skipF H1 H2).
Qed.

Lemma extF_skip2F :
   {n} (A B : 'E^n.+2) {i0 i1} (H : i1 i0),
    A i0 = B i0 A i1 = B i1 skip2F A H = skip2F B H A = B.
Proof. move=>>; rewrite -eqx2F_equiv; apply eqx2F_reg. Qed.

Lemma skip2F_insert2F :
   {n} (A : 'E^n) x0 x1 {i0 i1} (H : i1 i0),
    skip2F (insert2F A x0 x1 H) H = A.
Proof.
intros; rewrite skip2F_correct insert2F_correct 2!skipF_insertF; easy.
Qed.

Lemma insert2F_skip2F :
   {n} (A : 'E^n.+2) {i0 i1} (H : i1 i0),
    insert2F (skip2F A H) (A i0) (A i1) H = A.
Proof.
intros n A i0 i1 H.
rewrite skip2F_correct insert2F_correct -(skipF_correct H) !insertF_skipF//.
Qed.

End SkipF_Facts.

Section ReplaceF_Facts.

Context {E : Type}.

Properties of operators replaceF/replace2F.

Lemma replaceF_id :
   {n} (A : 'E^n) i0, replaceF A (A i0) i0 = A.
Proof.
intros n A i0; apply extF; intros i; destruct (ord_eq_dec i i0) as [Hi | Hi].
rewrite replaceF_correct_l Hi; easy.
rewrite replaceF_correct_r; easy.
Qed.

Lemma replaceF_equiv_def_insertF :
   {n} (A : 'E^n.+1) x0 i0, replaceF A x0 i0 = insertF (skipF A i0) x0 i0.
Proof.
intros n A x0 i0; apply extF; intros i.
destruct (ord_eq_dec i i0) as [H0 | H0].
rewritereplaceF_correct_l, H0, insertF_correct_l; easy.
rewrite replaceF_correct_r; try easy.
destruct (nat_lt_eq_gt_dec i i0) as [[H0a | H0a] | H0a].
2: contradict H0a; apply ord_neq_compat; easy.
rewrite insertF_correct_rl skipF_correct_l; try easy; unfold widenF_S.
rewrite widen_narrow_S; easy.
rewrite insertF_correct_rr skipF_correct_r; unfold liftF_S.
rewrite lift_lower_S; easy.
rewrite lower_S_correct; auto with zarith.
Qed.

Lemma replaceF_equiv_def_skipF :
   {n} (A : 'E^n) x0 i0,
    replaceF A x0 i0 = skipF (insertF A x0 (widen_S i0)) (lift_S i0).
Proof.
intros n A x0 i0; apply extF; intros i.
destruct (ord_eq_dec i i0) as [H0 | H0].
rewrite replaceF_correct_l H0; try easy.
assert (Ha : (widen_S i0 < lift_S i0)%coq_nat).
  rewrite widen_S_correct lift_S_correct; apply nat_ltS.
assert (Hb : widen_S i0 lift_S i0) by apply ord_lt_neq, Ha.
replace i0 with (insert_ord Hb) at 3.
rewrite skipF_correct insertF_correct_l; try easy.
apply ord_inj; rewrite insert_ord_correct_l; easy.
rewrite replaceF_correct_r; try easy.
destruct (nat_lt_eq_gt_dec i i0) as [[H0a | H0a] | H0a].
2: contradict H0a; apply ord_neq_compat; easy.
rewrite skipF_correct_l; try (rewrite lift_S_correct; auto with arith);
    unfold widenF_S; rewrite insertF_correct_rl.
f_equal; apply ord_inj; easy.
assert (Hb : (widen_S i0 < lift_S i)%coq_nat).
  rewrite widen_S_correct lift_S_correct; auto with arith.
rewrite skipF_correct_r; try (now apply Nat.nlt_ge);
    unfold liftF_S; rewrite insertF_correct_rr.
f_equal; apply ord_inj; rewrite lower_S_correct; easy.
Qed.

Lemma replaceF_compat_gen :
   {n} (A B : 'E^n) x0 y0 i0 j0,
    eqxF A B i0 x0 = y0 i0 = j0
    replaceF A x0 i0 = replaceF B y0 j0.
Proof.
intros n A B x0 y0 i0 j0 HAB Hxy Hij; rewrite -Hxy -Hij.
apply extF; intros i; destruct (ord_eq_dec i i0).
rewrite → 2!replaceF_correct_l; easy.
rewrite → 2!replaceF_correct_r; auto.
Qed.

Lemma replaceF_compat :
   {n} (A B : 'E^n) x0 y0 i0,
    eqxF A B i0 x0 = y0 replaceF A x0 i0 = replaceF B y0 i0.
Proof. intros; apply replaceF_compat_gen; easy. Qed.

Lemma replaceF_reg_l :
   {n} (A B : 'E^n) x0 y0 i0,
    replaceF A x0 i0 = replaceF B y0 i0 eqxF A B i0.
Proof.
move=>> /extF_rev H i Hi; specialize (H i); simpl in H.
erewrite 2!replaceF_correct_r in H; easy.
Qed.

Lemma replaceF_reg_r :
   {n} (A B : 'E^n) x0 y0 i0,
    replaceF A x0 i0 = replaceF B y0 i0 x0 = y0.
Proof.
moven A B x0 y0 i0 /extF_rev H; specialize (H i0); simpl in H.
erewrite 2!replaceF_correct_l in H; easy.
Qed.

Lemma replaceF_reg :
   {n} (A B : 'E^n) x0 y0 i0,
    replaceF A x0 i0 = replaceF B y0 i0 eqxF A B i0 x0 = y0.
Proof.
move=>> H; split; [eapply replaceF_reg_l | eapply replaceF_reg_r]; apply H.
Qed.

Lemma eqxF_replaceF :
   {n} (A B : 'E^n) x1 y1 i1 j1 i0,
    eqx2F A B i0 i1 x1 = y1 i1 = j1
    eqxF (replaceF A x1 i1) (replaceF B y1 j1) i0.
Proof.
intros n A B x1 y1 i1 j1 i0 HAB Hxy Hij; rewrite -Hxy -Hij.
intros i Hi; destruct (ord_eq_dec i i1).
rewrite → 2!replaceF_correct_l; easy.
rewrite → 2!replaceF_correct_r; auto.
Qed.

Lemma replaceF_neqxF_compat_l :
   {n} {A B : 'E^n} x0 y0 {i0},
    neqxF A B i0 replaceF A x0 i0 replaceF B y0 i0.
Proof. move=>>; rewrite neqxF_not_equiv -contra_equiv; apply replaceF_reg. Qed.

Lemma replaceF_neqxF_compat_r :
   {n} {A B : 'E^n} {x0 y0} i0,
    x0 y0 replaceF A x0 i0 replaceF B y0 i0.
Proof. move=>>; rewrite -contra_equiv; apply replaceF_reg. Qed.

Lemma replaceF_neqxF_reg :
   {n} {A B : 'E^n} {x0 y0 i0},
    replaceF A x0 i0 replaceF B y0 i0 neqxF A B i0 x0 y0.
Proof.
move=>>; rewrite neqxF_not_equiv -not_and_equiv -contra_equiv.
intros; apply replaceF_compat; easy.
Qed.

Lemma replaceF_neqxF_equiv :
   {n} {A B : 'E^n} {x0 y0 i0},
    replaceF A x0 i0 replaceF B y0 i0 neqxF A B i0 x0 y0.
Proof.
intros; split; [apply replaceF_neqxF_reg | intros [H | H]];
    [apply replaceF_neqxF_compat_l | apply replaceF_neqxF_compat_r]; easy.
Qed.

Lemma neqxF_replaceF :
   {n} (A B : 'E^n) x1 y1 i1 i0,
    neqxF (replaceF A x1 i1) (replaceF B y1 i1) i0
    neqx2F A B i0 i1 x1 y1.
Proof.
move=>>; rewrite neqxF_not_equiv neqx2F_not_equiv -not_and_equiv -contra_equiv.
intros; apply eqxF_replaceF; easy.
Qed.

Lemma replaceF_constF :
   {n} (x : E) i0, replaceF (constF n x) x i0 = constF n x.
Proof.
intros n x i0; apply extF; intros i; destruct (ord_eq_dec i i0).
rewritereplaceF_correct_l, constF_correct; easy.
rewrite replaceF_correct_r; easy.
Qed.

Lemma replaceF_singleF_0 :
   (x0 y0 : E), replaceF (singleF x0) y0 ord0 = singleF y0.
Proof.
intros; apply extF; intro;
    rewrite I_1_is_unit singleF_0 replaceF_correct_l; easy.
Qed.

Lemma replaceF_coupleF_0 :
   (x0 x1 y0 : E), replaceF (coupleF x0 x1) y0 ord0 = coupleF y0 x1.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewritecoupleF_0, replaceF_correct_l; easy.
rewritereplaceF_correct_r, 2!coupleF_1; easy.
Qed.

Lemma replaceF_coupleF_1 :
   (x0 x1 y1 : E), replaceF (coupleF x0 x1) y1 ord_max = coupleF x0 y1.
Proof.
intros; apply extF; intros i; destruct (ord2_dec i) as [Hi | Hi]; rewrite Hi.
rewritereplaceF_correct_r, 2!coupleF_0; easy.
rewritecoupleF_1, replaceF_correct_l; easy.
Qed.

Lemma replaceF_tripleF_0 :
   (x0 x1 x2 y0 : E),
    replaceF (tripleF x0 x1 x2) y0 ord0 = tripleF y0 x1 x2.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewritetripleF_0, replaceF_correct_l; easy.
rewritereplaceF_correct_r, 2!tripleF_1; easy.
rewritereplaceF_correct_r, 2!tripleF_2; easy.
Qed.

Lemma replaceF_tripleF_1 :
   (x0 x1 x2 y1 : E), replaceF (tripleF x0 x1 x2) y1 ord1 = tripleF x0 y1 x2.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewritereplaceF_correct_r, 2!tripleF_0; easy.
rewritetripleF_1, replaceF_correct_l; easy.
rewritereplaceF_correct_r, 2!tripleF_2; easy.
Qed.

Lemma replaceF_tripleF_2 :
   (x0 x1 x2 y2 : E), replaceF (tripleF x0 x1 x2) y2 ord_max = tripleF x0 x1 y2.
Proof.
intros; apply extF; intros i;
    destruct (ord3_dec i) as [[Hi | Hi] | Hi]; rewrite Hi.
rewritereplaceF_correct_r, 2!tripleF_0; easy.
rewritereplaceF_correct_r, 2!tripleF_1; easy.
rewritetripleF_2, replaceF_correct_l; easy.
Qed.

Lemma PAF_ind_replaceF :
   {n} {P : 'Prop^n} {i0} p0, P i0 PAF (replaceF P p0 i0) PAF P.
Proof.
intros n P i0 p0 H0 H1 i; destruct (ord_eq_dec i i0) as [-> | Hi]; [easy |].
rewrite -(replaceF_correct_r _ p0 Hi); easy.
Qed.

Lemma extF_replaceF :
   {n} (A B : 'E^n) x0 i0,
    A i0 = B i0 replaceF A x0 i0 = replaceF B x0 i0 A = B.
Proof.
intros n A B x0 i0 H0 H.
apply extF; intros i; destruct (ord_eq_dec i i0) as [Hi | Hi].
rewrite Hi; easy.
rewrite -(replaceF_correct_r A x0 Hi) -(replaceF_correct_r B x0 Hi) H; easy.
Qed.

Lemma skipF_replaceF :
   {n} (A : 'E^n.+1) x0 i0, skipF (replaceF A x0 i0) i0 = skipF A i0.
Proof. intros; apply skipF_compat; intro; apply replaceF_correct_r. Qed.

Lemma replace2F_sym :
   {n} (A : 'E^n) x0 x1 {i0 i1},
    i1 i0 replace2F A x0 x1 i0 i1 = replace2F A x1 x0 i1 i0.
Proof. move=>>; apply replace2F_equiv_def. Qed.

Lemma replace2F_compat_gen :
   {n} (A B : 'E^n) x0 x1 y0 y1 i0 i1 j0 j1,
    eqx2F A B i0 i1 x0 = y0 x1 = y1 i0 = j0 i1 = j1
    replace2F A x0 x1 i0 i1 = replace2F B y0 y1 j0 j1.
Proof.
intros; unfold replace2F; apply replaceF_compat_gen; try easy.
apply eqxF_replaceF; try apply eqx2F_sym_i; easy.
Qed.

Lemma replace2F_compat :
   {n} (A B : 'E^n) x0 x1 y0 y1 i0 i1,
    eqx2F A B i0 i1 x0 = y0 x1 = y1
    replace2F A x0 x1 i0 i1 = replace2F B y0 y1 i0 i1.
Proof. intros; apply replace2F_compat_gen; easy. Qed.

Lemma replace2F_reg_l :
   {n} (A B : 'E^n) x0 x1 y0 y1 i0 i1,
    replace2F A x0 x1 i0 i1 = replace2F B y0 y1 i0 i1 eqx2F A B i0 i1.
Proof.
move=>> H2 i [Hi0 Hi1]; unfold replace2F in H2.
specialize (replaceF_reg_l _ _ _ _ _ H2 i Hi1); intros H1.
erewrite 2!replaceF_correct_r in H1; easy.
Qed.

Lemma replace2F_reg_r0 :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1},
    i1 i0 replace2F A x0 x1 i0 i1 = replace2F B y0 y1 i0 i1 x0 = y0.
Proof.
move=>> Hi; rewrite → 2!replace2F_equiv_def; try easy; apply replaceF_reg_r.
Qed.

Lemma replace2F_reg_r1 :
   {n} (A B : 'E^n) x0 x1 y0 y1 i0 i1,
    replace2F A x0 x1 i0 i1 = replace2F B y0 y1 i0 i1 x1 = y1.
Proof. move=>>; apply replaceF_reg_r. Qed.

Lemma replace2F_reg :
   {n} (A B : 'E^n) x0 x1 y0 y1 {i0 i1},
    i1 i0 replace2F A x0 x1 i0 i1 = replace2F B y0 y1 i0 i1
    eqx2F A B i0 i1 x0 = y0 x1 = y1.
Proof.
move=>> Hi H; repeat split; [eapply replace2F_reg_l | eapply replace2F_reg_r0 |
    eapply replace2F_reg_r1]; try apply H; easy.
Qed.

Lemma replace2F_neqxF_compat_l :
   {n} {A B : 'E^n} x0 x1 y0 y1 {i0 i1},
    neqx2F A B i0 i1 replace2F A x0 x1 i0 i1 replace2F B y0 y1 i0 i1.
Proof.
move=>>; rewrite neqx2F_not_equiv -contra_equiv; apply replace2F_reg_l.
Qed.

Lemma replace2F_neqxF_compat_r0 :
   {n} (A B : 'E^n) {x0} x1 {y0} y1 {i0 i1},
    i1 i0 x0 y0 replace2F A x0 x1 i0 i1 replace2F B y0 y1 i0 i1.
Proof. move=>>; rewrite -contra_equiv; apply replace2F_reg_r0. Qed.

Lemma replace2F_neqxF_compat_r1 :
   {n} (A B : 'E^n) x0 {x1} y0 {y1} i0 i1,
    x1 y1 replace2F A x0 x1 i0 i1 replace2F B y0 y1 i0 i1.
Proof. move=>>; rewrite -contra_equiv; apply replace2F_reg_r1. Qed.

Lemma replace2F_neqxF_reg :
   {n} {A B : 'E^n} {x0 x1 y0 y1 i0 i1},
    replace2F A x0 x1 i0 i1 replace2F B y0 y1 i0 i1
    neqx2F A B i0 i1 x0 y0 x1 y1.
Proof.
move=>>; rewrite neqx2F_not_equiv -not_and3_equiv -contra_equiv.
intros; apply replace2F_compat; easy.
Qed.

Lemma replace2F_neqxF_equiv :
   {n} {A B : 'E^n} {x0 x1 y0 y1 i0 i1}, i1 i0
    replace2F A x0 x1 i0 i1 replace2F B y0 y1 i0 i1
    neqx2F A B i0 i1 x0 y0 x1 y1.
Proof.
intros; split; [apply replace2F_neqxF_reg | intros [H1 | [H1 | H1]]];
    [apply replace2F_neqxF_compat_l |
     apply replace2F_neqxF_compat_r0 | apply replace2F_neqxF_compat_r1]; easy.
Qed.

Lemma replace2F_constF :
   {n} (x : E) i0 i1, replace2F (constF n x) x x i0 i1 = constF n x.
Proof. intros; unfold replace2F; rewrite 2!replaceF_constF; easy. Qed.

Lemma replace2F_coupleF :
   (x0 x1 y0 y1 : E),
    replace2F (coupleF x0 x1) y0 y1 ord0 ord_max = coupleF y0 y1.
Proof.
intros; unfold replace2F; rewrite replaceF_coupleF_0 replaceF_coupleF_1; easy.
Qed.

Lemma replace2F_tripleF_01 :
   (x0 x1 x2 y0 y1 : E),
    replace2F (tripleF x0 x1 x2) y0 y1 ord0 ord1 = tripleF y0 y1 x2.
Proof.
intros; unfold replace2F; rewrite replaceF_tripleF_0 replaceF_tripleF_1; easy.
Qed.

Lemma replace2F_tripleF_02 :
   (x0 x1 x2 y0 y2 : E),
    replace2F (tripleF x0 x1 x2) y0 y2 ord0 ord_max = tripleF y0 x1 y2.
Proof.
intros; unfold replace2F; rewrite replaceF_tripleF_0 replaceF_tripleF_2; easy.
Qed.

Lemma replace2F_tripleF_12 :
   (x0 x1 x2 y1 y2 : E),
    replace2F (tripleF x0 x1 x2) y1 y2 ord1 ord_max = tripleF x0 y1 y2.
Proof.
intros; unfold replace2F; rewrite replaceF_tripleF_1 replaceF_tripleF_2; easy.
Qed.

Lemma PAF_ind_replace2F :
   {n} {P : 'Prop^n} {i0 i1} p0 p1,
    P i0 P i1 PAF (replace2F P p0 p1 i0 i1) PAF P.
Proof.
intros n P i0 i1 p0 p1 H0 H1 H2; destruct (ord_eq_dec i1 i0) as [Hi | Hi].
rewrite replace2F_correct_eq// in H2; apply (PAF_ind_replaceF p1 H1 H2).
rewrite -(replaceF_correct_r _ p0 Hi) in H1.
apply: (PAF_ind_replaceF p0 H0) (PAF_ind_replaceF _ H1 H2).
Qed.

Lemma extF_replace2F :
   {n} (A B : 'E^n) x0 x1 i0 i1,
    A i0 = B i0 A i1 = B i1
    replace2F A x0 x1 i0 i1 = replace2F B x0 x1 i0 i1 A = B.
Proof.
intros n A B x0 x1 i0 i1 H0 H1 H2; apply extF; intros i.
destruct (ord_eq_dec i i0) as [Hi0 | Hi0]; try now rewrite Hi0.
destruct (ord_eq_dec i i1) as [Hi1 | Hi1]; try now rewrite Hi1.
rewrite <- (replace2F_correct_r A x0 x1 Hi0 Hi1),
    <- (replace2F_correct_r B x0 x1 Hi0 Hi1), H2; easy.
Qed.

Lemma skip2F_replace2F :
   {n} (A : 'E^n.+2) x0 x1 {i0 i1} (H : i1 i0),
    skip2F (replace2F A x0 x1 i0 i1) H = skip2F A H.
Proof.
intros; apply skip2F_compat; move=>> [H0 H1]; apply replace2F_correct_r; easy.
Qed.

End ReplaceF_Facts.

Section PermutF_Facts1.

Context {E : Type}.

Properties of operators permutF/revF/moveF/transpF.

Lemma permutF_id_alt : {n}, permutF (@id 'I_n) = @id 'E^n.
Proof. easy. Qed.

Lemma permutF_id :
   {n} (p : 'I_[n]), same_fun p id permutF p = (@id 'E^n).
Proof. move=>> /fun_ext Hp; subst; easy. Qed.

Lemma permutF_comp :
   {n} p q (A : 'E^n), permutF q (permutF p A) = permutF (p \o q) A.
Proof. easy. Qed.

Lemma permutF_can :
   {n} p q (A : 'E^n), cancel q p permutF q (permutF p A) = A.
Proof.
move=>> H; rewrite permutF_comp; apply extF; intros i.
unfold permutF, comp; rewrite H; easy.
Qed.

Lemma permutF_invol :
   {n} p, involutive p involutive (@permutF E n p).
Proof.
move=>> Hp; move=>>; apply extF; intro; unfold permutF; rewrite Hp; easy.
Qed.

Lemma permutF_inj : {n} p, injective p injective (@permutF E n p).
Proof.
move=>> /injF_bij [q _ Hq] A B /extF_rev H; apply extF; intros i.
rewrite -(Hq i); apply H.
Qed.

Lemma permutF_inj_compat :
   {n} {p} (Hp : injective p) {A : 'E^n},
    injective A injective (permutF p A).
Proof. move=>> Hp A HA i j /HA /Hp; easy. Qed.

Lemma permutF_f_inv_l :
   {n} {p} (Hp : bijective p) (A : 'E^n),
    A = permutF (f_inv Hp) (permutF p A).
Proof. intros n p Hp A; rewrite permutF_can //; apply f_inv_can_r. Qed.

Lemma permutF_f_inv_r :
   {n} {p} (Hp : bijective p) (A : 'E^n),
    A = permutF p (permutF (f_inv Hp) A).
Proof. intros n p Hp A; rewrite permutF_can //; apply f_inv_can_l. Qed.

Lemma permutF_invalF_l : {n} p (A : 'E^n), invalF (permutF p A) A.
Proof. intros n p A i; (p i); easy. Qed.

Lemma permutF_invalF_r :
   {n} p (A : 'E^n), surjective p invalF A (permutF p A).
Proof.
move=>> /surj_has_right_inv [q Hq] i;
     (q i); unfold permutF; rewrite Hq; easy.
Qed.

Lemma castF_permutF :
   {n1 n2} (H : n1 = n2) p (A1 : 'E^n1),
    castF H (permutF p A1) = permutF (cast_f_ord H p) (castF H A1).
Proof.
intros; apply extF; intro; unfold castF, permutF; f_equal; apply ord_inj; easy.
Qed.

Lemma permutF_castF :
   {n1 n2} (H : n1 = n2) p (A1 : 'E^n1),
    permutF p (castF H A1) = castF H (permutF (cast_f_ord (eq_sym H) p) A1).
Proof.
intros; apply (castF_inj (eq_sym H)); rewrite castF_permutF !castF_can_r; easy.
Qed.

Lemma permutF_liftF_S :
   {n} p (A : 'E^n.+1),
    liftF_S (permutF p A) = funF (liftF_S p) A.
Proof. easy. Qed.

Lemma permutF_widenF_S :
   {n} p (A : 'E^n.+1),
    widenF_S (permutF p A) = funF (widenF_S p) A.
Proof. easy. Qed.

Lemma firstF_permutF :
   {n1 n2} p (A : 'E^(n1 + n2)),
    firstF (permutF p A) = funF (firstF p) A.
Proof. easy. Qed.

Lemma lastF_permutF :
   {n1 n2} p (A : 'E^(n1 + n2)),
    lastF (permutF p A) = funF (lastF p) A.
Proof. easy. Qed.

Lemma skipF_permutF :
   {n} {p} (Hp : injective p) (A : 'E^n.+1) i0,
    skipF (permutF p A) i0 = permutF (skip_f_ord Hp i0) (skipF A (p i0)).
Proof.
move=>>; apply extF; intro; unfold permutF; rewrite skipF_correct; easy.
Qed.

Lemma revF_invol : {n}, involutive (@revF E n).
Proof. intros; apply permutF_invol, rev_ordK. Qed.

Lemma revF_inj : {n}, injective (@revF E n).
Proof. intros; apply permutF_inj, rev_ord_inj. Qed.

Lemma revF_inj_compat :
   {n} {A : 'E^n}, injective A injective (revF A).
Proof. move=>>; apply permutF_inj_compat, rev_ord_inj. Qed.

Lemma revF_S_0 : {n} (A : 'E^n.+1), revF A ord0 = A ord_max.
Proof. intros; rewrite revF_correct rev_ord_0; easy. Qed.

Lemma revF_S_r :
   {n} (A : 'E^n.+1), liftF_S (revF A) = revF (widenF_S A).
Proof.
intros; unfold revF, permutF, liftF_S, widenF_S; apply extF; intro; f_equal.
apply rev_ord_r.
Qed.

Lemma revF_S_l :
   {n} (A : 'E^n.+1), widenF_S (revF A) = revF (liftF_S A).
Proof.
intros; unfold revF, permutF, liftF_S, widenF_S; apply extF; intro; f_equal.
apply rev_ord_l.
Qed.

Lemma revF_S_max : {n} (A : 'E^n.+1), revF A ord_max = A ord0.
Proof. intros; rewrite revF_correct rev_ord_max; easy. Qed.

Lemma revF_invalF_l : {n} (A : 'E^n), invalF (revF A) A.
Proof. intros; apply permutF_invalF_l. Qed.

Lemma revF_invalF_r : {n} (A : 'E^n), invalF A (revF A).
Proof. intros; apply permutF_invalF_r, bij_surj, rev_ord_bij. Qed.

Lemma revF_castF :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1),
    revF (castF H A1) = castF H (revF A1).
Proof. intros; unfold revF; rewrite permutF_castF cast_f_rev_ord; easy. Qed.

Lemma firstF_revF :
   {n1 n2} (A : 'E^(n1 + n2)),
    firstF (revF A) = revF (lastF (castF (addnC n1 n2) A)).
Proof.
intros; apply extF; intro; unfold firstF, lastF, revF, permutF, castF; f_equal.
apply ord_inj; simpl; rewrite addnC addnBA; easy.
Qed.

Lemma revF_firstF :
   {n1 n2} (A : 'E^(n1 + n2)),
    revF (firstF A) = lastF (castF (addnC n1 n2) (revF A)).
Proof. intros; apply revF_inj; rewrite -firstF_revF !revF_invol; easy. Qed.

Lemma firstF_lastF_eq_revF :
   {n1 n2} (A : 'E^(n1 + n2)),
    firstF A = revF (lastF (castF (addnC n1 n2) (revF A))).
Proof. intros; rewrite -revF_firstF revF_invol; easy. Qed.

Lemma revF_lastF :
   {n1 n2} (A : 'E^(n1 + n2)),
    revF (lastF A) = firstF (castF (addnC n1 n2) (revF A)).
Proof.
intros; rewrite -revF_castF firstF_revF castF_comp castF_id; easy.
Qed.

Lemma lastF_revF :
   {n1 n2} (A : 'E^(n1 + n2)),
    lastF (revF A) = revF (firstF (castF (addnC n1 n2) A)).
Proof. intros; rewrite revF_firstF revF_castF castF_comp castF_id; easy. Qed.

Lemma lastF_firstF_eq_revF :
   {n1 n2} (A : 'E^(n1 + n2)),
    lastF A = revF (firstF (castF (addnC n1 n2) (revF A))).
Proof. intros; rewrite -lastF_revF revF_invol; easy. Qed.

Lemma skipF_revF :
   {n} (A : 'E^n.+1) i0,
    skipF (revF A) i0 = revF (skipF A (rev_ord i0)).
Proof.
intros n A i0; rewrite (skipF_permutF rev_ord_inj); unfold revF; f_equal.
apply extF; intros i;
    apply (skip_ord_inj (rev_ord i0)); rewrite skip_f_ord_correct.
apply ord_inj; simpl.
destruct i0 as [i0 Hi0], i as [i Hi]; simpl.
destruct (lt_dec i i0) as [H1 | H1]; [rewrite bump_l// | rewrite bump_r_alt//];
    (destruct (lt_dec (n - i.+1) (n.+1 - i0.+1)) as [H2 | H2];
    [rewrite bump_l// | rewrite bump_r_alt//]).
2: rewrite subSS subnSK; easy.
all: exfalso.
move: H1 H2; rewrite -minusE; lia.
rewrite -minusE in H2; move: Hi ⇒ /ltP; move: Hi0 ⇒ /ltP; lia.
Qed.

Lemma revF_skipF :
   {n} (A : 'E^n.+1) i0,
    revF (skipF A i0) = skipF (revF A) (rev_ord i0).
Proof. intros; rewrite skipF_revF rev_ordK; easy. Qed.

Lemma moveF_inj :
   {n} i0 i1, injective (fun A : 'E^n.+1moveF A i0 i1).
Proof. intros; apply permutF_inj, move_ord_inj. Qed.

Lemma moveF_inj_compat :
   {n} {A : 'E^n.+1} i0 i1, injective A injective (moveF A i0 i1).
Proof. move=>>; apply permutF_inj_compat, move_ord_inj. Qed.

Lemma moveF_invalF_l :
   {n} (A : 'E^n.+1) i0 i1, invalF (moveF A i0 i1) A.
Proof. intros; apply permutF_invalF_l. Qed.

Lemma moveF_invalF_r :
   {n} (A : 'E^n.+1) i0 i1, invalF A (moveF A i0 i1).
Proof. intros; apply permutF_invalF_r, bij_surj, move_ord_bij. Qed.

Lemma castF_moveF :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1.+1) i0 i1,
    let HH := eq_S n1 n2 H in
    castF HH (moveF A1 i0 i1) =
      moveF (castF HH A1) (cast_ord HH i0) (cast_ord HH i1).
Proof.
intros; rewrite castF_permutF; unfold moveF; rewrite cast_f_move_ord; easy.
Qed.

Lemma moveF_castF :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1.+1) i0 i1,
    let HH := eq_S n1 n2 H in
    moveF (castF HH A1) i0 i1 =
      castF HH (moveF A1 (cast_ord (eq_sym HH) i0) (cast_ord (eq_sym HH) i1)).
Proof.
intros n1 n2 H A1 i0 i1 HH; apply (castF_inj (eq_sym HH)).
rewrite castF_moveF !cast_ord_comp !cast_ord_id; easy.
Qed.

Lemma firstF_moveF :
   {n1 n2} (A : 'E^(n1 + n2).+1) i0 i1,
    firstF (castF (addSn_sym n1 n2) (moveF A i0 i1)) =
      funF (firstF (castF (addSn_sym n1 n2) (move_ord i0 i1))) A.
Proof.
intros n1 n2 A i0 i1; rewrite (firstF_castF n1.+1 n2) !castF_id.
apply: firstF_permutF.
Qed.

Lemma lastF_moveF :
   {n1 n2} (A : 'E^(n1 + n2).+1) i0 i1,
    lastF (castF (addnS_sym _ _) (moveF A i0 i1)) =
      funF (lastF (castF (addnS_sym _ _) (move_ord i0 i1))) A.
Proof. easy. Qed.

Lemma skipF_moveF :
   {n} (A : 'E^n.+1) i0 i1 j0,
    skipF (moveF A i0 i1) j0 =
      funF (skip_f_ord (move_ord_inj i0 i1) j0) (skipF A (move_ord i0 i1 j0)).
Proof. intros; apply skipF_permutF. Qed.

Lemma moveF_equiv_def :
   {n} (A : 'E^n.+1) i0 i1,
    moveF A i0 i1 = insertF (skipF A i0) (A i0) i1.
Proof.
intros n A i0 i1; apply extF; intros i; destruct (ord_eq_dec i i1) as [Hi | Hi].
rewrite moveF_correct_l// insertF_correct_l//.
rewrite moveF_correct_r insertF_correct_r//.
Qed.

Lemma transpF_invol :
   {n} i0 i1, involutive (fun A : 'E^ntranspF A i0 i1).
Proof. intros; apply permutF_invol, transp_ord_invol. Qed.

Lemma transpF_inj :
   {n} i0 i1, injective (fun A : 'E^ntranspF A i0 i1).
Proof. intros; apply permutF_inj, transp_ord_inj. Qed.

Lemma transpF_inj_compat :
   {n} {A : 'E^n} i0 i1, injective A injective (transpF A i0 i1).
Proof. move=>>; apply permutF_inj_compat, transp_ord_inj. Qed.

Lemma transpF_invalF_l :
   {n} (A : 'E^n) i0 i1, invalF (transpF A i0 i1) A.
Proof. intros; apply permutF_invalF_l. Qed.

Lemma transpF_invalF_r :
   {n} (A : 'E^n) i0 i1, invalF A (transpF A i0 i1).
Proof. intros; apply permutF_invalF_r, bij_surj, transp_ord_bij. Qed.

Lemma castF_transpF :
   {n1 n2} (H : n1 = n2) (A1 : 'E^n1) i0 i1,
    castF H (transpF A1 i0 i1) =
      transpF (castF H A1) (cast_ord H i0) (cast_ord H i1).
Proof.
intros; rewrite castF_permutF; unfold transpF; rewrite cast_f_transp_ord; easy.
Qed.

Lemma firstF_transpF :
   {n1 n2} (A : 'E^(n1 + n2)) i0 i1,
    firstF (transpF A i0 i1) = funF (firstF (transp_ord i0 i1)) A.
Proof. easy. Qed.

Lemma lastF_transpF :
   {n1 n2} (A : 'E^(n1 + n2)) i0 i1,
    lastF (transpF A i0 i1) = funF (lastF (transp_ord i0 i1)) A.
Proof. easy. Qed.

Lemma skipF_transpF :
   {n} (A : 'E^n.+1) i0 i1 j0,
    skipF (transpF A i0 i1) j0 =
      funF (skip_f_ord (transp_ord_inj i0 i1) j0)
        (skipF A (transp_ord i0 i1 j0)).
Proof. intros; apply skipF_permutF. Qed.

Lemma transpF_equiv_def :
   {n} (A : 'E^n) i0 i1,
    transpF A i0 i1 = replace2F A (A i1) (A i0) i0 i1.
Proof.
intros n A i0 i1; apply extF; intros i.
destruct (ord_eq2_dec i i0 i1) as [[Hi | Hi] | [Hi1 Hi2]].
rewrite transpF_correct_l0//; destruct (ord_eq_dec i1 i0) as [H | H].
subst; rewrite replace2F_correct_eq// replaceF_correct_l//.
rewrite replace2F_correct_l0//.
rewrite transpF_correct_l1// replace2F_correct_l1//.
rewrite transpF_correct_r// replace2F_correct_r//.
Qed.

End PermutF_Facts1.

Section PermutF_Facts2.

Context {E : Type}.

Lemma first_f_extendF :
   {n1 n2} {f : 'I_{n1,n1 + n2}} (Hf : injective f),
     (p : 'I_[n1 + n2]), bijective p f = firstF p.
Proof.
intros n1 n2 f Hf; destruct (injF_extend_bij_EX Hf) as [p [Hp1 Hp2]]; p.
split; [easy |].
apply extF; intros i1; rewrite Hp2; unfold widenF, firstF; f_equal.
apply ord_inj; easy.
Qed.

Lemma last_f_extendF :
   {n1 n2} {f : 'I_{n2,n1 + n2}} (Hf : injective f),
     (p : 'I_[n1 + n2]), bijective p f = lastF p.
Proof.
intros n1 n2 f' Hf'; pose (f := revF f').
assert (Hf0 : f' = revF f) by apply eq_sym, revF_invol.
assert (Hf1 : injective f) by now apply revF_inj_compat.
destruct (injF_extend_bij_EX Hf1) as [p [Hp1 Hp2]]; (revF p).
split; [apply injF_bij, revF_inj_compat, bij_inj; easy |].
apply extF; intros i2; unfold lastF; rewrite Hf0 !revF_correct Hp2.
unfold widenF; f_equal.
apply ord_inj; simpl; rewrite addnC -addnS subnDA addnK; easy.
Qed.

End PermutF_Facts2.

Section FilterPF_Facts1.

Definition and properties of filterP_f_ord.

Definition filterP_f_ord
    {n1 n2} {P1 : 'Prop^n1} {P2 : 'Prop^n2} (f : 'I_{n1,n2})
    {i1} (HP2 : P2 (f i1)) : 'I_{lenPF P1,lenPF P2} :=
  fun j1unfilterP_ord HP2 (f (filterP_ord j1)).

Lemma filterP_f_ord_correct :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2}
      {i1} (HP2 : P2 (f i1)) {j1 : 'I_(lenPF P1)},
    injective f extendPF f P1 P2
    filterP_ord (filterP_f_ord f HP2 j1) = f (filterP_ord j1).
Proof.
intros n1 n2 f P1 P2 i1 HP2 j1 Hf HP; rewrite filterP_unfilterP_ord_in//.
rewrite (extendPF_unfunF_rev Hf HP) (unfunF_correct_l _ (filterP_ord j1) _ Hf);
    [apply filterP_ord_correct | easy].
Qed.

Lemma filterP_f_ord_correct_alt :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2}
      {i1} (HP2 : P2 (f i1)) {j1 : 'I_(lenPF P1)} {j2 : 'I_(lenPF P2)},
    injective f extendPF f P1 P2
    filterP_f_ord f HP2 j1 = j2 f (filterP_ord j1) = filterP_ord j2.
Proof.
move=>> Hf HP;
    rewrite -(inj_equiv (filterP_ord_inj _)) (filterP_f_ord_correct _ Hf HP)//.
Qed.

Lemma filterP_f_ord_comp :
   {n1 n2 n3} {P1 : 'Prop^n1} {P2 : 'Prop^n2} {P3 : 'Prop^n3}
      {f12 : 'I_{n1,n2}} {f23 : 'I_{n2,n3}}
      {i1} (HP2 : P2 (f12 i1)) {HP3 : P3 (f23 (f12 i1))} {j1 : 'I_(lenPF P1)},
    injective f12 extendPF f12 P1 P2
    filterP_f_ord (f23 \o f12) HP3 j1 =
      filterP_f_ord f23 HP3 (filterP_f_ord f12 HP2 j1).
Proof.
move=>> Hf12 HP12; unfold filterP_f_ord at 2.
rewrite (filterP_f_ord_correct _ Hf12 HP12); easy.
Qed.

Lemma filterP_f_ord_comp_l :
   {n1 n2} {P1 : 'Prop^n1} {P2 : 'Prop^n2} {p1 : 'I_[n1]} {f : 'I_{n1,n2}}
      {i1} (HP1 : P1 (p1 i1)) {HP2 : P2 (f (p1 i1))}
      {j1 : 'I_(lenPF (permutF p1 P1))},
    injective p1
    filterP_f_ord (f \o p1) HP2 j1 =
      filterP_f_ord f HP2 (filterP_f_ord p1 HP1 j1).
Proof.
move=>> Hp1; apply (filterP_f_ord_comp _ Hp1), (extendPF_permutF _ Hp1).
Qed.

Context {E : Type}.

Properties of operators lenPF/filterPF/splitPF.

Lemma filterPF_eq_funF :
   {n} (P : 'Prop^n) (A : 'E^n), filterPF P A = funF filterP_ord A.
Proof. easy. Qed.

Lemma filter_eqF_gen_eq_funF :
   {F : Type} {n} (A : 'E^n) x0 (B : 'F^n),
    filter_eqF_gen A x0 B = funF filterP_ord B.
Proof. easy. Qed.

Lemma filter_eqF_eq_funF :
   {n} (A : 'E^n) x0, filter_eqF A x0 = funF filterP_ord A.
Proof. easy. Qed.

Lemma filter_neqF_gen_eq_funF :
   {F : Type} {n} (A : 'E^n) x0 (B : 'F^n),
    filter_neqF_gen A x0 B = funF filterP_ord B.
Proof. easy. Qed.

Lemma filter_neqF_eq_funF :
   {n} (A : 'E^n) x0, filter_neqF A x0 = funF filterP_ord A.
Proof. easy. Qed.

Lemma filterPF_nil :
   {n} (P : 'Prop^n) (A B : 'E^n), n = 0 filterPF P A = filterPF P B.
Proof.
intros; subst; apply extF; intros [j Hj]; exfalso.
rewrite lenPF_nil in Hj; easy.
Qed.

Lemma filterPF_ext_l_gen :
   {n1 n2} (Hn : n1 = n2) {P1 : 'Prop^n1} {P2 : 'Prop^n2}
      (HP : iffAF P1 (castF (eq_sym Hn) P2)) (A1 : 'E^n1),
    let A2 := castF Hn A1 in
    filterPF P1 A1 =
      castF (eq_sym (lenPF_ext_gen Hn (iffAF_eq_sym Hn HP))) (filterPF P2 A2).
Proof.
intros n1 n2 Hn P1 P2 HP A1 A2; unfold A2; subst; rewrite castF_id; clear A2.
apply extF; intro; unfold filterPF, castF; f_equal; apply ord_inj; simpl.
assert (HP' : iffAF P1 P2) by now intro; rewrite HP castF_id.
rewrite eq_sym_involutive (filterP_ord_ext HP')
    (filterP_cast_ord_eq (lenPF_ext _) (lenPF_ext_gen _ (iffAF_eq_sym _ _))); easy.
Qed.

Lemma filterPF_ext_l :
   {n P Q} (H : iffAF P Q) (A : 'E^n),
    filterPF P A = castF (eq_sym (lenPF_ext H)) (filterPF Q A).
Proof.
intros; apply extF; intro; unfold filterPF, castF; f_equal.
rewrite eq_sym_involutive; apply filterP_ord_ext.
Qed.

Lemma filterPF_ext_r :
   {n} (P : 'Prop^n) (A B : 'E^n),
    eqPF P A B filterPF P A = filterPF P B.
Proof. move=>> H; apply extF; intro; apply H, filterP_ord_correct. Qed.

Lemma filterPF_invalF :
   {n} P (A : 'E^n), invalF (filterPF P A) A.
Proof. intros n P A j; (enum_val j); easy. Qed.

Lemma lenPF_castF :
   {n1 n2} (H : n1 = n2) (P1 : 'Prop^n1), lenPF (castF H P1) = lenPF P1.
Proof. intros; subst; rewrite castF_id//. Qed.

Lemma filterPF_castF_l :
   {n1 n2} (H : n1 = n2) (P1 : 'Prop^n1) (A2 : 'E^n2),
    filterPF (castF H P1) A2 =
      castF (eq_sym (lenPF_castF H P1)) (filterPF P1 (castF (eq_sym H) A2)).
Proof.
intros n1 n2 H P1 A2; subst.
assert (HP : iffAF (castF (erefl n2) P1) P1) by now rewrite castF_id.
rewrite (filterPF_ext_l HP) eq_sym_refl (castF_refl A2); f_equal; easy.
Qed.

Lemma filterPF_castF_r :
   {n1 n2} (H : n1 = n2) (P2 : 'Prop^n2) (A1 : 'E^n1),
    filterPF P2 (castF H A1) =
      castF (lenPF_castF (eq_sym H) P2)
            (filterPF (castF (eq_sym H) P2) A1).
Proof.
intros n1 n2 H P2 A1; subst; rewrite eq_sym_refl castF_id.
assert (HP : iffAF (castF (erefl n2) P2) P2) by now rewrite castF_id.
rewrite (filterPF_ext_l HP) castF_comp castF_id; easy.
Qed.

Lemma filterPF_castF :
   {n1 n2} (H : n1 = n2) (P1 : 'Prop^n1) (A1 : 'E^n1),
    filterPF (castF H P1) (castF H A1) =
      castF (eq_sym (lenPF_castF H P1)) (filterPF P1 A1).
Proof. intros; rewrite filterPF_castF_l castF_can; easy. Qed.

Lemma lenPF_singleF_in : {P : Prop}, P lenPF (singleF P) = 1.
Proof. intros; apply lenPF1_in; easy. Qed.

Lemma filterPF_singleF_in :
   {P : Prop} (HP : P) (A : E),
    filterPF (singleF P) (singleF A) =
      castF (eq_sym (lenPF_singleF_in HP)) (singleF A).
Proof.
intros; apply extF; intro; unfold filterPF; rewrite !singleF_0; easy.
Qed.

Lemma lenPF_singleF_out : {P : Prop}, ¬ P lenPF (singleF P) = 0.
Proof. intros; apply lenPF1_out; easy. Qed.

Lemma filterPF_singleF_out :
   {P : Prop} (HP : ¬ P) (A : E) (B0 : 'E^0),
    filterPF (singleF P) (singleF A) =
      castF (eq_sym (lenPF_singleF_out HP)) B0.
Proof.
intros; apply extF; intros [i Hi]; exfalso.
rewrite (lenPF_singleF_out HP) in Hi; easy.
Qed.

Lemma filterPF_ind_l_in :
   {n} {P : 'Prop^n.+1} (HP : P ord0) (A : 'E^n.+1),
    filterPF P A =
      castF (eq_sym (lenPF_ind_l_in HP))
        (concatF (singleF (A ord0)) (filterPF (liftF_S P) (liftF_S A))).
Proof.
intros n P HP0 A; apply (castF_inj (lenPF_ind_l_in HP0)); rewrite castF_can.
assert (HP1 : iffAF P (castF_1pS (concatF (singleF (P ord0)) (liftF_S P))))
    by now rewrite -concatF_splitF_S1p.
rewrite (filterPF_ext_l HP1) {1}(concatF_splitF_S1p A) filterPF_castF !castF_comp.
pose (P0 := singleF (P ord0)); fold P0; pose (P' := liftF_S P); fold P'.
pose (A0 := singleF (A ord0)); fold A0; pose (A' := liftF_S A); fold A'.
pose (H := eq_trans (eq_sym (lenPF_castF (add1n n) (concatF P0 P')))
             (eq_trans (eq_sym (lenPF_ext HP1)) (lenPF_ind_l_in HP0))).
rewrite (castF_eq_l _ H).
apply extF; intros j; unfold filterPF, castF.
destruct (lt_dec (filterP_ord (cast_ord (eq_sym H) j)) 1) as [Hj1 | Hj1],
    (lt_dec j 1) as [Hj2 | Hj2].
rewrite !concatF_correct_l !I_1_is_unit; easy.
contradict Hj2; move: Hj1; rewrite -!ord0_lt_equiv;
    move⇒ /(filterP_ord_ind_l_in_0_rev HP0) Hj.
rewrite cast_ord_comp cast_ord_0_equiv in Hj; apply ord_inj; easy.
contradict Hj1; move: Hj2; rewrite -!ord0_lt_equiv; move=>> →.
assert (HP0' : concatF P0 P' ord0) by easy.
apply (filterP_ord_ind_l_in_0 HP0'), ord_inj; easy.
rewrite !concatF_correct_r; f_equal; apply ord_inj; simpl; apply addn_is_subn.
assert (H0 : cast_ord (lenPF_ind_l_in HP0) (cast_ord (eq_sym H) j) ord0).
  rewrite cast_ord_comp; contradict Hj2; apply cast_ord_0_equiv in Hj2.
  simpl; rewrite Hj2; apply Nat.lt_0_1.
rewrite filterP_ord_ind_l_in_n0 lift_S_correct -add1n; f_equal.
assert (HP2 : iffAF (liftF_S (concatF P0 P')) (liftF_S P)).
  unfold P0, P'; rewrite concatF_splitF_S1p'.
  unfold castF_S1p; rewrite castF_id; easy.
rewrite (filterP_ord_ext HP2).
assert (Hj : cast_ord (lenPF_ext HP2) (lower_S H0) = concat_r_ord Hj2)
    by now apply ord_inj.
rewrite Hj; easy.
Qed.

Lemma filterPF_ind_l_out :
   {n} {P : 'Prop^n.+1} (HP : ¬ P ord0) (A : 'E^n.+1),
    filterPF P A =
      castF (eq_sym (lenPF_ind_l_out HP)) (filterPF (liftF_S P) (liftF_S A)).
Proof.
intros n P HP A; apply (castF_inj (lenPF_ind_l_out HP)); rewrite castF_can.
assert (HP1 : iffAF P (castF_1pS (concatF (singleF (P ord0)) (liftF_S P))))
    by now rewrite -concatF_splitF_S1p.
rewrite (filterPF_ext_l HP1) {1}(concatF_splitF_S1p A) filterPF_castF !castF_comp.
pose (P0 := singleF (P ord0)); fold P0; pose (P' := liftF_S P); fold P'.
pose (A0 := singleF (A ord0)); fold A0; pose (A' := liftF_S A); fold A'.
pose (H := eq_trans (eq_sym (lenPF_castF (add1n n) (concatF P0 P')))
             (eq_trans (eq_sym (lenPF_ext HP1)) (lenPF_ind_l_out HP))).
rewrite (castF_eq_l _ H).
apply extF; intros j; unfold filterPF, castF.
destruct (lt_dec (filterP_ord (cast_ord (eq_sym H) j)) 1) as [Hj | Hj].
contradict Hj; rewrite -ord0_lt_equiv filterP_ord_ind_l_out.
apply lift_S_not_first.
rewrite concatF_correct_r; f_equal; apply ord_inj; simpl; apply addn_is_subn.
rewrite filterP_ord_ind_l_out lift_S_correct -add1n; f_equal.
assert (HP2 : iffAF (liftF_S (concatF P0 P')) (liftF_S P)).
  unfold P0, P'; rewrite concatF_splitF_S1p'.
  unfold castF_S1p; rewrite castF_id; easy.
rewrite (filterP_ord_ext HP2) !cast_ord_comp cast_ord_id; easy.
Qed.

Lemma lenPF_ind_l :
   {n} (P : 'Prop^n.+1),
    lenPF P = lenPF (singleF (P ord0)) + lenPF (liftF_S P).
Proof.
intros n P; destruct (classic (P ord0)) as [HP | HP].
rewrite (lenPF_ind_l_in HP) (lenPF_singleF_in HP) //.
rewrite (lenPF_ind_l_out HP) (lenPF_singleF_out HP) //.
Qed.

Lemma filterPF_ind_l :
   {n} (P : 'Prop^n.+1) (A : 'E^n.+1),
    filterPF P A =
      castF (eq_sym (lenPF_ind_l P))
        (concatF (filterPF (singleF (P ord0)) (singleF (A ord0)))
                 (filterPF (liftF_S P) (liftF_S A))).
Proof.
intros n P A; destruct (classic (P ord0)) as [HP | HP].
rewrite filterPF_ind_l_in filterPF_singleF_in concatF_castF_l castF_comp.
apply castF_eq_l.
rewrite filterPF_ind_l_out (concatF_nil_l' (lenPF_singleF_out HP)) castF_comp.
apply castF_eq_l.
Qed.

Lemma filterPF_ind_r_in :
   {n} {P : 'Prop^n.+1} (HP : P ord_max) (A : 'E^n.+1),
    filterPF P A =
      castF (eq_sym (lenPF_ind_r_in HP))
        (concatF (filterPF (widenF_S P) (widenF_S A)) (singleF (A ord_max))).
Proof.
intros n P HPn A; apply (castF_inj (lenPF_ind_r_in HPn)); rewrite castF_can.
assert (HP1 : iffAF P (castF_p1S (concatF (widenF_S P) (singleF (P ord_max)))))
    by now rewrite -concatF_splitF_Sp1.
rewrite (filterPF_ext_l HP1) {1}(concatF_splitF_Sp1 A) filterPF_castF !castF_comp.
pose (P' := widenF_S P); fold P'; pose (Pn := singleF (P ord_max)); fold Pn.
pose (A' := widenF_S A); fold A'; pose (An := singleF (A ord_max)); fold An.
pose (H := eq_trans (eq_sym (lenPF_castF (addn1 n) (concatF P' Pn)))
             (eq_trans (eq_sym (lenPF_ext HP1)) (lenPF_ind_r_in HPn))).
rewrite (castF_eq_l _ H).
apply extF; intros j; unfold filterPF, castF.
destruct (lt_dec (filterP_ord (cast_ord (eq_sym H) j)) n) as [Hj1 | Hj1],
    (lt_dec j (lenPF P')) as [Hj2 | Hj2].
rewrite !concatF_correct_l; f_equal; apply ord_inj; simpl.
assert (H0 : lenPF (concatF P' Pn) = lenPF P)
    by apply eq_sym, (lenPF_ext_gen (eq_sym (addn1 n))), HP1.
assert (HP1' : i, concatF P' Pn i P (cast_ord (addn1 n) i))
  by now intros; rewrite HP1; unfold castF_p1S; rewrite castF_cast_ord.
rewrite (filterP_ord_ext_gen HP1') cast_ord_comp; simpl.
assert (Hn : cast_ord (lenPF_ind_r_in_S HPn)
    (cast_ord (etrans (eq_sym H) (lenPF_ext_gen (addn1 n) HP1')) j) ord_max).
  rewrite cast_ord_comp; contradict Hj2; apply cast_ord_max_equiv in Hj2.
  rewrite Hj2; apply Nat.lt_irrefl.
rewrite filterP_ord_ind_r_in_nmax widen_S_correct.
assert (Hj : narrow_S Hn = concat_l_ord Hj2) by now apply ord_inj.
rewrite Hj; easy.
contradict Hj1; move: Hj2; rewrite !(cast_ord_val (addn1 _))
    !Nat.nlt_ge -!ord_max_ge_equiv -filterP_cast_ord.
assert (HPn' : concatF P' Pn (cast_ord (eq_sym (addn1 n)) ord_max))
    by now clear H; rewrite (concatF_splitF_Sp1 P) in HPn.
intros Hj; rewrite cast_ord_max_equiv in Hj; apply (filterP_ord_ind_r_in_max HPn').
rewrite !cast_ord_comp; apply ord_inj; simpl.
rewrite Hj; apply lenPF_ext; intros i; rewrite concatF_splitF_Sp1'.
unfold castF_Sp1, castF; rewrite cast_ord_comp cast_ord_id; easy.
contradict Hj2; move: Hj1; rewrite !(cast_ord_val (addn1 _))
    !Nat.nlt_ge -!ord_max_ge_equiv -filterP_cast_ord.
assert (HPn' : concatF P' Pn (cast_ord (eq_sym (addn1 n)) ord_max))
    by now clear H; rewrite (concatF_splitF_Sp1 P) in HPn.
move⇒ /(filterP_ord_ind_r_in_max_rev HPn') Hj.
rewrite !cast_ord_comp cast_ord_max_equiv in Hj; apply ord_inj; simpl.
rewrite Hj; apply lenPF_ext; intros i; rewrite concatF_splitF_Sp1'.
unfold castF_Sp1, castF; rewrite cast_ord_comp cast_ord_id; easy.
rewrite !concatF_correct_r !I_1_is_unit; easy.
Qed.

Lemma filterPF_ind_r_out :
   {n} {P : 'Prop^n.+1} (HP : ¬ P ord_max) (A : 'E^n.+1),
    filterPF P A =
      castF (eq_sym (lenPF_ind_r_out HP)) (filterPF (widenF_S P) (widenF_S A)).
Proof.
intros n P HPn A; apply (castF_inj (lenPF_ind_r_out HPn)); rewrite castF_can.
assert (HP1 : iffAF P (castF_p1S (concatF (widenF_S P) (singleF (P ord_max)))))
    by now rewrite -concatF_splitF_Sp1.
rewrite (filterPF_ext_l HP1) {1}(concatF_splitF_Sp1 A) filterPF_castF !castF_comp.
pose (P' := widenF_S P); fold P'; pose (Pn := singleF (P ord_max)); fold Pn.
pose (A' := widenF_S A); fold A'; pose (An := singleF (A ord_max)); fold An.
pose (H := eq_trans (eq_sym (lenPF_castF (addn1 n) (concatF P' Pn)))
             (eq_trans (eq_sym (lenPF_ext HP1)) (lenPF_ind_r_out HPn))).
rewrite (castF_eq_l _ H).
apply extF; intros j; unfold filterPF, castF.
destruct (lt_dec (filterP_ord (cast_ord (eq_sym H) j)) n) as [Hj | Hj].
rewrite concatF_correct_l; f_equal; apply ord_inj; simpl.
assert (H0 : lenPF (concatF P' Pn) = lenPF P)
    by apply eq_sym, (lenPF_ext_gen (eq_sym (addn1 n))), HP1.
assert (HP1' : i, concatF P' Pn i P (cast_ord (addn1 n) i))
  by now intros; rewrite HP1; unfold castF_p1S; rewrite castF_cast_ord.
rewrite (filterP_ord_ext_gen HP1') cast_ord_comp; simpl.
rewrite filterP_ord_ind_r_out widen_S_correct cast_ord_comp cast_ord_id; easy.
apply: (absurd _ _ HPn).
rewrite (cast_ord_val (addn1 _)) Nat.nlt_ge -ord_max_ge_equiv in Hj.
rewrite (concatF_splitF_Sp1 P) -{2}Hj -filterP_cast_ord cast_ord_comp.
apply filterP_ord_correct.
Qed.

Lemma lenPF_ind_r :
   {n} (P : 'Prop^n.+1),
    lenPF P = lenPF (widenF_S P) + lenPF (singleF (P ord_max)).
Proof.
intros n P; destruct (classic (P ord_max)) as [HP | HP].
rewrite (lenPF_ind_r_in HP) (lenPF_singleF_in HP) //.
rewrite (lenPF_ind_r_out HP) (lenPF_singleF_out HP) addn0 //.
Qed.

Lemma filterPF_ind_r :
   {n} (P : 'Prop^n.+1) (A : 'E^n.+1),
    filterPF P A =
      castF (eq_sym (lenPF_ind_r P))
        (concatF (filterPF (widenF_S P) (widenF_S A))
                 (filterPF (singleF (P ord_max)) (singleF (A ord_max)))).
Proof.
intros n P A; destruct (classic (P ord_max)) as [HP | HP].
rewrite filterPF_ind_r_in filterPF_singleF_in concatF_castF_r castF_comp.
apply castF_eq_l.
rewrite filterPF_ind_r_out (concatF_nil_r' (lenPF_singleF_out HP)) castF_comp.
apply castF_eq_l.
Qed.

Lemma lenPF_concatF :
   {n1 n2} (P1 : 'Prop^n1) (P2 : 'Prop^n2),
    lenPF (concatF P1 P2) = lenPF P1 + lenPF P2.
Proof.
intros n1 n2 P1 P2; induction n2 as [| n2 IHn2].
rewrite concatF_nil_r lenPF_castF lenPF_nil addn0; easy.
rewrite -(lenPF_castF (addnS n1 n2)) lenPF_ind_r (lenPF_ind_r P2).
rewrite widenF_S_concatF concatF_last IHn2 addnA; easy.
Qed.

Lemma filterPF_concatF :
   {n1 n2} P1 P2 (A1 : 'E^n1) (A2 : 'E^n2),
    filterPF (concatF P1 P2) (concatF A1 A2) =
      castF (eq_sym (lenPF_concatF P1 P2))
            (concatF (filterPF P1 A1) (filterPF P2 A2)).
Proof.
intros n1 n2; induction n2 as [| n2 IHn2]; intros P1 P2 A1 A2.
assert (HP : iffAF (concatF P1 P2) (castF (addn0_sym n1) P1))
    by now rewrite concatF_nil_r.
rewrite (filterPF_ext_l HP) (concatF_nil_r A1) filterPF_castF
    (concatF_nil_r' (lenPF_nil P2) (filterPF _ _)).
rewrite !castF_comp; apply castF_eq_l.
apply (castF_inj (eq_sym (lenPF_castF (addnS n1 n2) (concatF P1 P2)))).
rewrite -filterPF_castF filterPF_ind_r (filterPF_ind_r P2) castF_comp.
assert (HP : iffAF (widenF_S (castF (addnS n1 n2) (concatF P1 P2)))
    (concatF P1 (widenF_S P2))) by now rewrite widenF_S_concatF.
rewrite (filterPF_ext_l HP) (widenF_S_concatF A1 A2) IHn2.
assert (HPmax : iffAF (singleF (castF (addnS n1 n2) (concatF P1 P2) ord_max))
    (singleF (P2 ord_max))) by now rewrite concatF_last.
rewrite (filterPF_ext_l HPmax) (concatF_last A1 A2).
rewrite !concatF_castF_l !concatF_castF_r concatF_assoc_l !castF_comp.
apply castF_eq_l.
Qed.

Lemma lenPF_splitF :
   {n1 n2} (P : 'Prop^(n1 + n2)),
    lenPF P = lenPF (firstF P) + lenPF (lastF P).
Proof. intros; rewrite -lenPF_concatF -concatF_splitF //. Qed.

Lemma filterPF_splitF :
   {n1 n2} P (A : 'E^(n1 + n2)),
    filterPF P A =
      castF (eq_sym (lenPF_splitF P))
            (concatF (filterPF (firstF P) (firstF A))
                     (filterPF (lastF P) (lastF A))).
Proof.
intros n1 n2 P A.
assert (HP : iffAF P (concatF (firstF P) (lastF P)))
    by now rewrite -concatF_splitF.
rewrite (filterPF_ext_l HP) {1}(concatF_splitF A) filterPF_concatF.
rewrite !castF_comp; apply castF_eq_l.
Qed.

Lemma filterPF_firstF :
   {n1 n2} P (A : 'E^(n1 + n2)),
    filterPF (firstF P) (firstF A) =
      firstF (castF (lenPF_splitF P) (filterPF P A)).
Proof. intros; rewrite filterPF_splitF castF_can firstF_concatF; easy. Qed.

Lemma filterPF_lastF :
   {n1 n2} P (A : 'E^(n1 + n2)),
    filterPF (lastF P) (lastF A) =
      lastF (castF (lenPF_splitF P) (filterPF P A)).
Proof. intros; rewrite filterPF_splitF castF_can lastF_concatF; easy. Qed.

Lemma lenPF_permutF :
   {n} {p} {P : 'Prop^n}, injective p lenPF (permutF p P) = lenPF P.
Proof.
intros [| n] p P Hp; [rewrite !lenPF_nil; easy |].
apply (bijS_eq_card p), (injS_surjS_bijS I_S_is_nonempty);
    [apply funS_correct; easy | move=>> _ _; apply Hp |].
intros i Hi; (f_inv (injF_bij Hp) i); unfold permutF;
    rewrite f_inv_can_r; easy.
Qed.

Lemma lenPF_permutF_f_inv_l :
   {n} {p : 'I_[n]} (Hp : injective p) (P : 'Prop^n),
    let q := f_inv (injF_bij Hp) in
    lenPF (permutF q (permutF p P)) = lenPF P.
Proof. intros; rewrite -permutF_f_inv_l; easy. Qed.

Lemma lenPF_permutF_f_inv_r :
   {n} {p : 'I_[n]} (Hp : injective p) (P : 'Prop^n),
    let q := f_inv (injF_bij Hp) in
    lenPF (permutF p (permutF q P)) = lenPF P.
Proof. intros; rewrite -permutF_f_inv_r; easy. Qed.

Lemma filterPF_permutF :
   {n} {p : 'I_[n]} {P : 'Prop^n} {i0} (HP0 : P (p i0)) {A : 'E^n},
    injective p
    filterPF (permutF p P) (permutF p A) =
      funF (filterP_f_ord p HP0) (filterPF P A).
Proof.
move=>> Hp; apply extF; intros j; unfold filterPF, permutF, funF; f_equal.
rewrite filterP_f_ord_correct//; apply extendPF_funF, incl_RgF; easy.
Qed.

Lemma lenPF_revF : {n} {P : 'Prop^n}, lenPF (revF P) = lenPF P.
Proof. intros; apply lenPF_permutF, rev_ord_inj. Qed.

Lemma filterPF_revF :
   {n} {P : 'Prop^n} {i0} (HP0 : P (rev_ord i0)) {A : 'E^n},
    filterPF (revF P) (revF A) =
      funF (filterP_f_ord (@rev_ord n) HP0) (filterPF P A).
Proof. intros n P i0 HP0 A; apply (filterPF_permutF HP0 rev_ord_inj). Qed.

Lemma lenPF_moveF :
   {n} {P : 'Prop^n.+1} i0 i1, lenPF (moveF P i0 i1) = lenPF P.
Proof. intros; apply lenPF_permutF, move_ord_inj. Qed.

Lemma filterPF_moveF :
   {n} {P : 'Prop^n.+1} i0 i1 {j0} (HP : P (move_ord i0 i1 j0))
      {A : 'E^n.+1},
    filterPF (moveF P i0 i1) (moveF A i0 i1) =
      funF (filterP_f_ord (move_ord i0 i1) HP) (filterPF P A).
Proof.
intros n P i0 i1 j0 HP A; apply (filterPF_permutF HP (move_ord_inj _ _)).
Qed.

Lemma lenPF_transpF :
   {n} {P : 'Prop^n} i0 i1, lenPF (transpF P i0 i1) = lenPF P.
Proof. intros; apply lenPF_permutF, transp_ord_inj. Qed.

Lemma filterPF_transpF :
   {n} {P : 'Prop^n} i0 i1 {j0} (HP : P (transp_ord i0 i1 j0)) {A : 'E^n},
    filterPF (transpF P i0 i1) (transpF A i0 i1) =
      funF (filterP_f_ord (transp_ord i0 i1) HP) (filterPF P A).
Proof.
intros n P i0 i1 j0 HP A; apply (filterPF_permutF HP (transp_ord_inj _ _)).
Qed.

End FilterPF_Facts1.

Section FilterPF_Facts2.

Context {E : Type}.


Lemma lenPF_firstF_in :
   {n1 n2} {P : 'I_(n1 + n2) Prop},
    ( i1, firstF P i1) lenPF P = n1 + lenPF (lastF P).
Proof.
intros n1 n2 P HP; induction n1 as [| n1 Hn1].
rewrite {1}(concatF_splitF P) concatF_nil_l (add0n (lenPF _)); easy.
assert (H0 : castF (addSn n1 n2) P ord0)
    by now move: (HP ord0); rewrite firstF_0 (castF_eq _ ord0).
rewrite -(lenPF_castF (addSn n1 n2)) (lenPF_ind_l_in H0) Hn1;
    fold (liftF_S (castF (addSn n1 n2) P)).
rewrite -add1n addnA; f_equal; rewrite -lastF_S1p lastF2.
unfold castF_S1p; rewrite !castF_comp castF_id; easy.
intros; rewrite -liftF_S_firstF; apply HP.
Qed.

Lemma lenPF_firstF_out :
   {n1 n2} {P : 'I_(n1 + n2) Prop},
    ( i1, ¬ firstF P i1) lenPF P = lenPF (lastF P).
Proof.
intros n1 n2 P HP; induction n1 as [| n1 Hn1].
rewrite {1}(concatF_splitF P) concatF_nil_l; easy.
assert (H0 : ¬ castF (addSn n1 n2) P ord0)
    by now move: (HP ord0); rewrite firstF_0 (castF_eq _ ord0).
rewrite -(lenPF_castF (addSn n1 n2)) (lenPF_ind_l_out H0) Hn1;
    fold (liftF_S (castF (addSn n1 n2) P)).
f_equal; rewrite -lastF_S1p lastF2.
unfold castF_S1p; rewrite !castF_comp castF_id; easy.
intros; rewrite -liftF_S_firstF; apply HP.
Qed.

Lemma lenPF_lastF_in :
   {n1 n2} {P : 'I_(n1 + n2) Prop},
    ( i2, lastF P i2) lenPF P = lenPF (firstF P) + n2.
Proof.
intros; rewrite firstF_lastF_eq_revF lenPF_revF (addnC (lenPF _)) -lenPF_firstF_in.
rewrite lenPF_castF lenPF_revF; easy.
intro; rewrite -revF_lastF revF_correct; easy.
Qed.

Lemma lenPF_lastF_out :
   {n1 n2} {P : 'I_(n1 + n2) Prop},
    ( i2, ¬ lastF P i2) lenPF P = lenPF (firstF P).
Proof.
intros; rewrite firstF_lastF_eq_revF lenPF_revF -lenPF_firstF_out.
rewrite lenPF_castF lenPF_revF; easy.
intro; rewrite -revF_lastF revF_correct; easy.
Qed.

Lemma lenPF_extendPF :
   {n1 n2} {f : 'I_{n1,n2}} {P1 : 'I_n1 Prop} {P2 : 'I_n2 Prop},
    injective f extendPF f P1 P2 lenPF P1 = lenPF P2.
Proof.
intros n1 n2 f P1 P2 Hf HP.
pose (Hn := eq_sym (subnKC (injF_leq Hf))).
pose (g i1 := cast_ord Hn (f i1)).
assert (Hg1 : i1, f i1 = cast_ord (eq_sym Hn) (g i1))
    by now intros; rewrite cast_ord_comp cast_ord_id.
assert (Hg2 : injective g) by now unfold g; move=>> /cast_ord_inj /Hf.
destruct (first_f_extendF Hg2) as [p [Hp Hp1]]; move: Hp ⇒ /bij_inj Hp2.
rewrite -(lenPF_castF Hn) -(lenPF_permutF Hp2) lenPF_lastF_out.
apply lenPF_ext; intros i1; destruct (HP (f i1)) as [[j1 [Hj1 Hj2]] | [H _]];
    [| exfalso; rewrite Rg_compl in H; apply (H i1); easy].
apply Hf in Hj1; subst; rewrite Hj2 Hg1 Hp1 firstF_permutF; easy.
intros j; destruct (HP (cast_ord (eq_sym Hn) (p (last_ord n1 j))))
    as [[j1 [Hj _]] | [_ H]]; [exfalso | easy].
rewrite Hg1 Hp1 in Hj; apply cast_ord_inj, Hp2, ord_compat in Hj.
destruct j1 as [j1 Hj1]; simpl in Hj.
move: (leq_addr j n1); rewrite -Hj leqNgt; contradict Hj1; apply /negP; easy.
Qed.

Lemma filterP_ord_Rg_aux1 :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : incrF f)
      {P1 : 'Prop^n1} {P2 : 'Prop^n2} (HP : extendPF f P1 P2),
    let H := lenPF_extendPF (incrF_inj Hf) HP in
    Rg (fun j1 : 'I_(lenPF P1)f (filterP_ord j1)) = image f P1.
Proof.
intros; apply subset_ext_equiv; split; intros i2 Hi2.
destruct Hi2 as [j1 _]; apply Im, filterP_ord_correct.
destruct Hi2 as [i1 Hi1].
rewrite -(filterP_unfilterP_ord_in Hi1 i1 Hi1).
apply: (Im _ _ (unfilterP_ord Hi1 i1)); easy.
Qed.

Lemma filterP_ord_Rg_aux2 :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : incrF f)
      {P1 : 'Prop^n1} {P2 : 'Prop^n2} (HP : extendPF f P1 P2),
    image f P1 = P2.
Proof.
intros n1 n2 f Hf P1 P2 HP; apply subset_ext_equiv; split; intros i2.
intros [i1 Hi1]; destruct (HP (f i1)) as [[k1 [Hk1a Hk1b]] | [Hk1 _]].
rewrite -Hk1b (incrF_inj Hf _ _ Hk1a); easy.
exfalso; apply Hk1; easy.
destruct (extendPF_funF_rev (incrF_inj Hf) HP) as [-> HP2].
intros Hi2; destruct (HP2 i2 Hi2) as [i1 _]; apply Im; easy.
Qed.

Lemma filterP_ord_Rg_aux3 :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : incrF f)
      {P1 : 'Prop^n1} {P2 : 'Prop^n2} (HP : extendPF f P1 P2),
    let H := lenPF_extendPF (incrF_inj Hf) HP in
    P2 = Rg (fun j1filterP_ord (cast_ord H j1)).
Proof.
intros n1 n2 f Hf P1 P2 HP H.
apply subset_ext_equiv; split; intros i2 HP2;
    [| inversion HP2; apply filterP_ord_correct].
destruct (im_dec f i2) as [[i1 <-] | Hi2].
apply Rg_ex; (cast_ord (eq_sym H) (unfilterP_ord HP2 (f i1))).
rewrite cast_ord_comp cast_ord_id filterP_unfilterP_ord_in; easy.
contradict Hi2; rewrite not_all_not_ex_equiv.
destruct (HP i2) as [[i1 Hi1] | Hi2]; [ i1 |]; easy.
Qed.

Lemma filterP_ord_Rg :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : incrF f)
      {P1 : 'Prop^n1} {P2 : 'Prop^n2} (HP : extendPF f P1 P2),
    let H := lenPF_extendPF (incrF_inj Hf) HP in
    Rg (fun j1 : 'I_(lenPF P1)f (filterP_ord j1)) =
      Rg (fun j1filterP_ord (cast_ord H j1)).
Proof.
intros n1 n2 f Hf P1 P2 HP H.
rewrite (filterP_ord_Rg_aux1 Hf HP).
rewrite (filterP_ord_Rg_aux2 Hf HP).
apply filterP_ord_Rg_aux3.
Qed.

Lemma filterP_ord_w_incrF :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : incrF f) {P1 : 'Prop^n1}
      {P2 : 'Prop^n2} (HP : extendPF f P1 P2),
    let H := lenPF_extendPF (incrF_inj Hf) HP in
    f \o filterP_ord = filterP_ord \o (cast_ord H).
Proof.
intros; apply fun_ext_incrF_Rg.
apply incrF_comp; [apply filterP_ord_incrF | easy].
apply filterP_cast_ord_incrF.
apply filterP_ord_Rg.
Qed.

Lemma filterP_f_ord_w_incrF :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : incrF f)
      {P1 : 'Prop^n1} {P2 : 'Prop^n2} (HP : extendPF f P1 P2)
      {i1} (HP2 : P2 (f i1)),
    let H := lenPF_extendPF (incrF_inj Hf) HP in
    filterP_f_ord f HP2 = cast_ord H.
Proof.
intros n1 n2 f Hf P1 P2 HP i1 HP2 H; apply extF; intros j1.
move: (extendPF_unfunF_rev (incrF_inj Hf) HP) ⇒ HP2'; subst.
rewrite (filterP_f_ord_correct_alt _ (incrF_inj Hf) HP) -(comp_correct _ f).
rewrite (filterP_ord_w_incrF Hf HP); easy.
Qed.

Lemma filterPF_funF :
   {F : Type} {n1 n2} {f : 'I_{n1,n2}} {P1 : 'Prop^n1} {P2 : 'Prop^n2}
      {i0} (HP0 : P2 (f i0)) {A2 : 'F^n2},
    injective f extendPF f P1 P2
    filterPF P1 (funF f A2) = funF (filterP_f_ord f HP0) (filterPF P2 A2).
Proof.
move=>> Hf HP; apply extF; intro.
destruct (extendPF_funF_rev Hf HP) as [HP1 HP2]; subst.
unfold filterPF, funF; f_equal.
rewrite filterP_f_ord_correct; easy.
Qed.

Lemma len_neqF_funF :
   {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0},
    injective f incl (neqF A2 x0) (Rg f)
    lenPF (neqF (funF f A2) x0) = lenPF (neqF A2 x0).
Proof.
move=>> Hf HA2; apply (lenPF_extendPF Hf), (extendPF_funF_neqF_equiv Hf); easy.
Qed.

Lemma filter_neqF_gen_funF :
   {F : Type} {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0} {B2 : 'F^n2}
      {i0} (HP0 : neqF A2 x0 (f i0)),
    injective f incl (neqF A2 x0) (Rg f)
    filter_neqF_gen (funF f A2) x0 (funF f B2) =
      funF (filterP_f_ord f HP0) (filter_neqF_gen A2 x0 B2).
Proof.
intros F n1 n2 f A2 x0 B2 i0 HP0 Hf HA2; unfold filter_neqF_gen.
apply (filterPF_funF HP0 Hf), (extendPF_funF_neqF Hf HA2).
Qed.

Lemma filter_neqF_gen_funF_r :
   {F : Type} {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0} {B1 : 'F^n1} y0
      {i0} (HP0 : neqF A2 x0 (f i0)),
    injective f incl (neqF A2 x0) (Rg f)
    filter_neqF_gen (funF f A2) x0 B1 =
      funF (filterP_f_ord f HP0) (filter_neqF_gen A2 x0 (unfunF f B1 y0)).
Proof. intros; rewrite -filter_neqF_gen_funF// funF_unfunF//. Qed.

Lemma filter_neqF_funF :
   {n1 n2} {f : 'I_{n1,n2}} {A2 : 'E^n2} {x0}
      {i0} (HP0 : neqF A2 x0 (f i0)),
    injective f incl (neqF A2 x0) (Rg f)
    filter_neqF (funF f A2) x0 =
      funF (filterP_f_ord f HP0) (filter_neqF A2 x0).
Proof.
intros n1 n2 f A2 x0 i0 HP0 Hf HA2; unfold filter_neqF.
rewrite (filter_neqF_gen_funF_r x0 HP0)// unfunF_funF//; repeat f_equal.
apply extF; intros i2; destruct (im_dec f i2) as [[i1 <-] | Hi2].
apply maskPF_correct_l; easy.
rewrite -incl_compl_equiv in HA2; specialize (HA2 i2);
    unfold compl, neqF in HA2; rewrite NNPP_equiv in HA2.
rewrite HA2; [ apply maskPF_correct_r |]; rewrite Rg_compl; easy.
Qed.

Lemma filterPF_unfunF :
   {F : Type} {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f)
      {P1 : 'I_n1 Prop} {P2 : 'I_n2 Prop} (HP : extendPF f P1 P2)
      {A1 : 'F^n1} x0 i1,
    P1 i1
    let q1 := proj1_sig (injF_restr_bij_EX Hf) in
    let Hq1a := proj1 (proj2_sig (injF_restr_bij_EX Hf)) in
    let Hq1b := bij_inj Hq1a in
    filterPF P2 (unfunF f A1 x0) =
      castF (lenPF_extendPF Hf HP) (castF (lenPF_permutF Hq1b)
        (filterPF (permutF q1 P1) (permutF q1 A1))).
Proof.
intros F n1 n2 f Hf P1 P2 HP A1 x0 i1 HP1 q1 Hq1a Hq1b.
pose (Hq1c := proj2 (proj2_sig (injF_restr_bij_EX Hf)));
    pose (p1 := f_inv Hq1a); fold q1 in Hq1a, Hq1b, Hq1c.
assert (HP1' : P1 (q1 (p1 i1))) by now unfold p1; rewrite f_inv_can_r.
assert (HP2 : P2 (f i1))
    by now rewrite (extendPF_unfunF_rev Hf HP) (unfunF_correct_l _ i1).
assert (HP2' : P2 (f (q1 (p1 i1)))) by now rewrite f_inv_can_r.
rewrite (filterPF_permutF HP1' Hq1b) -{2}(funF_unfunF x0 Hf A1).
rewrite (filterPF_funF HP2' Hf HP).
apply extF; intros j2; unfold castF, funF; f_equal.
rewrite -(filterP_f_ord_comp_l HP1' Hq1b).
rewrite (filterP_f_ord_w_incrF Hq1c (extendPF_incrF Hf HP)).
rewrite 2!cast_ord_comp cast_ord_id; easy.
Qed.

Lemma len_neqF_unfunF :
   {n1 n2} {f : 'I_{n1,n2}} {A1 : 'E^n1} {x0},
    injective f lenPF (neqF A1 x0) = lenPF (neqF (unfunF f A1 x0) x0).
Proof.
move=>> Hf; apply (lenPF_extendPF Hf), (extendPF_unfunF_neqF _ _ Hf).
Qed.

Lemma filter_neqF_gen_unfunF :
   {F : Type} {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f)
      (A1 : 'E^n1) x0 (B1 : 'F^n1) y0,
    let q1 := proj1_sig (injF_restr_bij_EX Hf) in
    let Hq1a := proj1 (proj2_sig (injF_restr_bij_EX Hf)) in
    let Hq1b := bij_inj Hq1a in
    filter_neqF_gen (unfunF f A1 x0) x0 (unfunF f B1 y0) =
      castF (len_neqF_unfunF Hf) (castF (lenPF_permutF Hq1b)
        (filter_neqF_gen (permutF q1 A1) x0 (permutF q1 B1))).
Proof.
intros F n1 n2 f Hf A1 x0 B1 y0 q1 Hq1a Hq1b.
destruct (classic ( i1, A1 i1 = x0)) as [HA1 | HA1].
apply eqAF_nil; left; apply lenPF0_alt; intuition.
move: HA1 ⇒ /not_all_ex_not_equiv [i0 Hi0].
move: (extendPF_unfunF_neqF A1 x0 Hf) ⇒ HP.
unfold filter_neqF_gen; rewrite (filterPF_unfunF Hf HP _ i0);
    [rewrite !castF_comp; apply castF_eq_r |]; easy.
Qed.

Lemma filter_neqF_gen_unfunF_l :
   {F : Type} (HF : inhabited F) {n1 n2}
      {f : 'I_{n1,n2}} (Hf : injective f) (A1 : 'E^n1) x0 (B2 : 'F^n2),
    let q1 := proj1_sig (injF_restr_bij_EX Hf) in
    let Hq1a := proj1 (proj2_sig (injF_restr_bij_EX Hf)) in
    let Hq1b := bij_inj Hq1a in
    filter_neqF_gen (unfunF f A1 x0) x0 B2 =
      castF (len_neqF_unfunF Hf) (castF (lenPF_permutF Hq1b)
        (filter_neqF_gen (permutF q1 A1) x0 (permutF q1 (funF f B2)))).
Proof.
intros F [y0] n1 n2 f Hf A1 x0 B2 q1 Hq1a Hq1b.
rewrite -(filter_neqF_gen_unfunF _ _ _ _ y0); apply filterPF_ext_r; intro.
move⇒ /(proj1 contra_equiv (unfunF_correct_r _ _)) /not_all_not_ex [i1 <-].
rewrite unfunF_funF// maskPF_correct_l//.
Qed.

Lemma filter_neqF_unfunF :
   {n1 n2} {f : 'I_{n1,n2}} (Hf : injective f) (A1 : 'E^n1) x0,
    let q1 := proj1_sig (injF_restr_bij_EX Hf) in
    let Hq1a := proj1 (proj2_sig (injF_restr_bij_EX Hf)) in
    let Hq1b := bij_inj Hq1a in
    filter_neqF (unfunF f A1 x0) x0 =
      castF (len_neqF_unfunF Hf) (castF (lenPF_permutF Hq1b)
        (filter_neqF (permutF q1 A1) x0)).
Proof.
intros; unfold filter_neqF; rewrite filter_neqF_gen_unfunF_l;
  [rewrite funF_unfunF; easy | apply (inhabits x0)].
Qed.

End FilterPF_Facts2.

Section MapF_Facts.

Properties of operators mapiF/mapF/map2F.

Context {E F G : Type}.

Lemma mapF_comp :
   {n} (f : E F) (g : F G) (A : 'E^n),
    mapF (g \o f) A = mapF g (mapF f A).
Proof. easy. Qed.

Lemma mapF_eq :
   {n} (f : E F) (A B : 'E^n), A = B mapF f A = mapF f B.
Proof. intros; f_equal; easy. Qed.

Lemma mapF_inj :
   {n} (f : E F) (A B : 'E^n),
    injective f mapF f A = mapF f B A = B.
Proof. moven f A B Hf /extF_rev H; apply extF; intro; apply Hf, H. Qed.

Lemma mapF_eq_f :
   {n} (f g : E F) (A : 'E^n), f = g mapF f A = mapF g A.
Proof. intros; f_equal; easy. Qed.

Lemma mapF_inj_f :
   n (f g : E F),
    ( (A : 'E^n.+1), mapF f A = mapF g A) f = g.
Proof.
intros n f g H; apply fun_ext; intros x.
apply (extF_rev _ _ (H (constF n.+1 x)) ord0).
Qed.

Lemma mapF_constF :
   {n} (f : E F) x, mapF f (constF n x) = constF n (f x).
Proof. easy. Qed.

Lemma mapF_singleF :
   (f : E F) x0, mapF f (singleF x0) = singleF (f x0).
Proof. easy. Qed.

Lemma mapF_coupleF :
   (f : E F) x0 x1, mapF f (coupleF x0 x1) = coupleF (f x0) (f x1).
Proof.
intros; apply extF; intro.
rewrite mapF_correct; unfold coupleF; destruct (ord2_dec _); easy.
Qed.

Lemma mapF_tripleF :
   (f : E F) x0 x1 x2,
    mapF f (tripleF x0 x1 x2) = tripleF (f x0) (f x1) (f x2).
Proof.
intros; apply extF; intro; rewrite mapF_correct; unfold tripleF;
    destruct (ord3_dec _) as [[H | H] | H]; easy.
Qed.

Lemma mapF_inF :
   {n} (f : E F) x (A : 'E^n), inF x A inF (f x) (mapF f A).
Proof. intros n f x A [i Hi]; i; rewrite Hi; easy. Qed.

Lemma mapF_inclF :
   {n} (f : E F) (A : 'E^n) PE,
    inclF A PE inclF (mapF f A) (image f PE).
Proof. easy. Qed.

Lemma mapF_invalF :
   {n1 n2} (f : E F) (A1 : 'E^n1) (A2 : 'E^n2),
    invalF A1 A2 invalF (mapF f A1) (mapF f A2).
Proof. intros n1 n2 f A1 A2 HA i1; apply mapF_inF; easy. Qed.

Lemma mapF_castF :
   {n1 n2} (H : n1 = n2) (f : E F) (A1 : 'E^n1),
    mapF f (castF H A1) = castF H (mapF f A1).
Proof. easy. Qed.

Lemma mapF_firstF :
   {n1 n2} (f : E F) (A : 'E^(n1 + n2)),
    mapF f (firstF A) = firstF (mapF f A).
Proof. easy. Qed.

Lemma mapF_lastF :
   {n1 n2} (f : E F) (A : 'E^(n1 + n2)),
    mapF f (lastF A) = lastF (mapF f A).
Proof. easy. Qed.

Lemma mapF_concatF :
   {n1 n2} (f : E F) (A1 : 'E^n1) (A2 : 'E^n2),
    mapF f (concatF A1 A2) = concatF (mapF f A1) (mapF f A2).
Proof.
intros; apply extF; intro; rewrite mapF_correct.
unfold concatF; destruct (lt_dec _ _); easy.
Qed.

Lemma mapF_insertF :
   {n} (f : E F) (A : 'E^n) x0 i0,
    mapF f (insertF A x0 i0) = insertF (mapF f A) (f x0) i0.
Proof.
intros; apply extF; intro; rewrite mapF_correct.
unfold insertF; destruct (ord_eq_dec _ _); easy.
Qed.

Lemma mapF_insert2F :
   {n} (f : E F) (A : 'E^n) x0 x1 {i0 i1} (H : i1 i0),
    mapF f (insert2F A x0 x1 H) = insert2F (mapF f A) (f x0) (f x1) H.
Proof. intros; rewrite 2!insert2F_correct 2!mapF_insertF; easy. Qed.

Lemma mapF_skipF :
   {n} (f : E F) (A : 'E^n.+1) i0,
    mapF f (skipF A i0) = skipF (mapF f A) i0.
Proof. easy. Qed.

Lemma mapF_skip2F :
   {n} (f : E F) (A : 'E^n.+2) {i0 i1} (H : i1 i0),
    mapF f (skip2F A H) = skip2F (mapF f A) H.
Proof. easy. Qed.

Lemma mapF_replaceF :
   {n} (f : E F) (A : 'E^n) x0 i0,
    mapF f (replaceF A x0 i0) = replaceF (mapF f A) (f x0) i0.
Proof. intros; rewrite 2!replaceF_equiv_def_skipF mapF_skipF mapF_insertF; easy. Qed.

Lemma mapF_replace2F :
   {n} (f : E F) (A : 'E^n) x0 x1 i0 i1,
    mapF f (replace2F A x0 x1 i0 i1) =
      replace2F (mapF f A) (f x0) (f x1) i0 i1.
Proof. intros; rewrite 2!mapF_replaceF; easy. Qed.

Lemma map2F_concatF :
   {n1 n2} (f : E F G)
      (A1 : 'E^n1) (B1 : 'F^n1) (A2 : 'E^n2) (B2 : 'F^n2),
    map2F f (concatF A1 A2) (concatF B1 B2) =
      concatF (map2F f A1 B1) (map2F f A2 B2).
Proof.
intros; apply extF; intro; rewrite map2F_correct.
unfold concatF; destruct (lt_dec _ _); easy.
Qed.

Lemma map2F_skipF :
   {n} (f : E F G) (A : 'E^n.+1) (B : 'F^n.+1) i0,
    map2F f (skipF A i0) (skipF B i0) = skipF (map2F f A B) i0.
Proof. easy. Qed.

End MapF_Facts.

Section Fun_Facts.

Context {E F : Type}.
Context {n n1 n2 : nat}.
Hypothesis Heq : n1 = n2.
Hypothesis Hle : n1 n2.

Variable p : 'I_[n].

Variable f : '(E F)^n.
Variable fS : '(E F)^n.+1.
Variable f1 : '(E F)^n1.
Variable f2 : '(E F)^n2.
Variable f12 : '(E F)^(n1 + n2).

Lemma fct_castF_eq : x, castF Heq (f1^~ x) = (castF Heq f1)^~ x.
Proof. easy. Qed.

Lemma fct_widenF_S_eq : x, widenF_S (fS^~ x) = (widenF_S fS)^~ x.
Proof. easy. Qed.

Lemma fct_liftF_S_eq : x, liftF_S (fS^~ x) = (liftF_S fS)^~ x.
Proof. easy. Qed.

Lemma fct_widenF_eq : x, widenF Hle (f2^~ x) = (widenF Hle f2)^~ x.
Proof. easy. Qed.

Lemma fct_firstF_eq : x, firstF (f12^~ x) = (firstF f12)^~ x.
Proof. easy. Qed.

Lemma fct_lastF_eq : x, lastF (f12^~ x) = (lastF f12)^~ x.
Proof. easy. Qed.

Lemma fct_concatF_eq : x, concatF (f1^~ x) (f2^~ x) = (concatF f1 f2)^~ x.
Proof.
intros x; apply extF; intros i;
    destruct (lt_dec i n1) as [Hi | Hi];
    [rewrite !concatF_correct_l | rewrite !concatF_correct_r]; easy.
Qed.

Lemma fct_insertF_eq :
   f0 i0 x, insertF (f^~ x) (f0 x) i0 = (insertF f f0 i0)^~ x.
Proof.
intros f0 i0 x; apply extF; intros i;
    destruct (ord_eq_dec i i0) as [Hi | Hi];
    [rewrite !insertF_correct_l | rewrite !insertF_correct_r]; easy.
Qed.

Lemma fct_skipF_eq : i0 x, skipF (fS^~ x) i0 = (skipF fS i0)^~ x.
Proof. easy. Qed.

Lemma fct_replaceF_eq :
   f0 i0 x, replaceF (fS^~ x) (f0 x) i0 = (replaceF fS f0 i0)^~ x.
Proof.
intros f0 i0 x; apply extF; intros i;
    destruct (ord_eq_dec i i0) as [Hi | Hi];
    [rewrite !replaceF_correct_l | rewrite !replaceF_correct_r]; easy.
Qed.

Lemma fct_permutF_eq : x, permutF p (f^~ x) = (permutF p f)^~ x.
Proof. easy. Qed.

End Fun_Facts.

Section Swap_fun.

Context {E F : Type}.

Definition gather {n} (f : '(E F)^n) : E 'F^n := swap f.
Definition scatter {n} (f : E 'F^n) : '(E F)^n := swap f.

Lemma gather_scatter : {n} (f : E 'F^n), gather (scatter f) = f.
Proof. easy. Qed.

Lemma scatter_gather : {n} (f : '(E F)^n), scatter (gather f) = f.
Proof. easy. Qed.

End Swap_fun.

From Coq Require Import List.

Section FF_list.

Context {E : Type}.

Fixpoint to_listF {n:nat} (A:'E^n) : list E :=
   match n as p return (n=p _) with
   | 0 ⇒ fun _nil
   | S mfun Hcons ((castF H A) ord0)
                 (to_listF (liftF_S (castF H A)))
end erefl.

Lemma to_listF_correct : {n} (elt: E) (A:'E^n) (i:'I_n),
    A i = nth i (to_listF A) elt.
Proof.
intros n; induction n; intros elt A i; simpl; [destruct i; easy |].
case (ord_eq_dec i ord0); intros Hi.
rewrite Hi; simpl.
rewrite castF_id; easy.
case_eq (nat_of_ord i).
intros Hi2; exfalso; apply Hi.
apply ord_inj; rewrite Hi2; easy.
intros m Hm; rewrite castF_id.
rewrite <- (liftF_lower_S A Hi).
rewrite (IHn elt).
f_equal.
simpl; rewrite Hm -minusE; now auto with zarith.
Qed.

Lemma to_listF_length : {n} (A:'E^n),
    length (to_listF A) = n.
Proof.
induction n.
intros A; simpl; easy.
intros A; simpl.
rewrite IHn; easy.
Qed.

Lemma to_listF_castF : {n m} (H:n=m) A,
   to_listF A = to_listF (castF H A).
Proof.
intros n m H A; subst.
rewrite castF_id; easy.
Qed.

Lemma to_listF_concatF: {n m} (A:'E^n) (B:'E^m),
  to_listF (concatF A B) = to_listF A ++ to_listF B.
Proof.
intros n m A B; induction n.
simpl; rewrite concatF_nil_l; easy.
simpl; rewrite 2!castF_id.
f_equal.
rewrite concatF_correct_l.
f_equal; apply ord_inj; now simpl.
apply trans_eq with (to_listF (liftF_S (castF (addSn n m) (concatF A B)))).
f_equal.
apply extF; intros i.
unfold liftF_S, castF; f_equal.
apply ord_inj; easy.
rewrite liftF_S_concatF.
apply IHn.
Qed.

Definition of_listF (l : list E) : 'E^(length l)
  := match l with
     | nilfun_from_I_0 E
     | elt :: llfun inth i l elt
 end.
Arguments of_listF l : simpl never.
Arguments of_listF l i : simpl never.

Lemma of_listF_correct : (elt: E) (l:list E)
     (i:'I_(length l)),
       nth i l elt = of_listF l i.
Proof.
intros elt l i; destruct l; simpl in i; [destruct i; easy |].
unfold of_listF; apply nth_indep; now apply /ltP.
Qed.

Lemma of_listF_correct' : (elt: E) (l:list E) (i:nat)
     (H: i < length l),
    nth i l elt = (of_listF l) (Ordinal H).
Proof.
intros elt l i H.
rewrite -(of_listF_correct elt); easy.
Qed.

Lemma of_to_listF : {n} (A:'E^n),
   A = castF (to_listF_length A) (of_listF (to_listF A)).
Proof.
intros [| n] A; apply extF; intros i.
destruct i; easy.
rewrite (to_listF_correct (A ord0)) of_listF_correct'; try easy.
rewrite to_listF_length; easy.
Qed.

Lemma of_to_listF' : {n} (A:'E^n),
   (of_listF (to_listF A))
      = castF (eq_sym (to_listF_length A)) A.
Proof.
intros n A.
apply trans_eq with
 (castF (eq_sym (to_listF_length A)) (castF (to_listF_length A) (of_listF (to_listF A)))).
2: f_equal.
2: rewrite <- of_to_listF; easy.
now rewrite castF_can.
Qed.

Lemma to_of_listF : (l:list E),
     to_listF (of_listF l) = l.
Proof.
intros l.
case l; try easy.
clear l; intros a l.
apply nth_ext with a a.
rewrite to_listF_length; easy.
rewrite to_listF_length; intros n Hn.
rewrite of_listF_correct'.
rewrite to_listF_length.
now apply /ltP.
intros Hm.
rewrite of_to_listF'.
unfold castF; easy.
Qed.

Lemma to_listF_inj : {n:nat} (A B:'E^n),
   to_listF A = to_listF B A = B.
Proof.
intros [| n] A B H; apply extF; intros i.
destruct i; easy.
rewrite (of_to_listF A) (of_to_listF B); unfold castF.
rewrite -(of_listF_correct (A ord0)) -(of_listF_correct (A ord0)).
f_equal; easy.
Qed.

Lemma to_listF_firstn : {n:nat} (A:'E^n) (i:'I_n),
  firstn i (to_listF A)
     = to_listF (firstF (castF_nip A (widen_S i))).
Proof.
intros n; induction n; intros A i.
destruct i; easy.
assert (Y : (i length (to_listF A))%coq_nat).
rewrite to_listF_length.
assert (i < n.+1)%coq_nat; try auto with zarith.
apply /ltP; easy.
simpl; rewrite castF_id.
case (classic (i=ord0)); intros Hi.
rewrite Hi; now simpl.
pose (j:= lower_S Hi).
assert (Hj: nat_of_ord i = (nat_of_ord j).+1).
assert (nat_of_ord i 0).
intros T; apply Hi.
apply ord_inj; easy.
simpl; rewrite -minusE; auto with zarith.
rewriteHj at 1.
apply trans_eq with (A ord0 :: firstn j (to_listF (liftF_S A))).
easy.
rewrite IHn.
replace i with (lift_S j).
simpl.
rewrite castF_id.
f_equal; try easy.
unfold firstF, castF_nip, castF; simpl.
f_equal; apply ord_inj; now simpl.
f_equal; simpl.
unfold firstF, castF_nip, liftF_S, castF; simpl.
apply extF; intros m; f_equal.
apply ord_inj; simpl; easy.
apply ord_inj; simpl; easy.
Qed.

End FF_list.

Section Lex_orders_Def.

Context {T : Type}.
Variable R : T T Prop.

Lexicographic order on 'T^n.

Fixpoint lex {n} (x y : 'T^n) : Prop :=
  match n as p return (n = p _) with
  | 0 ⇒ fun _reflexive R
  | S mfun H
      castF H x ord0 castF H y ord0
        R (castF H x ord0) (castF H y ord0)
      castF H x ord0 = castF H y ord0
        lex (skipF (castF H x) ord0) (skipF (castF H y) ord0)
  end erefl.

Co-lexicographic order on 'T^n.
Fixpoint colex {n} (x y : 'T^n) : Prop :=
  match n as p return (n = p _) with
  | 0 ⇒ fun Hreflexive R
  | S mfun H
      castF H x ord_max castF H y ord_max
        R (castF H x ord_max) (castF H y ord_max)
      castF H x ord_max = castF H y ord_max
        colex (skipF (castF H x) ord_max) (skipF (castF H y) ord_max)
  end erefl.

Symmetric, or converse, lexicographic order on 'T^n.
Definition symlex {n} : 'T^n 'T^n Prop := converse (@lex n).

Reverse lexicographic order on 'T^n.
Definition revlex {n} : 'T^n 'T^n Prop := converse (@colex n).

Correctness lemmas.

Lemma lex_nil : (x y : 'T^0), lex x y reflexive R.
Proof. easy. Qed.

Lemma colex_nil : (x y : 'T^0), colex x y reflexive R.
Proof. easy. Qed.

Lemma symlex_nil : (x y : 'T^0), symlex x y reflexive R.
Proof. easy. Qed.

Lemma revlex_nil : (x y : 'T^0), revlex x y reflexive R.
Proof. easy. Qed.

Lemma lex_S :
   {n} {x y : 'T^n.+1},
    lex x y
    x ord0 y ord0 R (x ord0) (y ord0)
    x ord0 = y ord0 lex (skipF x ord0) (skipF y ord0).
Proof. intros n x y; simpl; repeat rewrite castF_refl; easy. Qed.

Lemma colex_S :
   {n} {x y : 'T^n.+1},
    colex x y
    x ord_max y ord_max R (x ord_max) (y ord_max)
    x ord_max = y ord_max colex (skipF x ord_max) (skipF y ord_max).
Proof. intros n x y; simpl; repeat rewrite castF_refl; easy. Qed.

Lemma symlex_S :
   {n} {x y : 'T^n.+1},
    symlex x y
    x ord0 y ord0 R (y ord0) (x ord0)
    x ord0 = y ord0 symlex (skipF x ord0) (skipF y ord0).
Proof.
intros n x y; simpl; repeat rewrite castF_refl; rewrite eq_sym_equiv; easy.
Qed.

Lemma revlex_S :
   {n} {x y : 'T^n.+1},
    revlex x y
    x ord_max y ord_max R (y ord_max) (x ord_max)
    x ord_max = y ord_max revlex (skipF x ord_max) (skipF y ord_max).
Proof.
intros n x y; simpl; repeat rewrite castF_refl; rewrite eq_sym_equiv; easy.
Qed.

Lemma lex_1 :
   {x y : 'T^1},
    lex x y
    x ord0 y ord0 R (x ord0) (y ord0) x ord0 = y ord0 reflexive R.
Proof. intros; rewrite lex_S lex_nil; easy. Qed.

Lemma colex_1 :
   {x y : 'T^1},
    colex x y
    x ord_max y ord_max R (x ord_max) (y ord_max)
    x ord_max = y ord_max reflexive R.
Proof. intros; rewrite colex_S colex_nil; easy. Qed.

Lemma symlex_1 :
   {x y : 'T^1},
    symlex x y
    x ord0 y ord0 R (y ord0) (x ord0) x ord0 = y ord0 reflexive R.
Proof. intros; rewrite symlex_S symlex_nil; easy. Qed.

Lemma revlex_1 :
   {x y : 'T^1},
    revlex x y
    x ord_max y ord_max R (y ord_max) (x ord_max)
    x ord_max = y ord_max reflexive R.
Proof. intros; rewrite revlex_S revlex_nil; easy. Qed.

"w_eq" stands for "when equal".
Lemma lex_equiv_w_eq :
   {n} {x y : 'T^n}, x = y lex x y reflexive R.
Proof.
intros n; induction n; [easy | intros; subst; rewrite lex_S IHn; tauto].
Qed.

"w_neq" stands for "when not equal".
Lemma lex_equiv_w_neq :
   {n} {x y : 'T^n}, x y lex x y
     (i : 'I_n),
      ( (j : 'I_n), (j < i)%coq_nat x j = y j)
      x i y i R (x i) (y i).
Proof.
intros n; induction n; intros x y H; [contradict H; apply hat0F_unit |];
    split; rewrite lex_S.
intros [[H0 H1] | [H0 H1]]; [ ord0; easy |].
destruct (neqxF_compat ord0 H) as [| H2]; [easy |].
destruct (IHn _ _ (skipF_neqxF_compat H2)) as [H3 _].
destruct (H3 H1) as [i [Hi1 Hi2]]; (lift_S i); split;
    [| rewrite !skipF_first in Hi2; easy].
intros j; destruct (ord_eq_dec j ord0) as [-> | Hj1]; [easy | intros Hj2].
specialize (Hi1 (lower_S Hj1)); rewrite !skipF_first !liftF_lower_S in Hi1.
apply Hi1; rewrite -(lower_lift_S (lift_S_not_first i));
    apply lower_S_incrS; easy.
intros [i [Hi1 Hi2]].
destruct (ord_eq_dec i ord0) as [-> | Hi0]; [left; easy | right].
assert (H0 : x ord0 = y ord0) by now apply Hi1, ord_n0_gt_equiv.
split; [easy | apply IHn]; [contradict H; apply (extF_skipF ord0); easy |].
(lower_S Hi0); split; [| rewrite !skipF_first !liftF_lower_S; easy].
intros j Hj; apply Hi1; rewrite skip_ord_first -(lift_lower_S Hi0).
apply lift_S_incrF; easy.
Qed.

"w_eq" stands for "when equal".
Lemma colex_equiv_w_eq :
   {n} {x y : 'T^n}, x = y colex x y reflexive R.
Proof.
intros n; induction n; [easy | intros; subst; rewrite colex_S IHn; tauto].
Qed.

"w_neq" stands for "when not equal".
Lemma colex_equiv_w_neq :
   {n} {x y : 'T^n}, x y colex x y
     (i : 'I_n),
      ( (j : 'I_n), (i < j)%coq_nat x j = y j)
      x i y i R (x i) (y i).
Proof.
intros n; induction n; intros x y H; [contradict H; apply hat0F_unit |];
    split; rewrite colex_S.
intros [[H0 H1] | [H0 H1]].
ord_max; split; [| easy].
intros j Hj; contradict Hj; apply Nat.nlt_ge; apply /leP; apply leqS_rev; easy.
destruct (neqxF_compat ord_max H) as [| H2]; [easy |].
destruct (IHn _ _ (skipF_neqxF_compat H2)) as [H3 _].
destruct (H3 H1) as [i [Hi1 Hi2]]; (widen_S i); split;
    [| rewrite !skipF_last in Hi2; easy].
intros j; destruct (ord_eq_dec j ord_max) as [-> | Hj1]; [easy | intros Hj2].
specialize (Hi1 (narrow_S Hj1)); rewrite !skipF_last !widenF_narrow_S in Hi1.
apply Hi1; rewrite -(narrow_widen_S (widen_S_not_last i));
    apply narrow_S_incrS; easy.
intros [i [Hi1 Hi2]].
destruct (ord_eq_dec i ord_max) as [-> | Hin]; [left; easy | right].
assert (H0 : x ord_max = y ord_max) by now apply Hi1, ord_nmax_lt_equiv.
split; [easy | apply IHn]; [contradict H; apply (extF_skipF ord_max); easy |].
(narrow_S Hin); split; [| rewrite !skipF_last !widenF_narrow_S; easy].
intros j Hj; apply Hi1; rewrite skip_ord_last -(widen_narrow_S Hin).
apply widen_S_incrF; easy.
Qed.

"w_eq" stands for "when equal".
Lemma symlex_equiv_w_eq :
   {n} {x y : 'T^n}, x = y symlex x y reflexive R.
Proof. intros; apply lex_equiv_w_eq; easy. Qed.

"w_neq" stands for "when not equal".
Lemma symlex_equiv_w_neq :
   {n} {x y : 'T^n},
    x y symlex x y
     (i : 'I_n),
      ( (j : 'I_n), (j < i)%coq_nat x j = y j)
      x i y i R (y i) (x i).
Proof.
move=>> H; unfold symlex, converse; rewrite (lex_equiv_w_neq (not_eq_sym H)).
split; intros [i [Hi1 [Hi2 Hi3]]]; i;
    (split; [intros; apply eq_sym, Hi1; easy |]);
    (split; [apply not_eq_sym |]); easy.
Qed.

"w_eq" stands for "when equal".
Lemma revlex_equiv_w_eq :
   {n} {x y : 'T^n}, x = y revlex x y reflexive R.
Proof. intros; apply colex_equiv_w_eq; easy. Qed.

"w_neq" stands for "when not equal".
Lemma revlex_equiv_w_neq :
   {n} {x y : 'T^n},
    x y revlex x y
     (i : 'I_n),
      ( (j : 'I_n), (i < j)%coq_nat x j = y j)
      x i y i R (y i) (x i).
Proof.
move=>> H; unfold revlex, converse; rewrite (colex_equiv_w_neq (not_eq_sym H)).
split; intros [i [Hi1 [Hi2 Hi3]]]; i;
    (split; [intros; apply eq_sym, Hi1; easy |]);
    (split; [apply not_eq_sym |]); easy.
Qed.

End Lex_orders_Def.

Section Lex_orders_Facts1.

Context {T : Type}.

Compatibility results with operators.
With the converse / complementary / conv_compl operators.

Lemma lex_conv :
   {R : T T Prop} {n}, @lex _ (converse R) n = converse (lex R).
Proof.
unfold converse; intros R n;
    apply fun_ext2; intros x y; apply prop_ext; induction n; [easy |].
rewrite !lex_S IHn neq_sym_equiv eq_sym_equiv; easy.
Qed.

Lemma colex_conv :
   {R : T T Prop} {n},
    @colex _ (converse R) n = converse (colex R).
Proof.
unfold converse; intros R n;
    apply fun_ext2; intros x y; apply prop_ext; induction n; [easy |].
rewrite !colex_S IHn neq_sym_equiv eq_sym_equiv; easy.
Qed.

Lemma symlex_conv :
   {R : T T Prop} {n},
    @symlex _ (converse R) n = converse (symlex R).
Proof. intros; unfold symlex; rewrite lex_conv; easy. Qed.

Lemma revlex_conv :
   {R : T T Prop} {n},
    @revlex _ (converse R) n = converse (revlex R).
Proof. intros; unfold revlex; rewrite colex_conv; easy. Qed.

Lemma lex_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @lex _ (complementary R) n = complementary (lex R).
Proof.
intros R n HT1 HT2 H; apply fun_ext2; intros x y; apply prop_ext;
    induction n; rewrite compl_alt.
+ rewrite !lex_nil compl_refl_equiv; split;
      [apply irrefl_not_refl | destruct H]; easy.
+ rewrite !lex_S IHn not_or_equiv !not_and_equiv !NNPP_equiv; split.
  - intros [H1 | H1]; split; [right | left | left | right]; easy.
  - intros [[H1 | H1] [H2 | H2]]; [| right | left |]; try easy.
    destruct (HT2 (x ord0) (y ord0)); [right | left]; easy.
Qed.

Lemma colex_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @colex _ (complementary R) n = complementary (colex R).
Proof.
intros R n HT1 HT2 H; apply fun_ext2; intros x y; apply prop_ext;
    induction n; rewrite compl_alt.
+ rewrite !colex_nil compl_refl_equiv; split;
      [apply irrefl_not_refl | destruct H]; easy.
+ rewrite !colex_S IHn not_or_equiv !not_and_equiv !NNPP_equiv; split.
  - intros [H1 | H1]; split; [right | left | left | right]; easy.
  - intros [[H1 | H1] [H2 | H2]]; [| right | left |]; try easy.
    destruct (HT2 (x ord_max) (y ord_max)); [right | left]; easy.
Qed.

Lemma symlex_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @symlex _ (complementary R) n = complementary (symlex R).
Proof. intros; unfold symlex; rewrite lex_compl; easy. Qed.

Lemma revlex_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @revlex _ (complementary R) n = complementary (revlex R).
Proof. intros; unfold revlex; rewrite colex_compl; easy. Qed.

Lemma lex_conv_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @lex _ (conv_compl R) n = conv_compl (lex R).
Proof. intros; rewrite lex_conv lex_compl; easy. Qed.

Lemma colex_conv_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @colex _ (conv_compl R) n = conv_compl (colex R).
Proof. intros; rewrite colex_conv colex_compl; easy. Qed.

Lemma symlex_conv_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @symlex _ (conv_compl R) n = conv_compl (symlex R).
Proof. intros; rewrite symlex_conv symlex_compl; easy. Qed.

Lemma revlex_conv_compl :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @revlex _ (conv_compl R) n = conv_compl (revlex R).
Proof. intros; rewrite revlex_conv revlex_compl; easy. Qed.

With the br_and / br_or operators.

Lemma lex_br_and :
   {R1 R2 : T T Prop} {n},
    @lex _ (br_and R1 R2) n = br_and (lex R1) (lex R2).
Proof.
unfold br_and;
    intros R1 R2 n; apply fun_ext2; intros x y; apply prop_ext; induction n.
rewrite !lex_nil; apply br_and_refl_equiv.
rewrite !lex_S IHn; split.
intros [H | H]; split; [left | left | right | right]; easy.
intros [[H1 | H1] [H2 | H2]]; [left |..| right]; easy.
Qed.

Lemma colex_br_and :
   {R1 R2 : T T Prop} {n},
    @colex _ (br_and R1 R2) n = br_and (colex R1) (colex R2).
Proof.
unfold br_and;
    intros R1 R2 n; apply fun_ext2; intros x y; apply prop_ext; induction n.
rewrite !colex_nil; apply br_and_refl_equiv.
rewrite !colex_S IHn; split.
intros [H | H]; split; [left | left | right | right]; easy.
intros [[H1 | H1] [H2 | H2]]; [left |..| right]; easy.
Qed.

Lemma symlex_br_and :
   {R1 R2 : T T Prop} {n},
    @symlex _ (br_and R1 R2) n = br_and (symlex R1) (symlex R2).
Proof. intros; unfold symlex; rewrite br_and_conv lex_br_and; easy. Qed.

Lemma revlex_br_and :
   {R1 R2 : T T Prop} {n},
    @revlex _ (br_and R1 R2) n = br_and (revlex R1) (revlex R2).
Proof. intros; unfold revlex; rewrite br_and_conv colex_br_and; easy. Qed.

Since reflexivity of a disjunction is not equivalent to the disjunction of reflexivities, the base case cannot be fullfilled in inductions, and *lex orders do not commute with operator br_or.
"w_neq" stands for "when not equal".
Lemma lex_br_or_w_neq :
   {R1 R2 : T T Prop} {n} {x y : 'T^n},
    x y lex (br_or R1 R2) x y br_or (lex R1) (lex R2) x y.
Proof.
unfold br_or at 2; intros R1 R2 n x y H1; induction n;
    [contradict H1; apply hat0F_unit |].
destruct (nextF_skipF ord0 H1) as [H2 | H2];
    rewrite !lex_S; [| rewrite (IHn _ _ H2)]; split.
intros [[H3 [H4 | H4]] | H3]; [left; left | right; left |]; easy.
intros [[H3 | H3] | [H3 | H3]];
    [left; split; [| left] | | left; split; [| right] |]; easy.
intros [[H3 [H4 | H4]] | [H3 [H4 | H4]]];
    [left; left | right; left | left; right | right; right]; easy.
intros [[H3 | H3] | [H3 | H3]];
    [left; split; [| left] | right; split; [| left] |
     left; split; [| right] | right; split; [| right]]; easy.
Qed.

"w_neq" stands for "when not equal".
Lemma colex_br_or_w_neq :
   {R1 R2 : T T Prop} {n} {x y : 'T^n},
    x y colex (br_or R1 R2) x y br_or (colex R1) (colex R2) x y.
Proof.
unfold br_or at 2; intros R1 R2 n x y H1; induction n;
    [contradict H1; apply hat0F_unit |].
destruct (nextF_skipF ord_max H1) as [H2 | H2];
    rewrite !colex_S; [| rewrite (IHn _ _ H2)]; split.
intros [[H3 [H4 | H4]] | H3]; [left; left | right; left |]; easy.
intros [[H3 | H3] | [H3 | H3]];
    [left; split; [| left] | | left; split; [| right] |]; easy.
intros [[H3 [H4 | H4]] | [H3 [H4 | H4]]];
    [left; left | right; left | left; right | right; right]; easy.
intros [[H3 | H3] | [H3 | H3]];
    [left; split; [| left] | right; split; [| left] |
     left; split; [| right] | right; split; [| right]]; easy.
Qed.

"w_neq" stands for "when not equal".
Lemma symlex_br_or_w_neq :
   {R1 R2 : T T Prop} {n} {x y : 'T^n},
    x y symlex (br_or R1 R2) x y br_or (symlex R1) (symlex R2) x y.
Proof.
unfold symlex; intros; rewrite -!lex_conv -br_or_conv lex_br_or_w_neq; easy.
Qed.

"w_neq" stands for "when not equal".
Lemma revlex_br_or_w_neq :
   {R1 R2 : T T Prop} {n} {x y : 'T^n},
    x y revlex (br_or R1 R2) x y br_or (revlex R1) (revlex R2) x y.
Proof.
unfold revlex;
    intros; rewrite -!colex_conv -br_or_conv colex_br_or_w_neq; easy.
Qed.

With the br_and_neq / br_or_eq operators.

Lemma lex_eq : {n}, lex eq = @eq 'T^n.
Proof.
intros n; induction n; apply fun_ext2; intros x y; apply prop_ext.
rewrite lex_nil (hat0F_unit x y); easy.
rewrite lex_S IHn (extF_skipF_equiv ord0); tauto.
Qed.

Lemma lex_neq : inhabited T {n}, lex neq = @neq 'T^n.
Proof.
intros HT n; induction n; apply fun_ext2; intros x y; apply prop_ext.
rewrite lex_nil (hat0F_unit x y); split; intros H; contradict H; [| easy].
apply (irrefl_not_refl HT); easy.
unfold neq; rewrite lex_S IHn; rewrite (nextF_skipF_equiv ord0); tauto.
Qed.

Lemma colex_eq : {n}, colex eq = @eq 'T^n.
Proof.
intros n; induction n; apply fun_ext2; intros x y; apply prop_ext.
rewrite colex_nil (hat0F_unit x y); easy.
rewrite colex_S IHn (extF_skipF_equiv ord_max); tauto.
Qed.

Lemma colex_neq : inhabited T {n}, colex neq = @neq 'T^n.
Proof.
intros HT n; induction n; apply fun_ext2; intros x y; apply prop_ext.
rewrite colex_nil (hat0F_unit x y); split; intros H; contradict H; [| easy].
apply (irrefl_not_refl HT); easy.
unfold neq; rewrite colex_S IHn; rewrite (nextF_skipF_equiv ord_max); tauto.
Qed.

Lemma symlex_eq : {n}, symlex eq = @eq 'T^n.
Proof. intros; unfold symlex; rewrite lex_eq; apply conv_eq. Qed.

Lemma symlex_neq : inhabited T {n}, symlex neq = @neq 'T^n.
Proof. intros HT n; unfold symlex; rewrite (lex_neq HT); apply conv_neq. Qed.

Lemma revlex_eq : {n}, revlex eq = @eq 'T^n.
Proof. intros; unfold revlex; rewrite colex_eq; apply conv_eq. Qed.

Lemma revlex_neq : inhabited T {n}, revlex neq = @neq 'T^n.
Proof. intros HT n; unfold revlex; rewrite (colex_neq HT); apply conv_neq. Qed.

Lemma lex_br_and_neq :
   {R : T T Prop} {n},
    inhabited T @lex _ (br_and_neq R) n = br_and_neq (lex R).
Proof. intros; rewrite !br_and_neq_eq lex_br_and lex_neq; easy. Qed.

Lemma colex_br_and_neq :
   {R : T T Prop} {n},
    inhabited T @colex _ (br_and_neq R) n = br_and_neq (colex R).
Proof. intros; rewrite !br_and_neq_eq colex_br_and colex_neq; easy. Qed.

Lemma symlex_br_and_neq :
   {R : T T Prop} {n},
    inhabited T @symlex _ (br_and_neq R) n = br_and_neq (symlex R).
Proof.
intros; unfold symlex; rewrite br_and_neq_conv lex_br_and_neq; easy.
Qed.

Lemma revlex_br_and_neq :
   {R : T T Prop} {n},
    inhabited T @revlex _ (br_and_neq R) n = br_and_neq (revlex R).
Proof.
intros; unfold revlex; rewrite br_and_neq_conv colex_br_and_neq; easy.
Qed.

"w_neq" stands for "when not equal".
Lemma lex_br_or_eq_w_neq :
   {R : T T Prop} {n} {x y : 'T^n},
    x y lex (br_or_eq R) x y br_or_eq (lex R) x y.
Proof. move=>> H; rewrite !br_or_eq_eq (lex_br_or_w_neq H) lex_eq; easy. Qed.

"w_neq" stands for "when not equal".
Lemma colex_br_or_eq_w_neq :
   {R : T T Prop} {n} {x y : 'T^n},
    x y colex (br_or_eq R) x y br_or_eq (colex R) x y.
Proof.
move=>> H; rewrite !br_or_eq_eq (colex_br_or_w_neq H) colex_eq; easy.
Qed.

"w_neq" stands for "when not equal".
Lemma symlex_br_or_eq_w_neq :
   {R : T T Prop} {n} {x y : 'T^n},
    x y symlex (br_or_eq R) x y br_or_eq (symlex R) x y.
Proof.
unfold symlex;
    intros; rewrite -!lex_conv -br_or_eq_conv lex_br_or_eq_w_neq; easy.
Qed.

"w_neq" stands for "when not equal".
Lemma revlex_br_or_eq_w_neq :
   {R : T T Prop} {n} {x y : 'T^n},
    x y revlex (br_or_eq R) x y br_or_eq (revlex R) x y.
Proof.
unfold revlex;
    intros; rewrite -!colex_conv -br_or_eq_conv colex_br_or_eq_w_neq; easy.
Qed.

With the strict / equivalent operators.

Lemma lex_strict :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @lex _ (strict R) n = strict (lex R).
Proof. intros; rewrite !strict_eq lex_br_and lex_conv_compl; easy. Qed.

Lemma colex_strict :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @colex _ (strict R) n = strict (colex R).
Proof. intros; rewrite !strict_eq colex_br_and colex_conv_compl; easy. Qed.

Lemma symlex_strict :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @symlex _ (strict R) n = strict (symlex R).
Proof. intros; unfold symlex; rewrite lex_strict; easy. Qed.

Lemma revlex_strict :
   {R : T T Prop} {n},
    inhabited T eq_dec T reflexive R irreflexive R
    @revlex _ (strict R) n = strict (revlex R).
Proof. intros; unfold revlex; rewrite colex_strict; easy. Qed.

Lemma lex_equivalent :
   {R : T T Prop} {n},
    @lex _ (equivalent R) n = equivalent (lex R).
Proof. intros; rewrite !equivalent_eq lex_br_and lex_conv; easy. Qed.

Lemma colex_equivalent :
   {R : T T Prop} {n},
    @colex _ (equivalent R) n = equivalent (colex R).
Proof. intros; rewrite !equivalent_eq colex_br_and colex_conv; easy. Qed.

Lemma symlex_equivalent :
   {R : T T Prop} {n},
    @symlex _ (equivalent R) n = equivalent (symlex R).
Proof. intros; unfold symlex; rewrite lex_equivalent; easy. Qed.

Lemma revlex_equivalent :
   {R : T T Prop} {n},
    @revlex _ (equivalent R) n = equivalent (revlex R).
Proof. intros; unfold revlex; rewrite colex_equivalent; easy. Qed.

End Lex_orders_Facts1.

Section Lex_orders_Facts2.

Context {T : Type}.

Compatibility results with elementary properties.
With the reflexive / irreflexive elementary properties.

Lemma lex_refl :
   {R : T T Prop},
    reflexive R {n}, reflexive (@lex _ R n).
Proof.
intros R H n; induction n; intros x; [easy |].
rewrite lex_S; right; split; [easy | apply IHn].
Qed.

Lemma colex_refl :
   {R : T T Prop},
    reflexive R {n}, reflexive (@colex _ R n).
Proof.
intros R H n; induction n; intros x; [easy |].
rewrite colex_S; right; split; [easy | apply IHn].
Qed.

Lemma symlex_refl :
   {R : T T Prop},
    reflexive R {n}, reflexive (@symlex _ R n).
Proof. intros; apply conv_refl, lex_refl; easy. Qed.

Lemma revlex_refl :
   {R : T T Prop},
    reflexive R {n}, reflexive (@revlex _ R n).
Proof. intros; apply conv_refl, colex_refl; easy. Qed.

Lemma lex_irrefl :
   {R : T T Prop},
    inhabited T irreflexive R {n}, irreflexive (@lex _ R n).
Proof.
intros R HT H n; induction n; intros y.
rewrite lex_nil; apply irrefl_not_refl; easy.
rewrite lex_S not_or_equiv !not_and_equiv NNPP_equiv; split;
    [left; easy | right; apply IHn].
Qed.

Lemma colex_irrefl :
   {R : T T Prop},
    inhabited T irreflexive R {n}, irreflexive (@colex _ R n).
Proof.
intros R HT H n; induction n; intros y.
rewrite colex_nil; apply irrefl_not_refl; easy.
rewrite colex_S not_or_equiv !not_and_equiv NNPP_equiv; split;
    [left; easy | right; apply IHn].
Qed.

Lemma symlex_irrefl :
   {R : T T Prop},
    inhabited T irreflexive R {n}, irreflexive (@symlex _ R n).
Proof. intros; apply conv_irrefl, lex_irrefl; easy. Qed.

Lemma revlex_irrefl :
   {R : T T Prop},
    inhabited T irreflexive R {n}, irreflexive (@revlex _ R n).
Proof. intros; apply conv_irrefl, colex_irrefl; easy. Qed.

With the symmetric / antisymmetric / asymmetric elementary properties.

Lemma lex_sym :
   {R : T T Prop},
    symmetric R {n}, symmetric (@lex _ R n).
Proof.
intros R H1 n x y; induction n; [rewrite (hat0F_unit x y); easy |].
rewrite !lex_S; intros [H2 | H2].
left; split; [apply not_eq_sym | apply H1]; easy.
right; split; [| apply IHn]; easy.
Qed.

Lemma colex_sym :
   {R : T T Prop},
    symmetric R {n}, symmetric (@colex _ R n).
Proof.
intros R H1 n x y; induction n; [rewrite (hat0F_unit x y); easy |].
rewrite !colex_S; intros [H2 | H2].
left; split; [apply not_eq_sym | apply H1]; easy.
right; split; [| apply IHn]; easy.
Qed.

Lemma symlex_sym :
   {R : T T Prop},
    symmetric R {n}, symmetric (@symlex _ R n).
Proof. intros; apply conv_sym, lex_sym; easy. Qed.

Lemma revlex_sym :
   {R : T T Prop},
    symmetric R {n}, symmetric (@revlex _ R n).
Proof. intros; apply conv_sym, colex_sym; easy. Qed.

Lemma lex_antisym :
   {R : T T Prop},
    antisymmetric R {n}, antisymmetric (@lex _ R n).
Proof.
intros R H1 n x y; induction n; [rewrite (hat0F_unit x y); easy |].
rewrite !lex_S; intros [[H2a H2b] | [H2 H3]] [[H4a H4b] | [H4 H5]].
contradict H2a; apply H1; easy.
contradict H2a; easy.
contradict H4a; easy.
apply extF_skipF with ord0; [| apply IHn]; easy.
Qed.

Lemma colex_antisym :
   {R : T T Prop},
    antisymmetric R {n}, antisymmetric (@colex _ R n).
Proof.
intros R H1 n x y; induction n; [rewrite (hat0F_unit x y); easy |].
rewrite !colex_S; intros [[H2a H2b] | [H2 H3]] [[H4a H4b] | [H4 H5]].
contradict H2a; apply H1; easy.
contradict H2a; easy.
contradict H4a; easy.
apply extF_skipF with ord_max; [| apply IHn]; easy.
Qed.

Lemma symlex_antisym :
   {R : T T Prop},
    antisymmetric R {n}, antisymmetric (@symlex _ R n).
Proof. intros; apply conv_antisym, lex_antisym; easy. Qed.

Lemma revlex_antisym :
   {R : T T Prop},
    antisymmetric R {n}, antisymmetric (@revlex _ R n).
Proof. intros; apply conv_antisym, colex_antisym; easy. Qed.

Lemma lex_asym :
   {R : T T Prop},
    inhabited T asymmetric R {n}, asymmetric (@lex _ R n).
Proof.
intros R HT H n x y; induction n.
rewrite (hat0F_unit x y); intros _; apply lex_irrefl, asym_irrefl; easy.
rewrite !lex_S; intros [[H3a H3b] | [H3a H3b]];
    rewrite not_or_equiv !not_and_equiv NNPP_equiv; split.
right; apply H; easy.
left; apply neq_sym_equiv; easy.
left; easy.
right; apply IHn; easy.
Qed.

Lemma colex_asym :
   {R : T T Prop},
    inhabited T asymmetric R {n}, asymmetric (@colex _ R n).
Proof.
intros R HT H n x y; induction n.
rewrite (hat0F_unit x y); intros _; apply colex_irrefl, asym_irrefl; easy.
rewrite !colex_S; intros [[H3a H3b] | [H3a H3b]];
    rewrite not_or_equiv !not_and_equiv NNPP_equiv; split.
right; apply H; easy.
left; apply neq_sym_equiv; easy.
left; easy.
right; apply IHn; easy.
Qed.

Lemma symlex_asym :
   {R : T T Prop},
    inhabited T asymmetric R {n}, asymmetric (@symlex _ R n).
Proof. intros; apply conv_asym, lex_asym; easy. Qed.

Lemma revlex_asym :
   {R : T T Prop},
    inhabited T asymmetric R {n}, asymmetric (@revlex _ R n).
Proof. intros; apply conv_asym, colex_asym; easy. Qed.

With the connected / strongly_connected / trichotomous elementary properties.

Lemma lex_conn :
   {R : T T Prop},
    eq_dec T connected R {n}, connected (@lex _ R n).
Proof.
intros R HT H n x y H1; induction n.
rewrite (hat0F_unit x y) in H1; easy.
rewrite !lex_S; destruct (HT (x ord0) (y ord0)) as [H2 | H2].
assert (H3 : skipF x ord0 skipF y ord0).
  contradict H1; apply extF_skipF with ord0; easy.
destruct (IHn _ _ H3) as [H4 | H4]; [left | right]; right; easy.
destruct (H _ _ H2) as [H3 | H3];
    [left | right; rewrite neq_sym_equiv]; left; easy.
Qed.

Lemma colex_conn :
   {R : T T Prop},
    eq_dec T connected R {n}, connected (@colex _ R n).
Proof.
intros R HT H n x y H1; induction n.
rewrite (hat0F_unit x y) in H1; easy.
rewrite !colex_S; destruct (HT (x ord_max) (y ord_max)) as [H2 | H2].
assert (H3 : skipF x ord_max skipF y ord_max).
  contradict H1; apply extF_skipF with ord_max; easy.
destruct (IHn _ _ H3) as [H4 | H4]; [left | right]; right; easy.
destruct (H _ _ H2) as [H3 | H3];
    [left | right; rewrite neq_sym_equiv]; left; easy.
Qed.

Lemma symlex_conn :
   {R : T T Prop},
    eq_dec T connected R {n}, connected (@symlex _ R n).
Proof. intros; apply conv_conn, lex_conn; easy. Qed.

Lemma revlex_conn :
   {R : T T Prop},
    eq_dec T connected R {n}, connected (@revlex _ R n).
Proof. intros; apply conv_conn, colex_conn; easy. Qed.

Lemma lex_str_conn :
   {R : T T Prop},
    eq_dec T
    strongly_connected R {n}, strongly_connected (@lex _ R n).
Proof.
intros R HT H1 n x y; induction n.
rewrite lex_nil; left; apply str_conn_refl; easy.
rewrite !lex_S; destruct (HT (x ord0) (y ord0)) as [H2 | H2].
destruct (IHn (skipF x ord0) (skipF y ord0)) as [H3 | H3];
    [left | right]; right; split; easy.
destruct (H1 (x ord0) (y ord0)) as [H3 | H3];
    [left | right; rewrite neq_sym_equiv]; left; split; try easy.
Qed.

Lemma colex_str_conn :
   {R : T T Prop},
    eq_dec T
    strongly_connected R {n}, strongly_connected (@colex _ R n).
Proof.
intros R HT H1 n x y; induction n.
rewrite colex_nil; left; apply str_conn_refl; easy.
rewrite !colex_S; destruct (HT (x ord_max) (y ord_max)) as [H2 | H2].
destruct (IHn (skipF x ord_max) (skipF y ord_max)) as [H3 | H3];
    [left | right]; right; split; easy.
destruct (H1 (x ord_max) (y ord_max)) as [H3 | H3];
    [left | right; rewrite neq_sym_equiv]; left; split; try easy.
Qed.

Lemma symlex_str_conn :
   {R : T T Prop},
    eq_dec T
    strongly_connected R {n}, strongly_connected (@symlex _ R n).
Proof. intros; apply conv_str_conn, lex_str_conn; easy. Qed.

Lemma revlex_str_conn :
   {R : T T Prop},
    eq_dec T
    strongly_connected R {n}, strongly_connected (@revlex _ R n).
Proof. intros; apply conv_str_conn, colex_str_conn; easy. Qed.

Lemma lex_tricho :
   {R : T T Prop},
    inhabited T eq_dec T
    trichotomous R {n}, trichotomous (@lex _ R n).
Proof.
intros R HT0 HT1 H n; move: (eq_decF HT1 n); intros HTn; move: H.
rewrite !tricho_equiv_asym_conn; [| easy..]; apply modus_ponens_and; intros H;
    [apply lex_asym | apply lex_conn]; easy.
Qed.

Lemma colex_tricho :
   {R : T T Prop},
    inhabited T eq_dec T
    trichotomous R {n}, trichotomous (@colex _ R n).
Proof.
intros R HT0 HT1 H n; move: (eq_decF HT1 n); intros HTn; move: H.
rewrite !tricho_equiv_asym_conn; [| easy..]; apply modus_ponens_and; intros H;
    [apply colex_asym | apply colex_conn]; easy.
Qed.

Lemma symlex_tricho :
   {R : T T Prop},
    inhabited T eq_dec T
    trichotomous R {n}, trichotomous (@symlex _ R n).
Proof. intros; apply conv_tricho, lex_tricho; easy. Qed.

Lemma revlex_tricho :
   {R : T T Prop},
    inhabited T eq_dec T
    trichotomous R {n}, trichotomous (@revlex _ R n).
Proof. intros; apply conv_tricho, colex_tricho; easy. Qed.

With the transitive / negatively_transitive elementary properties.

Lemma lex_trans :
   {R : T T Prop},
    eq_dec T antisymmetric R
    transitive R {n}, transitive (@lex _ R n).
Proof.
intros R HT H1 H2 n x y z; induction n; [easy |].
rewrite !lex_S; intros [[H3a H3b] | [H3 H4]] [[H5a H5b] | [H5 H6]].
left; split; [| apply H2 with (y ord0); easy].
destruct (HT (x ord0) (z ord0)) as [H4 |]; [exfalso | easy].
rewrite H4 in H3b; contradict H5a; apply H1; easy.
rewrite -H5; left; easy.
rewrite H3; left; easy.
right; split; [rewrite H3 | apply IHn with (skipF y ord0)]; easy.
Qed.

Lemma colex_trans :
   {R : T T Prop},
    eq_dec T antisymmetric R
    transitive R {n}, transitive (@colex _ R n).
Proof.
intros R HT H1 H2 n x y z; induction n; [easy |].
rewrite !colex_S; intros [[H3a H3b] | [H3 H4]] [[H5a H5b] | [H5 H6]].
left; split; [| apply H2 with (y ord_max); easy].
destruct (HT (x ord_max) (z ord_max)) as [H4 |]; [exfalso | easy].
rewrite H4 in H3b; contradict H5a; apply H1; easy.
rewrite -H5; left; easy.
rewrite H3; left; easy.
right; split; [rewrite H3 | apply IHn with (skipF y ord_max)]; easy.
Qed.

Lemma symlex_trans :
   {R : T T Prop},
    eq_dec T antisymmetric R
    transitive R {n}, transitive (@symlex _ R n).
Proof. intros; apply conv_trans, lex_trans; easy. Qed.

Lemma revlex_trans :
   {R : T T Prop},
    eq_dec T antisymmetric R
    transitive R n, transitive (@revlex _ R n).
Proof. intros; apply conv_trans, colex_trans; easy. Qed.

Lemma lex_neg_trans :
   {R : T T Prop},
    inhabited T eq_dec T reflexive R irreflexive R connected R
    negatively_transitive R {n}, negatively_transitive (@lex _ R n).
Proof.
intros R HT1 HT2; rewrite -compl_antisym_equiv.
moveH1 H2 /neg_trans_equiv /(lex_trans HT2 H2) H3 n.
rewrite neg_trans_equiv -(lex_compl HT1 HT2 H1); easy.
Qed.

Lemma colex_neg_trans :
   {R : T T Prop},
    inhabited T eq_dec T reflexive R irreflexive R connected R
    negatively_transitive R {n}, negatively_transitive (@colex _ R n).
Proof.
intros R HT1 HT2; rewrite -compl_antisym_equiv.
moveH1 H2 /neg_trans_equiv /(colex_trans HT2 H2) H3 n.
rewrite neg_trans_equiv -(colex_compl HT1 HT2 H1); easy.
Qed.

Lemma symlex_neg_trans :
   {R : T T Prop},
    inhabited T eq_dec T reflexive R irreflexive R connected R
    negatively_transitive R {n}, negatively_transitive (@symlex _ R n).
Proof. intros; apply conv_neg_trans, lex_neg_trans; easy. Qed.

Lemma revlex_neg_trans :
   {R : T T Prop},
    inhabited T eq_dec T reflexive R irreflexive R connected R
    negatively_transitive R n, negatively_transitive (@revlex _ R n).
Proof. intros; apply conv_neg_trans, colex_neg_trans; easy. Qed.

End Lex_orders_Facts2.

Section Lex_orders_Facts3.

Context {T : Type}.

Compatibility results with compound properties.
Compatibility of *lex operators with transitive needs antisymmetric for the argument binary relation. Thus, there is no compatibility result with partial_equivalence_relation, equivalence_relation, preorder, and total_preorder since they do not involve antisymmetry.
With the partial_order / total_order compound properties.

Lemma lex_partial_order :
   {R : T T Prop},
    eq_dec T partial_order R {n}, partial_order (@lex _ R n).
Proof.
intros R HT H n; split; [| split]; [apply lex_refl | apply lex_antisym |
    apply lex_trans; [easy |..]]; apply H.
Qed.

Lemma colex_partial_order :
   {R : T T Prop},
    eq_dec T partial_order R {n}, partial_order (@colex _ R n).
Proof.
intros R HT H n; split; [| split]; [apply colex_refl | apply colex_antisym |
    apply colex_trans; [easy |..]]; apply H.
Qed.

Lemma symlex_partial_order :
   {R : T T Prop},
    eq_dec T partial_order R {n}, partial_order (@symlex _ R n).
Proof. intros; apply conv_partial_order, lex_partial_order; easy. Qed.

Lemma revlex_partial_order :
   {R : T T Prop},
    eq_dec T partial_order R {n}, partial_order (@revlex _ R n).
Proof. intros; apply conv_partial_order, colex_partial_order; easy. Qed.

Lemma lex_total_order :
   {R : T T Prop},
    eq_dec T total_order R {n}, total_order (@lex _ R n).
Proof.
intros R HT H n; move: (eq_decF HT n) HHTn.
rewrite (total_order_equiv_po HT) (total_order_equiv_po HTn); intros H; split;
    [apply lex_partial_order | apply lex_conn]; easy.
Qed.

Lemma colex_total_order :
   {R : T T Prop},
    eq_dec T total_order R {n}, total_order (@colex _ R n).
Proof.
intros R HT H n; move: (eq_decF HT n) HHTn.
rewrite (total_order_equiv_po HT) (total_order_equiv_po HTn); intros H; split;
    [apply colex_partial_order | apply colex_conn]; easy.
Qed.

Lemma symlex_total_order :
   {R : T T Prop},
    eq_dec T total_order R {n}, total_order (@symlex _ R n).
Proof.
intros; apply conv_total_order, lex_total_order; [apply eq_decF |..]; easy.
Qed.

Lemma revlex_total_order :
   {R : T T Prop},
    eq_dec T total_order R {n}, total_order (@revlex _ R n).
Proof.
intros; apply conv_total_order, colex_total_order; [apply eq_decF |..]; easy.
Qed.

With the strict_partial_order / strict_total_order compound properties.

Lemma lex_strict_partial_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_partial_order R {n}, strict_partial_order (@lex _ R n).
Proof.
intros R HT1 HT2 H n; apply strict_partial_order_equiv_no_asym; split.
apply lex_irrefl; [easy | apply H].
apply lex_trans; [easy | apply asym_antisym |]; apply H.
Qed.

Lemma colex_strict_partial_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_partial_order R {n}, strict_partial_order (@colex _ R n).
Proof.
intros R HT1 HT2 H n; apply strict_partial_order_equiv_no_asym; split.
apply colex_irrefl; [easy | apply H].
apply colex_trans; [easy | apply asym_antisym |]; apply H.
Qed.

Lemma symlex_strict_partial_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_partial_order R n, strict_partial_order (@symlex _ R n).
Proof.
intros; apply conv_strict_partial_order, lex_strict_partial_order; easy.
Qed.

Lemma revlex_strict_partial_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_partial_order R n, strict_partial_order (@revlex _ R n).
Proof.
intros; apply conv_strict_partial_order, colex_strict_partial_order; easy.
Qed.

Lemma lex_strict_total_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_total_order R {n}, strict_total_order (@lex _ R n).
Proof.
intros R HT1 HT2 H n; move: H;
    rewrite !strict_total_order_equiv_spo; intros H; split.
apply lex_strict_partial_order; [easy.. | apply H].
apply lex_conn; [easy | apply H].
Qed.

Lemma colex_strict_total_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_total_order R {n}, strict_total_order (@colex _ R n).
Proof.
intros R HT1 HT2 H n; move: H;
    rewrite !strict_total_order_equiv_spo; intros H; split.
apply colex_strict_partial_order; [easy.. | apply H].
apply colex_conn; [easy | apply H].
Qed.

Lemma symlex_strict_total_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_total_order R {n}, strict_total_order (@symlex _ R n).
Proof.
intros; apply conv_strict_total_order, lex_strict_total_order; easy.
Qed.

Lemma revlex_strict_total_order :
   {R : T T Prop},
    inhabited T eq_dec T
    strict_total_order R {n}, strict_total_order (@revlex _ R n).
Proof.
intros; apply conv_strict_total_order, colex_strict_total_order; easy.
Qed.

Compatibility of *lex operators with negatively_transitive needs connected for the argument binary relation. Thus, a compatibility result with strict_weak_order, which involves negatively_transitive, would also need connected, and strict_weak_order would become strict_total_order.