diff --git a/FEM/FE_LagP_new.v b/FEM/FE_LagP_new.v
deleted file mode 100644
index ac9723bd15b6cbbd812b2a021eaf8400739b67be..0000000000000000000000000000000000000000
--- a/FEM/FE_LagP_new.v
+++ /dev/null
@@ -1,717 +0,0 @@
-(**
-This file is part of the Elfic 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.
-*)
-
-From FEM.Compl Require Import stdlib.
-
-Set Warnings "-notation-overridden".
-From FEM.Compl Require Import ssr.
-
-(* Next import provides Reals, Coquelicot.Hierarchy, functions to module spaces,
- and linear mappings. *)
-From LM Require Import linear_map.
-Set Warnings "notation-overridden".
-
-From Lebesgue Require Import Subset Function.
-
-From FEM Require Import Compl Algebra binomial_compl multi_index_new poly_Lagrange_new.
-From FEM Require Import P_approx_k_new FE_new FE_simplex_new.
-
-Local Open Scope R_scope.
-
-(** FE LAGRANGE current *)
-Section FE_Lagrange_cur_Pk_d.
-
-(*Local Notation "'nnode_LagP_' kL '_' dL" := ((pbinom dL kL).+1) (at level 50, format "'nnode_LagP_' kL '_' dL").*)
-
-Definition nnode_LagP dL kL : nat := (pbinom dL kL).+1.
-
-(* Réunion 1/9/23 Vincent est embêté :
-ici, on a un souci, on a besoin que les noeuds soient distincts
-et que cette famille de taille dim_Pk_d soit bien de cette taille.
-Il suffit que les noeuds (node_cur) soient distincts ou 
-que les sommets (vtx_cur) soient affinement indépendants
-SB dit : on a pas eu le pb avant car on était sur vtx_ref 
- (qui a les bonnes propriétés)
-On peut prouver ça à partir de la déf des node_cur, c'est bizarre que 
-ça ne nous ai pas explosé encore à la figure
-*)
-
-(*FC: node_ref_aux are the reference nodes (one per dof). *)
-
-Definition ndof_LagPk_d dL kL : nat := ndof_nodal (nnode_LagP dL kL). (* nodes of geometrical element *)
-
-(* "nombre de dof = nombre de noeuds" *)
-Lemma ndof_is_dim_Pk : ndof_LagPk_d = nnode_LagP.
-Proof. easy. Qed.
-
-Lemma ndof_LagPk_d_pos : forall dL kL, (0 < dL)%coq_nat -> (0 < ndof_LagPk_d dL kL)%coq_nat.
-Proof.
-intros; apply ndof_nodal_pos.
-apply pbinomS_pos.
-Qed.
-
-Definition shape_LagPk_d_is_Simplex := Simplex.
-
-Local Definition nvtx_LagPk_d dL : nat := 
-  match shape_LagPk_d_is_Simplex with (*number of vertices*)
-       | Simplex => (S dL)
-       | Quad => 2^dL
-    end.
-
-Lemma nvtx_LagPk_d_pos : forall dL, (0 < nvtx_LagPk_d dL)%coq_nat.
-Proof. auto with arith. Qed.
-
-Lemma P_compat_fin_LagPk_d : forall dL kL,
-  has_dim (P_approx_k_d dL kL) (ndof_LagPk_d dL kL).
-Proof.
-intros; rewrite ndof_is_dim_Pk.
-apply P_approx_k_d_compat_fin.
-Qed.
-
-Definition Sigma_LagPk_d_ref dL kL : '(FRd dL -> R)^(ndof_LagPk_d dL kL) :=
-  Sigma_nodal dL (nnode_LagP dL kL) (node_ref_aux dL kL).
-
-Definition Sigma_LagPk_d_cur dL kL vtx_cur : '(FRd dL -> R)^(ndof_LagPk_d dL kL) :=
-  Sigma_nodal dL (nnode_LagP dL kL) (node_cur_aux dL kL vtx_cur).
-
-Definition Sigma_LagPk_d_cur_aux dL kL vtx_cur := fun i p => 
-  Sigma_LagPk_d_ref dL kL i (fun x => p (T_geom vtx_cur x)).
-
-Lemma Sigma_LagPk_d_ref_lin_map : forall dL kL (i : 'I_(ndof_LagPk_d dL kL)),
-   is_linear_mapping (Sigma_LagPk_d_ref dL kL i).
-Proof.
-intros; apply Sigma_nodal_lin_map.
-Qed.
-
-(** "Livre Vincent Lemma 1659 - p51." *)
-Lemma unisolvence_LagP1_d_cur : forall dL vtx_cur,
-  (0 < dL)%coq_nat ->
-  affine_independent vtx_cur -> 
-  bijS (P_approx_k_d dL 1) fullset (gather (Sigma_LagPk_d_cur dL 1 vtx_cur)).
-Proof.
-intros dL vtx_cur dL_pos Hvtx.
-destruct dL; try easy.
-(* case dL + 1 *)
-apply (lmS_bijS_sub_gather_equiv (P_approx_k_d_compat_fin _ _)).
-rewrite ndof_is_dim_Pk; easy.
-intros [p Hp1] Hp2.
-apply val_inj; simpl.
-simpl in Hp2.
-destruct (is_basis_ex_decomp (LagP1_d_cur_is_basis dL.+1 vtx_cur Hvtx) p Hp1) as [L HL].
-rewrite HL in Hp2.
-rewrite HL.
-apply comb_lin_zero_compat_l, extF.
-intros i.
-specialize (Hp2 (cast_ord (eq_sym (pbinomS_1_r dL.+1)) i)).
-rewrite fct_comb_lin_r_eq in Hp2.
-rewrite (comb_lin_eq_r _ _ (kronecker^~ i)) in Hp2.
-rewrite (comb_lin_kronecker_basis L). 
-rewrite fct_comb_lin_r_eq; easy.
-apply fun_ext; intros j.
-rewrite (LagP1_d_cur_kron_nodes vtx_cur Hvtx).
-apply kronecker_sym.
-Qed.
-
-(** "Livre Vincent Lemma 1570 - p23." *)
-Lemma unisolvence_LagPk_1_cur : forall kL vtx_cur,
-  (0 < kL)%coq_nat ->
- affine_independent vtx_cur -> 
-  bijS (P_approx_k_d 1 kL) fullset (gather (Sigma_LagPk_d_cur 1 kL vtx_cur)).
-Proof.
-intros kL vtx_cur HkL Hvtx.
-destruct kL; try easy.
-(* case kL + 1 *)
-apply (lmS_bijS_sub_gather_equiv (P_approx_k_d_compat_fin _ _)).
-rewrite ndof_is_dim_Pk; easy.
-intros [p Hp1] Hp2.
-apply val_inj; simpl.
-destruct (is_basis_ex_decomp (LagPk_1_cur_is_basis kL.+1 HkL vtx_cur Hvtx) p Hp1) as [L HL].
-simpl in Hp2.
-rewrite HL in Hp2.
-rewrite HL.
-apply comb_lin_zero_compat_l, extF.
-intros i.
-specialize (Hp2 i).
-rewrite fct_comb_lin_r_eq in Hp2.
-rewrite (comb_lin_eq_r _ _ (kronecker^~ i)) in Hp2.
-rewrite (comb_lin_kronecker_basis L). 
-rewrite fct_comb_lin_r_eq; easy.
-apply fun_ext; intros j.
-rewrite kronecker_sym LagPk_1_cur_kron_nodes_aux; easy.
-Qed.
-
-(* face_hyp_0 est la face opposee au sommet z0 *)
-(** "Livre Vincent Lemma 1634 - p45." *)
-Definition face_hyp_0 dL (vtx_cur : 'R^{dL.+1,dL}) : (*'R^dL*) fct_ModuleSpace -> Prop 
-  := fun x => LagP1_d_cur vtx_cur ord0 x = 0.
-
-(** "Livre Vincent Lemma 1633 - p44." *)
-Lemma face_hyp_0_equiv : forall dL (vtx_cur : 'R^{dL.+1,dL}) (x : 'R^dL),
-  affine_independent vtx_cur ->
-  face_hyp_0 dL vtx_cur x <->
-    (exists L : 'R^dL, sum L = 1 /\ x = comb_lin L (liftF_S vtx_cur)).
-Proof.
-intros dL vtx_cur x Hvtx.
-split; intros H.
-exists (liftF_S (LagP1_d_cur vtx_cur^~ x)).
-split.
-apply (plus_reg_l (LagP1_d_cur vtx_cur ord0 x)).
-rewrite -sum_ind_l.
-rewrite H.
-rewrite plus_zero_l.
-apply LagP1_d_cur_sum_1.
-(* *)
-rewrite {1}(affine_independent_decomp dL vtx_cur x); try easy.
-rewrite comb_lin_ind_l.
-rewrite H scal_zero_l plus_zero_l; easy.
-(* <- *)
-destruct H as [L [HL1 HL2]].
-unfold face_hyp_0.
-unfold LagP1_d_cur.
-rewrite HL2.
-rewrite comb_lin_liftF_S_r; unfold castF_1pS; rewrite castF_refl.
-rewrite T_geom_inv_transports_convex_baryc; try easy.
-rewrite LagP1_d_ref_comb_lin. 
-rewrite concatF_correct_l; easy.
-1,2 : rewrite (sum_concatF (singleF 0%M) L).
-1,2 : rewrite HL1 sum_singleF plus_zero_l; easy.
-Qed.
-
-(* a_alpha \in H0 <-> alpha \in Ck_d *)
-(** "Livre Vincent Lemma 1648 - p48." *)
-Lemma Multi_index_in_Ck_d : forall dL kL (vtx_cur : '('R^dL)^dL.+1)
-  (ipk : 'I_((pbinom dL kL).+1)), (0 < dL)%coq_nat -> (0 < kL)%coq_nat -> 
-  affine_independent vtx_cur ->
-   ((pbinom dL kL.-1).+1 <= ipk)%coq_nat  <-> 
-    face_hyp_0 dL vtx_cur (node_cur_aux dL kL vtx_cur ipk).
-Proof.
-intros dL kL vtx_cur ipk HdL HkL Hvtx.
-rewrite -A_d_k_last_layer; try easy.
-unfold face_hyp_0, LagP1_d_cur.
-rewrite -node_cur_aux_comb_lin; try easy.
-assert (Y : sum ((LagP1_d_ref dL)^~ (node_ref dL kL ipk)) = 1%K).
-apply LagP1_d_ref_sum_1.
-rewrite T_geom_inv_transports_convex_baryc; try easy.
-rewrite LagP1_d_ref_0; try easy.
-split; intros H1.
-(* -> *)
-apply Rminus_diag_eq, eq_sym.
-rewrite comb_lin_ind_l.
-rewrite LagP1_d_ref_0; try easy.
-rewrite (comb_lin_eq_r (liftF_S
-        ((LagP1_d_ref dL)^~ (node_ref dL kL
-                              ipk)))
-  (liftF_S (vtx_simplex_ref dL)) kronecker).
-rewrite -comb_lin_kronecker_basis.
-2 :{ unfold vtx_simplex_ref, liftF_S.
-apply fun_ext; intros i.
-destruct (ord_eq_dec (lift_S i) ord0) as [H | H]; try easy.
-apply fun_ext; intros j; simpl; f_equal;
-auto with zarith. }
-rewrite (sum_eq _ (0 + liftF_S
-     ((LagP1_d_ref dL)^~ (node_ref dL kL ipk)))%M).
-rewrite plus_zero_l.
-unfold liftF_S, node_ref.
-rewrite (sum_ext _ 
-   (fun i : 'I_dL => INR (A_d_k dL kL ipk i) / INR kL)).
-rewrite -mult_sum_distr_r -inv_eq_R -one_eq_R; apply div_one_compat.
-apply invertible_equiv_R, not_eq_sym, Rlt_not_eq, lt_0_INR; easy.
-rewrite sum_INR; f_equal; easy.
-intros i; unfold LagP1_d_ref.
-destruct (ord_eq_dec _ _) as [H | H]; try easy.
-do 3!f_equal.
-apply lower_lift_S.
-f_equal; unfold vtx_simplex_ref.
-destruct (ord_eq_dec ord0 ord0) as [H | H]; try easy.
-rewrite scal_zero_r; easy.
-(* <- *)
-apply Rminus_diag_uniq_sym in H1.
-rewrite comb_lin_ind_l in H1.
-rewrite LagP1_d_ref_0 in H1; try easy.
-rewrite (comb_lin_eq_r (liftF_S
-        ((LagP1_d_ref dL)^~ (node_ref dL kL
-                              ipk)))
-  (liftF_S (vtx_simplex_ref dL)) kronecker) in H1.
-rewrite -comb_lin_kronecker_basis in H1.
-2 :{ unfold vtx_simplex_ref, liftF_S.
-apply fun_ext; intros i.
-destruct (ord_eq_dec (lift_S i) ord0) as [H | H]; try easy.
-apply fun_ext; intros j; simpl; f_equal; 
-auto with zarith. }
-rewrite (sum_eq _ (0 + liftF_S
-     ((LagP1_d_ref dL)^~ (node_ref dL kL ipk)))%M) in H1.
-2 : {f_equal.
-unfold vtx_simplex_ref.
-destruct (ord_eq_dec ord0 ord0) as [H | H]; try easy.
-rewrite scal_zero_r; easy. }
-rewrite plus_zero_l in H1.
-unfold node_ref in H1.
-rewrite (sum_ext _ 
-   (fun i : 'I_dL => INR (A_d_k dL kL ipk i) / INR kL)) in H1.
-rewrite -mult_sum_distr_r -inv_eq_R -one_eq_R in H1; apply div_one_reg in H1.
-rewrite sum_mapF in H1; try apply INR_morphism_m.
-apply INR_eq; easy.
-apply invertible_equiv_R, not_eq_sym, Rlt_not_eq, lt_0_INR; easy.
-intros i.
-unfold liftF_S, LagP1_d_ref.
-destruct (ord_eq_dec _ _); try easy.
-do 3!f_equal.
-apply lower_lift_S.
-Qed.
-
-(* a_alpha \notin H0 <-> alpha \in Ak-1_d *)
-Lemma Multi_index_in_A_d_k : forall dL kL (vtx_cur : '('R^dL)^dL.+1)
-  (ipk : 'I_((pbinom dL kL).+1)), (0 < dL)%coq_nat -> (0 < kL)%coq_nat -> 
-  affine_independent vtx_cur ->
-  ~ face_hyp_0 dL vtx_cur (node_cur_aux dL kL vtx_cur ipk) <->
-       (ipk < ((pbinom dL kL.-1).+1))%coq_nat.
-Proof.
-intros dL kL vtx_cur ipk HdL HkL Hvtx.
-apply iff_trans with (B := ~ ((pbinom dL kL.-1).+1 <= ipk)%coq_nat).
-apply not_iff_compat.
-rewrite Multi_index_in_Ck_d; try easy.
-split; intros H.
-apply not_ge; easy.
-apply Arith_prebase.lt_not_le_stt; easy.
-Qed.
-
-(* alpha \in Ak-1_d, a_tilde \notin H0 *)
-Lemma Multi_index_in_A_d_k_aux : forall dL kL (vtx_cur : '('R^dL)^dL.+1)
-  (ipk : 'I_((pbinom dL kL).+1)), (0 < dL)%coq_nat -> (0 < kL)%coq_nat -> 
-  affine_independent vtx_cur ->
-  ~ face_hyp_0 dL vtx_cur (sub_node dL kL.+1 vtx_cur ipk).
-Proof.
-intros dL kL vtx_cur ipk HdL HkL Hvtx.
-rewrite sub_node_cur_eq; auto with zarith.
-intros H.
-apply Multi_index_in_A_d_k; auto with zarith.
-simpl; apply /ltP; easy.
-Qed.
-
-(* face_hyp_ref_d est la face opposee au sommet z_d *)
-(** "Livre Vincent Lemma 1634 - p45." *)
-Definition face_hyp_ref_d dL : (*'R^dL*) fct_ModuleSpace -> Prop 
-  := fun x => LagP1_d_ref dL ord_max x = 0.
-
-(* Phi (H_ref) = H_cur *)
-(** "Livre Vincent Lemma 1661 - p54." *)
-Lemma Phi_d_0_in_face_hyp_0: forall dL (vtx_cur : '('R^dL)^dL.+1) x_ref,
-  affine_independent vtx_cur -> (0 < dL)%coq_nat ->
-  face_hyp_ref_d dL x_ref <->
-  face_hyp_0 dL vtx_cur (Phi_d_0 dL vtx_cur x_ref).
-Proof.
-intros dL vtx_cur x_ref Hvtx Hd.
-unfold face_hyp_0.
-replace 0 with (@zero R_AbelianMonoid) by easy.
-rewrite -Ker_comp_l_alt.
-2 : apply bij_surj, (Phi_d_0_bijective dL vtx_cur Hvtx).
-2 : { apply fun_ext; intros x.
-rewrite comp_correct.
-rewrite -LagP1_d_cur_Phi_d_0; easy. }
-rewrite transpF_correct_l0; try easy.
-rewrite -RgS_ex.
-split; try easy.
-intros H1.
-inversion H1 as [y Hy1 Hy2]. 
-unfold face_hyp_ref_d.
-replace x_ref with y; try easy.
-apply (bij_inj (Phi_d_0_bijective dL vtx_cur Hvtx)); easy.
-Qed.
-
-(** "Livre Vincent Lemma 1683 - p60." *)
-Lemma fact_zero_poly_ref : 
-  forall (dL kL : nat), (0 < dL)%coq_nat ->
-  forall p_ref : FRd dL, P_approx_k_d dL kL.+1 p_ref ->
-  (forall x : 'R^dL, face_hyp_ref_d dL x -> p_ref x = 0) <->
-    exists q_Ref : FRd dL, P_approx_k_d dL kL q_Ref /\
-         p_ref = ((LagP1_d_ref dL ord_max) * q_Ref)%K.
-Proof.
-intros dL kL Hd p_ref Hp1; split.
-(* -> *)
-destruct dL.
-intros Hp2; easy.
-(* *)
-intros Hp2.
-destruct (P_approx_Sk_split kL p_ref Hp1) as [p0 [p1 [H1 [H2 H3]]]].
-exists p1.
-split.
-assumption.
-rewrite H3.
-apply fun_ext; intros x.
-rewrite fct_mult_eq.
-assert (H : forall y : 'R^dL, p0 y = 0).
-intros y; rewrite -(Rplus_0_r (p0 _)).
-rewrite -{1}(Rmult_0_l (p1 (insertF y 0 ord_max))).
-replace (_ + _) with (p_ref (insertF y 0 ord_max)). 
-2 : try rewrite H3 widenF_S_insertF_max insertF_correct_l; easy.
-apply Hp2.
-unfold face_hyp_ref_d.
-rewrite (LagP1_d_ref_neq0 _ _ ord_max_not_0).
-rewrite insertF_correct_l; try easy.
-apply ord_inj; rewrite lower_S_correct; easy.
-(* fini l'assert *)
-rewrite H Rplus_0_l.
-rewrite (LagP1_d_ref_neq0 _ _ ord_max_not_0).
-unfold mult; simpl.
-do 2!f_equal.
-apply ord_inj; rewrite lower_S_correct; easy.
-(* <- *)
-intros [q [Hq1 Hq2]] x Hx.
-rewrite Hq2 fct_mult_eq Hx mult_zero_l; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1684 - p60." *)
-Lemma fact_zero_poly : 
-  forall (dL kL : nat) (vtx_cur : 'R^{dL.+1,dL}), 
-  (0 < dL)%coq_nat ->
-  affine_independent vtx_cur ->
-  forall p : FRd dL, P_approx_k_d dL kL.+1 p ->
-  (forall x : 'R^dL, face_hyp_0 dL vtx_cur x -> p x = 0) <->
-    exists q : FRd dL, P_approx_k_d dL kL q /\
-        p = ((LagP1_d_cur vtx_cur ord0) * q)%K.
-Proof.
-intros dL kL vtx_cur Hd Hvtx p Hp1; split.
-(* -> *)
-intros Hp2.
-pose (p_ref := compose p (Phi_d_0 dL vtx_cur)).
-assert (H : P_approx_k_d dL kL.+1 p_ref).
-apply Phi_d_0_compose; easy.
-destruct (proj1 (fact_zero_poly_ref dL kL Hd p_ref H)) as [q_ref [Y1 Y2]].
-intros x_ref Hx_ref.
-unfold p_ref, compose.
-apply Hp2. 
-apply Phi_d_0_in_face_hyp_0; easy.
-(* fini destruct *)
-exists (compose q_ref (Phi_d_0_inv dL vtx_cur Hvtx)).
-split.
-apply Phi_d_0_inv_compose; try easy.
-assert (H0 : p = compose p_ref ((Phi_d_0_inv dL vtx_cur Hvtx))).
-unfold p_ref, compose.
-apply fun_ext; intros x_cur.
-rewrite f_inv_can_r; easy.
-rewrite H0 Y2.
-unfold compose.
-apply fun_ext; intros x.
-rewrite 2!fct_mult_eq.
-f_equal.
-rewrite LagP1_d_ref_Phi_d_0_inv.
-rewrite transpF_correct_l0; easy.
-(* <- *)
-intros [q [Hq1 Hq2]] x Hx.
-rewrite Hq2 fct_mult_eq Hx mult_zero_l; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1657 - p51." *)
-Lemma Phi_in_face_hyp_0 : forall d1 (vtx_cur : 'R^{d1.+2,d1.+1}) ,
-  affine_independent vtx_cur ->
-  funS fullset (face_hyp_0 d1.+1 vtx_cur) (Phi d1 vtx_cur).
-Proof.
-intros d1 vtx_cur Hvtx _ [x _].
-rewrite face_hyp_0_equiv; try easy.
-exists (fun i => LagP1_d_ref d1 i x).
-split.
-apply LagP1_d_ref_sum_1.
-rewrite -Phi_eq; easy.
-Qed. 
-
-(** "Livre Vincent Lemma 1660 - p53." *)
-Lemma Phi_bijS :
-  forall d1 (vtx_cur : 'R^{d1.+2,d1.+1}),
-  affine_independent vtx_cur ->
-    bijS fullset (face_hyp_0 d1.+1 vtx_cur) (Phi d1 vtx_cur).
-Proof.
-intros d1 vtx_cur Hvtx.
-apply (injS_surjS_bijS inhabited_fct_ms).
-apply Phi_in_face_hyp_0; try easy.
-rewrite (injS_aff_lin_equiv_alt invertible_2 compatible_as_fullset
-  (Phi_is_affine_mapping d1 vtx_cur) 0%M); try easy.
-intros x [_ Hx].
-apply (affine_independent_skipF ord0 Hvtx).
-rewrite skipF_first liftF_S_0.
-rewrite -Phi_fct_lm_eq; easy.
-(* *)
-intros y Hy.
-rewrite (face_hyp_0_equiv d1.+1 vtx_cur y Hvtx) in Hy.
-destruct Hy as [mu [H1 H2]].
-exists (liftF_S mu).
-split; try easy.
-rewrite H2 -Phi_eq.
-unfold Phi_aux; simpl.
-apply comb_lin_eq_l.
-apply extF; intros i.
-rewrite LagP1_d_ref_liftF_S; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1662 - p52." *)
-Lemma unisolvence_LagPk_d_cur : forall dL kL (vtx_cur :'R^{dL.+1,dL}),
-  (0 < dL)%coq_nat -> (0 < kL)%coq_nat ->
-  affine_independent vtx_cur -> 
-  bijS (P_approx_k_d dL kL) fullset (gather (Sigma_LagPk_d_cur dL kL vtx_cur)). 
-Proof.
-(* Step induction *)
-intros dL kL vtx_cur HdL HkL Hvtx.
-generalize vtx_cur Hvtx.
-clear vtx_cur Hvtx.
-apply nat2_ind_alt_11 with (m:= kL) (n := dL)
-  (P := fun kL dL => forall vtx_cur, 
-  affine_independent vtx_cur -> 
-  bijS (P_approx_k_d dL kL) fullset (gather (Sigma_LagPk_d_cur dL kL vtx_cur))); try easy.
-clear HdL HkL kL dL.
-intros kL HkL vtx_cur Hvtx.
-apply unisolvence_LagPk_1_cur; easy.
-clear HdL HkL kL dL.
-intros dL HdL vtx_cur Hvtx.
-apply unisolvence_LagP1_d_cur; easy.
-clear HdL HkL kL dL.
-intros kL dL HkL HdL IH1 IH2 vtx_cur Hvtx.
-apply (lmS_bijS_sub_gather_equiv (P_approx_k_d_compat_fin _ _)).
-rewrite ndof_is_dim_Pk; easy.
-intros [p Hp1] Hp2.
-simpl in Hp2.
-apply val_inj; simpl.
-(* Step 1 *)
-specialize (IH1 (vtx_simplex_ref dL) (vtx_simplex_ref_affine_ind dL (kL.+1) (Nat.lt_0_succ kL))).
-rewrite lmS_bijS_sub_gather_equiv in IH1.
-2: rewrite ndof_is_dim_Pk; easy.
-pose (p0' := compose p (Phi dL vtx_cur )).
-assert (Hp0' : P_approx_k_d dL kL.+1 p0') by now apply Phi_compose.
-pose (p0 := mk_sub_ms_ (has_dim_compatible_ms
-                 (P_compat_fin_LagPk_d dL kL.+1)) Hp0').
-specialize (IH1 p0).
-fold (node_ref_aux dL (kL.+1)) in IH1.
-rewrite -node_ref_eq in IH1; try now apply (Nat.lt_0_succ kL).
-assert (Y1 : forall x : 'R^dL.+1, 
-  face_hyp_0 dL.+1 vtx_cur x -> p x = 0).
-intros x Hx.
-assert (Y2 : forall y : 'R^dL.+1,  face_hyp_0 dL.+1 vtx_cur y ->
-  p y = p0' (f_invS (Phi_bijS dL vtx_cur Hvtx) y)).
-unfold p0'.
-intros y Hy.
-unfold compose.
-rewrite (f_invS_canS_r (Phi_bijS dL vtx_cur Hvtx)); try easy.
-unfold funS.
-rewrite Y2; try easy.
-apply val_eq in IH1.
-simpl in IH1.
-rewrite IH1; easy.
-intros i; simpl; unfold p0', compose.
-rewrite image_of_nodes_face_hyp; try easy.
-rewrite node_cur_eq; try easy.
-apply Nat.lt_0_succ.
-destruct (proj1 (fact_zero_poly _ _ vtx_cur (Nat.lt_0_succ dL) Hvtx _ Hp1) Y1) as [q [Hq1 Hq2]].
-rewrite Hq2.
-(* Step 2 *)
-assert (H1 : (1 < kL.+1)%coq_nat); auto with zarith. 
-specialize (IH2 (sub_vertex (dL.+1) (kL.+1) vtx_cur) (sub_vertex_affine_ind (dL.+1) (kL.+1) (Nat.lt_0_succ dL) H1 vtx_cur Hvtx)).
-destruct (lmS_bijS_sub_gather_equiv
-    (P_compat_fin_LagPk_d (dL.+1) kL) (sub_node (dL.+1) (kL.+1) vtx_cur)) as [H3 _].
-rewrite ndof_is_dim_Pk; easy.
-unfold Sigma_LagPk_d_cur, nnode_LagP in IH2.
-unfold ndof_nodal, sub_node in H3.
-simpl in H3.
-rewrite -(mult_zero_r (LagP1_d_cur vtx_cur ord0)).
-apply fun_ext; intros x.
-apply mult_compat_l.
-generalize x. 
-clear x.
-apply fun_ext_equiv.
-specialize (H3 IH2 (mk_sub_ms Hq1)).
-simpl in H3.
-rewrite -mk_sub_zero_equiv.
-apply H3.
-intros i.
-apply (Rmult_0_reg_r (LagP1_d_cur vtx_cur ord0 (node_cur_aux dL.+1 kL (sub_vertex dL.+1 kL.+1 vtx_cur) i))).
-generalize (Multi_index_in_A_d_k_aux _ kL vtx_cur i); intros H4.
-unfold face_hyp_0 in H4.
-apply H4; try easy.
-auto with arith.
-replace (_ * _) with (p (sub_node dL.+1 kL.+1 vtx_cur i)).
-rewrite sub_node_cur_eq; try easy.
-apply Nat.lt_0_succ.
-rewrite Hq2; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1663 - p54." *)
-Lemma face_hyp_0_in : forall dL kL (vtx_cur : 'fct_ModuleSpace^dL.+1)
-  (p : fct_ModuleSpace)  (x : 'R^dL), 
-  affine_independent vtx_cur ->
-  P_approx_k_d dL kL p -> 
-  (forall i : 'I_(nnode_LagP dL kL),
-      p (node_cur_aux dL kL vtx_cur i) = 0) ->
-  face_hyp_0 dL vtx_cur x -> p x = 0.
-Proof.
-intros dL kL vtx_cur p x Hvtx Hp1 Hp2 Hx.
-unfold face_hyp_0 in Hx.
- 
-(* TODO HM 27/07/23 : Bcp de travail ici : Faut TH0   
- ce n'est pas urgent pour l'article. *)
-
-Admitted.
-
-End FE_Lagrange_cur_Pk_d.
-
-(** FE LAGRANGE current *)
-Section FE_Lagrange_cur_Pk_d_fact.
-
-Variable dL kL : nat.
-
-Hypothesis dL_pos : (0 < dL)%coq_nat.
-
-Hypothesis kL_pos : (0 < kL)%coq_nat.
-
-Variable vtx_cur :'R^{dL.+1,dL}.
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-
-Lemma nnode_LagPk_d_pos : (0 < nnode_LagP dL kL)%coq_nat.
-Proof.
-apply ndof_nodal_pos.
-apply pbinomS_pos.
-Qed.
-
-Lemma Sigma_LagPk_d_cur_lin_map :
-  forall i,
-   is_linear_mapping (Sigma_LagPk_d_cur dL kL vtx_cur i). 
-Proof.
-intros; apply Sigma_nodal_lin_map.
-Qed.
-
-Definition FE_LagPk_d_cur :=
-  mk_FE dL (nnode_LagP dL kL) dL_pos nnode_LagPk_d_pos
-  shape_LagPk_d_is_Simplex 
-  vtx_cur (P_approx_k_d dL kL) (P_compat_fin_LagPk_d dL kL)
-  (Sigma_LagPk_d_cur dL kL vtx_cur)      
-  Sigma_LagPk_d_cur_lin_map  
-  (unisolvence_LagPk_d_cur dL kL vtx_cur dL_pos kL_pos Hvtx).
-
-End FE_Lagrange_cur_Pk_d_fact.
-
-Section FE_Lagrange_ref_Pk_d_fact.
-
-Variable dL kL : nat.
-
-Hypothesis dL_pos : (0 < dL)%coq_nat.
-
-Hypothesis kL_pos : (0 < kL)%coq_nat.
-
-Lemma unisolvence_LagPk_d_ref :
-  bijS (P_approx_k_d dL kL) fullset (gather (Sigma_LagPk_d_ref dL kL)).
-Proof.
-apply unisolvence_LagPk_d_cur; try easy.
-apply (vtx_simplex_ref_affine_ind dL kL kL_pos).
-Qed.
-
-Definition FE_LagPk_d_ref := 
-  FE_LagPk_d_cur dL kL dL_pos kL_pos (vtx_simplex_ref dL) 
-    (vtx_simplex_ref_affine_ind dL kL kL_pos).
-
-Lemma Sigma_L_ref_eq : 
-  Sigma FE_LagPk_d_ref = Sigma_LagPk_d_ref dL kL.
-Proof. easy. Qed.
-
-Lemma shape_Lag_ref : shape FE_LagPk_d_ref = Simplex.
-Proof. easy. Qed.
-
-Notation local_interp_LagPk_d_ref := 
-  (local_interp FE_LagPk_d_ref).
-
-Definition local_interp_LagPk_d_cur (vtx_cur :'R^{dL.+1,dL})
-  (Hvtx : affine_independent vtx_cur) :=
-  (local_interp (FE_LagPk_d_cur dL kL dL_pos kL_pos 
-  vtx_cur Hvtx)).
-
-Lemma FE_cur_eq : forall (vtx_cur :'R^{dL.+1,dL})
-  (Hvtx : affine_independent vtx_cur),
-  FE_LagPk_d_cur dL kL dL_pos kL_pos vtx_cur Hvtx = 
-    FE_cur FE_LagPk_d_ref shape_Lag_ref vtx_cur Hvtx.
-Proof.
-intros vtx_cur Hvtx.
-pose (fe1 := FE_LagPk_d_cur dL kL dL_pos kL_pos vtx_cur Hvtx); fold fe1.
-pose (fe2 := FE_cur FE_LagPk_d_ref shape_Lag_ref vtx_cur Hvtx); fold fe2.
-assert (Hd : d fe2 = d fe1) by easy.
-assert (Hn : ndof fe2 = ndof fe1) by easy.
-assert (Hs : shape fe2 = shape fe1) by easy.
-apply (FE_ext Hd Hn Hs); simpl.
-(* *)
-rewrite castT_comp_rr castT_id; easy.
-(* *)
-rewrite cast2F_fun_id; apply subset_ext_equiv; split; intros p Hp.
-(* . *)
-simpl; apply P_approx_k_d_compose_affine_mapping; try easy.
-apply T_geom_is_affine_mapping.
-(* . *)
-simpl in Hp.
-apply P_approx_k_d_affine_mapping_rev with (T_geom vtx_cur); try easy.
-apply T_geom_is_affine_mapping.
-apply T_geom_bijective; easy.
-(* *)
-rewrite castF_id cast2F_fun_id; apply extF; intros i.
-rewrite mapF_correct; apply fun_ext; intros p; simpl.
-unfold Sigma_LagPk_d_cur, Sigma_nodal, cur_to_ref; f_equal.
-rewrite T_geom_transports_nodes; easy.
-Qed.
-
-Lemma shape_fun_L_cur_eq : forall (vtx_cur :'R^{dL.+1,dL})
-  (Hvtx : affine_independent vtx_cur),
-  shape_fun (FE_LagPk_d_cur dL kL dL_pos kL_pos vtx_cur Hvtx) = 
-    shape_fun_cur FE_LagPk_d_ref shape_Lag_ref vtx_cur Hvtx.
-Proof.
-intros vtx_cur Hvtx.
-rewrite (shape_fun_ext (FE_cur_eq vtx_cur Hvtx)) castF_id castF_fun_id; easy.
-Qed.
-
-(* From Aide-memoire EF Alexandre Ern : Eq 3.37 p. 63 *)
-(* "Ip (v o T) = (Ip v) o T" *)
-Lemma local_interp_LagPk_d_comp :
-  forall (v : FRd dL) (vtx_cur :'R^{dL.+1,dL})
-  (Hvtx : affine_independent vtx_cur),
-  local_interp_LagPk_d_ref (fun x1 : 'R^dL => v (T_geom vtx_cur x1)) =
-   (fun x2 : 'R^dL => local_interp_LagPk_d_cur vtx_cur Hvtx
-         v (T_geom vtx_cur x2)).
-Proof.
-intros v vtx_cur Hvtx.
-unfold local_interp_LagPk_d_ref,
-local_interp_LagPk_d_cur, local_interp.
-apply fun_ext; intros x.
-rewrite 2!fct_comb_lin_r_eq.
-apply comb_lin_scalF_compat.
-simpl.
-unfold Sigma_LagPk_d_ref, Sigma_LagPk_d_cur, Sigma_nodal.
-unfold scalF, mapF, map2F.
-apply extF; intros i.
-f_equal.
-f_equal.
-apply T_geom_transports_nodes; easy.
-(* *)
-rewrite shape_fun_L_cur_eq.
-rewrite (shape_fun_cur_correct_rev FE_LagPk_d_ref _ vtx_cur); easy.
-Qed.
-
-
-
-
-End FE_Lagrange_ref_Pk_d_fact.
-
-(* Note du 4/7/23
- le cas k=0 ne repose pas sur les mêmes définitions
- il ne peut pas être traité de la même façon : ce n'est pas un EF de Lagrange car pas nodal
- En conséquence, on fera (SB: peut-être) une autre section concernant k=0
- avec autres déf mais les démonstrations devraient être similaires / plus simples 
-  => hypothèse k > 0 OU k.+1 
-  (à voir selon les énoncés pour éviter les castF et ne pas faire .+1 de façon inopinée)
-  Bref : on peut mettre .+1 dans un aux mais on préfère hypothèse > 0 pour le final
-*)
-
diff --git a/FEM/FE_new.v b/FEM/FE_new.v
deleted file mode 100644
index 1402dfa04cde0ce9439b188389414c292e5b4c01..0000000000000000000000000000000000000000
--- a/FEM/FE_new.v
+++ /dev/null
@@ -1,265 +0,0 @@
-(**
-This file is part of the Elfic 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.
-*)
-
-From FEM.Compl Require Import stdlib.
-
-Set Warnings "-notation-overridden".
-From FEM.Compl Require Import ssr.
-
-(* Next import provides Reals, Coquelicot.Hierarchy, functions to module spaces,
- and linear mappings. *)
-From LM Require Import linear_map lax_milgram.
-Set Warnings "notation-overridden".
-
-From Lebesgue Require Import Subset.
-
-From FEM Require Import Compl Algebra geometry poly_Lagrange_new.
-
-Local Open Scope R_scope.
-
-Section FE_Local_simplex1.
-
-Inductive shape_type :=  Simplex | Quad.
-
-Definition nvtx_of_shape (d : nat) (shape : shape_type) : nat :=
-  match shape with
-    | Simplex => d.+1
-    | Quad => 2^d
-  end.
-
-Lemma nos_eq :
-  forall {d1 d2 s1 s2},
-    d1 = d2 -> s1 = s2 -> nvtx_of_shape d1 s1 = nvtx_of_shape d2 s2.
-Proof. move=>>; apply f_equal2. Qed.
-
-(* TODO: add an admissibility property for the geometrical element?
-  Il manque peut-être des hypothèses géométriques 
-    du type triangle pas plat ou dim (span_as vertex) = d. 
-  Se mettre à l'interieur ou à l'exterieur de record FE + dans geometry.v aussi ?
-  Manque hyp géométrique ds le cas du Quad pour éviter les sabliers *)
-
-(** Livre Alexandre Ern: Def(4.1) P.75*)
-Record FE : Type := mk_FE {
-  d : nat ; (* space dimension eg 1, 2, 3 *)
-  ndof : nat ; (* nb of degrees of freedom - eg number of nodes for Lagrange. *)
-  d_pos :    (0 < d)%coq_nat ;
-  ndof_pos : (0 < ndof)%coq_nat ;
-  shape : shape_type ;
-  nvtx : nat := nvtx_of_shape d shape ; (* number of vertices *)
-  vtx : '('R^d)^nvtx ; (* vertices of geometrical element *)
-  K_geom : 'R^d -> Prop := convex_envelop vtx ; (* geometrical element *)
-  P_approx : FRd d -> Prop ; (* Subset of FRd *)
-  P_approx_has_dim : has_dim P_approx ndof ; (* Subspace of dimension ndof  *)
-  Sigma : '(FRd d -> R)^ndof ;
-  Sigma_lin_map : forall i, is_linear_mapping (Sigma i) ;
-  unisolvence : bijS P_approx fullset (gather Sigma) ;
-}.
-
-Lemma FE_ext :
-  forall {fe1 fe2 : FE} (Hd : d fe2 = d fe1)
-      (Hn : ndof fe2 = ndof fe1) (Hs : shape fe2 = shape fe1),
-    vtx fe1 = castT (nos_eq Hd Hs) Hd (vtx fe2) ->
-    P_approx fe1 = cast2F_fun Hd (P_approx fe2) ->
-    Sigma fe1 = castF Hn (mapF (cast2F_fun Hd) (Sigma fe2)) ->
-    fe1 = fe2.
-Proof.
-intros fe1 fe2 Hd Hn Hs; destruct fe1, fe2; simpl in *; subst.
-rewrite castT_id !cast2F_fun_id castF_id; intros; subst.
-f_equal; apply proof_irrel.
-Qed.
-
-Variable fe: FE.
-
-Lemma nvtx_pos : (0 < nvtx fe)%coq_nat.
-Proof.
-unfold nvtx, nvtx_of_shape; case shape.
-auto with arith.
-apply nat_compl.S_pow_pos; auto.
-Qed.
-
-Lemma shape_dec :
-  {shape fe = Simplex} + {shape fe = Quad}.
-Proof.
-case (shape fe); [left | right]; easy.
-Qed.
-
-Lemma nvtx_dec :
-  {nvtx fe = S (d fe)} + {nvtx fe = (2^(d fe))%nat }.
-Proof.
-unfold nvtx; case (shape fe); [left|right]; easy.
-Qed.
-
-Lemma nvtx_Simplex :
-  shape fe = Simplex -> nvtx fe = S (d fe).
-Proof.
-unfold nvtx; case (shape fe); auto.
-intros H; discriminate.
-Qed.
-
-Lemma nvtx_Quad :
-  shape fe = Quad -> nvtx fe = (2^d fe)%nat.
-Proof.
-unfold nvtx; case (shape fe); auto.
-intros H; discriminate.
-Qed.
-
-Definition is_local_shape_fun := 
-  fun (theta : '(FRd (d fe))^(ndof fe)) =>
-  (forall i : 'I_(ndof fe),  P_approx fe (theta i)) /\
-  (forall i j : 'I_(ndof fe), Sigma fe i (theta j) = kronecker i j).
-
-Lemma is_local_shape_fun_inj : forall theta1 theta2,
-  is_local_shape_fun theta1 -> is_local_shape_fun theta2 -> 
-    theta1 = theta2.
-(* injective is_local_shape_fun *)
-Proof.
-intros theta1 theta2 [H1 H1'] [H2 H2'].
-pose (PC:= (has_dim_compatible_ms (P_approx_has_dim fe))).
-generalize (lmS_bijS_sub_full_equiv _ (P_approx_has_dim fe) (ndof fe) has_dim_Rn
-    (proj1 (gather_is_linear_mapping_compat _) (Sigma_lin_map fe)) eq_refl); intros T.
-destruct T as [T1 _].
-fold PC in T1.
-specialize (T1 (unisolvence fe)).
-apply fun_ext; intros j.
-apply minus_zero_reg_sym.
-generalize (compatible_ms_minus PC _ _ (H2 j) (H1 j)); intros H.
-apply trans_eq with (val (mk_sub_ms_ PC H)); try easy.
-eapply trans_eq with (val zero); try easy.
-f_equal; apply T1. 
-simpl; unfold gather, swap; simpl.
-apply fun_ext; intros i.
-unfold minus; rewrite (proj1 (Sigma_lin_map fe i)).
-rewrite is_linear_mapping_opp.
-2: apply Sigma_lin_map.
-rewrite H1' H2'.
-rewrite plus_opp_r; easy.
-Qed.
-
-(* From Aide-memoire EF Alexandre Ern : Definition 4.1 p. 75-76 *)
-Definition shape_fun : '(FRd (d fe))^(ndof fe) := predual_basis (unisolvence fe).
-
-Lemma shape_fun_correct : is_local_shape_fun shape_fun.
-Proof.
-split.
-apply predual_basis_in_sub.
-intros; apply predual_basis_dualF.
-Qed.
-
-(* Useless!
-Lemma shape_fun_is_poly : forall i, P_approx fe (shape_fun i).
-Proof.
-apply shape_fun_correct.
-Qed.*)
-
-Lemma shape_fun_is_basis : is_basis (P_approx fe) shape_fun.
-Proof.
-apply predual_basis_is_basis.
-apply fe.
-apply (Sigma_lin_map fe).
-Qed.
-
-(* From Aide-memoire EF Alexandre Ern : Definition 4.4 p. 78 *)
-Definition local_interp : FRd (d fe) -> FRd (d fe) := 
-  fun v => comb_lin (fun i => Sigma fe i v) shape_fun.
-
-Lemma local_interp_is_poly : forall v : FRd (d fe),
-      (P_approx fe) (local_interp v).
-Proof.
-intros v; unfold local_interp.
-rewrite (proj1 shape_fun_is_basis); easy.
-Qed.
-
-Lemma local_interp_lin_map :
-    is_linear_mapping local_interp.
-Proof.
-split.
-(* *)
-intros v1 v2.
-unfold local_interp.
-rewrite -comb_lin_plus_l.
-apply comb_lin_ext_l; intros i.
-apply (Sigma_lin_map fe).
-(* *)
-intros v l.
-unfold local_interp.
-rewrite -comb_lin_scal_l.
-apply comb_lin_ext_l; intros i.
-apply (Sigma_lin_map fe).
-Qed.
-
-Lemma local_interp_shape_fun : forall i : 'I_(ndof fe), 
-  local_interp (shape_fun i) = shape_fun i.
-Proof.
-intros j.
-unfold local_interp.
-apply trans_eq with
-   (comb_lin (fun i : 'I_(ndof fe) => kronecker i j) shape_fun). 
-apply comb_lin_scalF_compat, extF; intros i.
-f_equal; apply extF; intro.
-apply shape_fun_correct.
-apply comb_lin_kronecker_in_l.
-Qed.
-
-(* From Aide-memoire EF Alexandre Ern : Definition (3.2, 4.4) p. 78 *)
-Lemma local_interp_proj : forall p : FRd (d fe),
-  (P_approx fe) p -> local_interp p = p.
-Proof.
-intros p Hp.
-rewrite (proj1 shape_fun_is_basis) in Hp.
-inversion Hp as [ L HL ].
-rewrite linear_mapping_comb_lin_compat.
-apply comb_lin_ext_r; intros i.
-apply local_interp_shape_fun.
-apply local_interp_lin_map.
-Qed.
-
-(* From Aide-memoire EF Alexandre Ern : Definition (3.2, 4.4) p. 78 *)
-Lemma local_interp_idem : forall v : FRd (d fe),
-  local_interp (local_interp v) = local_interp v.
-Proof.
-intros v; rewrite local_interp_proj; try easy.
-apply local_interp_is_poly; try easy.
-Qed.
-
-(* From Aide-memoire EF Alexandre Ern : p. 77 *)
-Lemma Sigma_local_interp : forall (i : 'I_(ndof fe)) 
-  (v : FRd (d fe)),
-    Sigma fe i (local_interp v) = Sigma fe i v.
-Proof.
-intros i v.
-unfold local_interp.
-rewrite linear_mapping_comb_lin_compat.
-apply trans_eq with 
-  (comb_lin (fun j => kronecker i j)(fun j => Sigma fe j v)).
-apply comb_lin_scalF_compat; rewrite scalF_comm_R.
-f_equal; apply extF; intro; apply shape_fun_correct.
-rewrite comb_lin_kronecker_in_r; easy.
-apply (Sigma_lin_map fe).
-Qed.
-
-End FE_Local_simplex1.
-
-
-Section FE_Local_simplex2.
-
-Lemma shape_fun_ext :
-  forall {fe1 fe2 : FE} (H : fe1 = fe2),
-    shape_fun fe1 =
-      castF (eq_sym (f_equal ndof H))
-        (mapF (castF_fun (eq_sym (f_equal d H))) (shape_fun fe2)).
-Proof. intros; subst; rewrite castF_id castF_fun_id; easy. Qed.
-
-End FE_Local_simplex2.
diff --git a/FEM/FE_simplex_new.v b/FEM/FE_simplex_new.v
deleted file mode 100644
index 79fd0dfa3faa2c6ed4fc43777dcdfa10819d00b2..0000000000000000000000000000000000000000
--- a/FEM/FE_simplex_new.v
+++ /dev/null
@@ -1,435 +0,0 @@
-(**
-This file is part of the Elfic 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.
-*)
-
-From FEM.Compl Require Import stdlib.
-
-Set Warnings "-notation-overridden".
-From FEM.Compl Require Import ssr.
-
-(* Next import provides Reals, Coquelicot.Hierarchy, functions to module spaces,
- and linear mappings. *)
-From LM Require Import linear_map.
-Set Warnings "notation-overridden".
-
-From Lebesgue Require Import Subset Function.
-
-From FEM Require Import Compl Algebra geometry poly_Lagrange_new FE_new.
-
-Local Open Scope R_scope.
-
-Section FE_Current_Simplex.
-
-(* Note du 30/11/23 :
-à un moment, prouver aff_ind vtx -> existe boule ouverte dans K 
- prouver pour elt de ref et en déduire avec Tgeom 
- isobarycenter 
- intérieur non vide devrait être dans le Record
-*)
-
-(* 20/12/23 : Extract definitions and lemmas that will be applied to both simplex and Quad. 
-  Do we need modules ? *)
-
-(** Construct a FE_current from a given FE_ref and given current vertices vtx_cur. *)
-
-Variable FE_ref : FE.
-
-(* Local Definition is useful ? *)
-Local Definition dd := d FE_ref.
-
-Local Definition nndof := ndof FE_ref.
-
-Local Definition dd_pos := d_pos FE_ref.
-
-Local Definition nndof_pos := ndof_pos FE_ref.
-
-Local Definition shape_ref := shape FE_ref.
-
-Hypothesis shape_ref_is_Simplex : shape_ref = Simplex.
-
-Local Definition P_approx_ref : FRd dd -> Prop := P_approx FE_ref.
-
-Local Definition P_approx_has_dim_ref := P_approx_has_dim FE_ref.
-
-Local Definition Sigma_ref : '(FRd dd -> R)^nndof := Sigma FE_ref.
-
-Local Definition Sigma_lin_map_ref := Sigma_lin_map FE_ref.
-
-Local Definition unisolvence_ref := unisolvence FE_ref.
-
-Local Definition shape_fun_ref : '(FRd dd)^nndof := shape_fun FE_ref.
-
-Local Definition local_interp_ref : FRd dd -> FRd dd := 
-  fun v => local_interp FE_ref v.
-
-Local Definition nnvtx :=  S dd.
-
-Lemma nnvtx_eq_S_dd : nvtx FE_ref = S dd.
-Proof.
-apply (nvtx_Simplex FE_ref shape_ref_is_Simplex).
-Qed.
-
-Local Definition vtx_ref : '('R^dd)^nnvtx := castF nnvtx_eq_S_dd (vtx FE_ref).
-
-Lemma P_approx_ref_zero : P_approx_ref zero.
-Proof.
-apply: compatible_ms_zero.
-apply: has_dim_compatible_ms.
-apply FE_ref.
-Qed.
-
-Local Definition K_geom_ref : 'R^dd -> Prop := convex_envelop vtx_ref.
-
-Lemma K_geom_ref_def_correct : K_geom_ref = K_geom FE_ref.
-Proof.
-apply eq_sym, (convex_envelop_castF nnvtx_eq_S_dd); easy.
-Qed.
-
-(* FE_ref is indeed a reference FE *)
-Hypothesis FE_ref_is_ref : forall j,
-  vtx_ref j = vtx_simplex_ref dd j.
-
-Variable vtx_cur : '('R^dd)^nnvtx.
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-
-Definition K_geom_cur := convex_envelop vtx_cur.
-
-(* From Aide-memoire EF Alexandre Ern : p. 79 *)
-Definition cur_to_ref : FRd dd -> FRd dd := 
-  fun v_cur x_ref => v_cur (T_geom vtx_cur x_ref).
-
-Definition ref_to_cur : FRd dd -> FRd dd := 
-  fun v_ref x_cur => v_ref (T_geom_inv vtx_cur x_cur).
-
-Definition P_approx_cur : FRd dd -> Prop := 
-  preimage cur_to_ref P_approx_ref.
-
-Lemma is_linear_mapping_cur_to_ref : is_linear_mapping cur_to_ref.
-Proof. easy. Qed.
-
-Lemma cur_to_ref_surj : forall v_ref,
-    exists v_cur, cur_to_ref v_cur = v_ref.
-Proof.
-intros v_ref.
-unfold cur_to_ref.
-exists (fun x_cur => v_ref (T_geom_inv vtx_cur x_cur)).
-apply fun_ext; intros x_ref.
-rewrite -T_geom_inv_comp; try easy.
-Qed.
-
-Lemma cur_to_ref_inj : forall v_ref2 v_ref1,
-  cur_to_ref v_ref2 = cur_to_ref v_ref1 ->
-    v_ref2 = v_ref1. 
-Proof.
-intros v_ref2 v_ref1 H1.
-apply fun_ext; intros x_cur.
-rewrite (T_geom_comp vtx_cur Hvtx x_cur).
-unfold cur_to_ref in H1.
-apply (fun_ext_rev H1 (T_geom_inv vtx_cur x_cur)).
-Qed.
-
-Lemma cur_to_ref_inj_aux : forall v_ref,
-  cur_to_ref v_ref = zero -> v_ref = zero. 
-Proof.
-intros v_ref H.
-apply fun_ext; intros x_cur.
-rewrite (T_geom_comp vtx_cur Hvtx x_cur).
-unfold cur_to_ref in H.
-apply (fun_ext_rev H (T_geom_inv vtx_cur x_cur)).
-Qed.
-
-Lemma cur_to_ref_comp : forall v_ref : FRd dd,
-    v_ref = cur_to_ref (ref_to_cur v_ref).
-Proof.
-intros v_ref.
-unfold ref_to_cur, cur_to_ref.
-apply fun_ext; intros x_ref.
-f_equal.
-apply T_geom_inv_comp; try easy.
-Qed.
-
-Lemma ref_to_cur_comp : forall v_cur : FRd dd,
-    v_cur = ref_to_cur (cur_to_ref v_cur).
-Proof.
-intros v_cur.
-unfold ref_to_cur, cur_to_ref.
-apply fun_ext; intros x_cur.
-f_equal.
-apply T_geom_comp; try easy.
-Qed.
-
-Lemma P_approx_cur_correct : forall v_ref : FRd dd,
-  P_approx_ref v_ref -> P_approx_cur (ref_to_cur v_ref).
-Proof.
-intros v_ref H.
-unfold P_approx_cur, preimage.
-rewrite -cur_to_ref_comp; easy.
-Qed.
-
-Lemma P_approx_ref_correct : forall v_cur : FRd dd,
-  P_approx_cur v_cur -> P_approx_ref (cur_to_ref v_cur).
-Proof.
-intros v_cur H.
-rewrite -> ref_to_cur_comp. 
-unfold P_approx_cur, preimage in H.
-rewrite -ref_to_cur_comp; try easy.
-Qed.
-
-Lemma cur_to_ref_bij :
-  bijS (preimage cur_to_ref P_approx_ref) P_approx_ref cur_to_ref.
-Proof.
-apply bijS_ex; try apply inhabited_ms.
-exists ref_to_cur; split.
-(* *)
-intros _ [v_cur H]; apply P_approx_ref_correct; easy.
-(* *)
-split.
-intros _ [v_ref H]; apply P_approx_cur_correct; easy.
-(* *)
-split.
-intros v_cur H; rewrite <- ref_to_cur_comp; easy.
-(* *)
-intros v_ref H; rewrite <- cur_to_ref_comp; easy.
-Qed.
-
-Lemma P_approx_cur_compatible : compatible_ms P_approx_cur.
-Proof.
-apply compatible_ms_preimage.
-apply is_linear_mapping_cur_to_ref.
-apply (has_dim_compatible_ms (P_approx_has_dim FE_ref)).
-Qed.
-
-Lemma P_approx_cur_compat_fin : has_dim P_approx_cur nndof.
-Proof.
-assert (H : image cur_to_ref (preimage cur_to_ref P_approx_ref) = P_approx_ref).
-rewrite image_of_preimage.
-apply inter_left.
-intros v_ref Hv_ref.
-rewrite (cur_to_ref_comp v_ref); apply Im; easy.
-(* *)
-unfold P_approx_cur.
-apply (Dim (preimage cur_to_ref P_approx_ref) nndof (fun i :'I_nndof => 
-      ref_to_cur (shape_fun_ref i))).
-rewrite (is_linear_mapping_is_basis_compat_equiv cur_to_ref); try easy.
-(* *)
-rewrite H.
-replace (fun i => cur_to_ref _) with shape_fun_ref.
-apply shape_fun_is_basis.
-apply fun_ext; intro; apply cur_to_ref_comp.
-(* *)
-apply P_approx_cur_compatible.
-(* *)
-rewrite H; apply cur_to_ref_bij.
-(* *)
-intros i.
-apply P_approx_cur_correct.
-unfold P_approx_ref; rewrite (proj1 (shape_fun_is_basis FE_ref)).
-rewrite -comb_lin_kronecker_in_r; easy.
-Qed.
-
-Definition Sigma_cur : '(FRd dd -> R)^(nndof) := 
-  fun i (p : FRd dd) => Sigma_ref i (cur_to_ref p).
-
-Lemma Sigma_cur_lin_map : forall i : 'I_(nndof), 
-  is_linear_mapping (Sigma_cur i).
-Proof.
-intros i.
-unfold is_linear_mapping; split; intros y; unfold Sigma_cur.
-intros z; apply Sigma_lin_map; easy.
-apply Sigma_lin_map; easy.
-Qed.
-
-Lemma unisolvence_cur : 
-  bijS P_approx_cur fullset (gather Sigma_cur).
-Proof.
-assert (K: compatible_ms P_approx_ref).
-eapply has_dim_compatible_ms; apply FE_ref.
-apply (lmS_bijS_sub_full_equiv _ P_approx_cur_compat_fin _ has_dim_Rn
-    (proj1 (gather_is_linear_mapping_compat _) Sigma_cur_lin_map) eq_refl).
-pose (PC:= (has_dim_compatible_ms P_approx_cur_compat_fin)); fold PC.
-pose (PR:= (has_dim_compatible_ms (P_approx_has_dim FE_ref))).
-(* *)
-intros [q Hq] H1; simpl in H1.
-apply val_inj, cur_to_ref_inj_aux; try easy; simpl.
-specialize (P_approx_ref_correct q Hq); try easy; intros H2.
-apply trans_eq with (val (mk_sub_ms_ PR H2)); try easy.
-apply trans_eq with (val (sub_zero (compatible_g_m (compatible_ms_g PR)))); try easy; f_equal.
-apply (lmS_bijS_sub_full_equiv _ P_approx_has_dim_ref _ has_dim_Rn
-    (proj1 (gather_is_linear_mapping_compat _) Sigma_lin_map_ref) eq_refl).
-apply unisolvence_ref; try easy.
-simpl; unfold gather, swap; simpl; easy.
-Qed.
-
-Definition FE_cur :=
-  mk_FE dd nndof dd_pos nndof_pos shape_ref
-  (castF (eq_sym nnvtx_eq_S_dd) vtx_cur)
-  P_approx_cur P_approx_cur_compat_fin Sigma_cur
-  Sigma_cur_lin_map unisolvence_cur.
-
-Definition d_cur := d FE_cur.
-
-Definition ndof_cur := ndof FE_cur.
-
-Definition shape_fun_cur : '(FRd d_cur)^ndof_cur := shape_fun FE_cur.
-
-Lemma nvtx_cur_eq : nvtx FE_cur = dd.+1.
-Proof.
-apply nvtx_Simplex.
-unfold FE_cur; easy.
-Qed.
-
-Lemma K_geom_cur_def_correct : K_geom_cur = K_geom FE_cur.
-Proof.
-apply (convex_envelop_castF (eq_sym nnvtx_eq_S_dd)); easy.
-Qed.
-
-Lemma P_approx_ref_image : 
-  image ref_to_cur P_approx_ref = P_approx_cur.
-Proof.
-rewrite image_eq.
-unfold image_ex.
-apply fun_ext; intros x_cur.
-apply prop_ext.
-split.
-(* *)
-intros [x_ref [Hx1 Hx2]].
-rewrite Hx2.
-apply P_approx_cur_correct; easy.
-(* *)
-intros H.
-exists (cur_to_ref x_cur).
-split.
-apply P_approx_ref_correct; easy.
-apply ref_to_cur_comp; easy. 
-Qed.
-
-Lemma P_approx_cur_image : 
-  image cur_to_ref P_approx_cur = P_approx_ref.
-Proof.
-rewrite image_eq.
-unfold image_ex.
-apply fun_ext; intros x_ref.
-apply prop_ext.
-split.
-(* *)
-intros [x_cur [Hx1 Hx2]].
-rewrite Hx2.
-apply P_approx_ref_correct; easy.
-(* *)
-intros H.
-exists (ref_to_cur x_ref).
-split.
-apply P_approx_cur_correct; easy.
-apply cur_to_ref_comp; easy. 
-Qed.
-
-Lemma cur_to_ref_bijS_spec :
-  bijS_spec P_approx_ref P_approx_cur ref_to_cur cur_to_ref.
-Proof.
-repeat split.
-intros _ [x_ref H1]; apply P_approx_cur_correct; easy.
-(* *)
-intros _ [x_cur H1]; apply P_approx_ref_correct; easy.
-(* *)
-intros x_ref H1; rewrite -cur_to_ref_comp; easy.
-(* *)
-intros x_ref H1; rewrite -ref_to_cur_comp; easy.
-Qed.
-
-
-Lemma shape_fun_cur_correct : forall i : 'I_(ndof FE_ref), 
-  shape_fun_cur i = ref_to_cur (shape_fun_ref i).
-Proof.
-intros i.
-apply cur_to_ref_inj.
-rewrite -cur_to_ref_comp.
-apply eq_sym.
-unfold cur_to_ref, shape_fun_cur, shape_fun_ref.
-apply fun_ext; intros x_ref.
-rewrite -> (is_local_shape_fun_inj (FE_ref) _
-  ( fun i x_ref => shape_fun FE_cur i (T_geom vtx_cur x_ref))); try easy.
-apply shape_fun_correct.
-(* *)
-clear i x_ref.
-generalize (shape_fun_correct FE_cur); intros [H1 H2].
-unfold FE_cur at 1 in H1; simpl in H1. 
-split.
-apply H1.
-(* *)
-unfold FE_cur at 1 in H2; simpl in H2. 
-unfold Sigma_cur in H2.
-apply H2. 
-Qed.
-
-Lemma shape_fun_cur_correct_rev : forall i : 'I_(ndof FE_cur), 
-  shape_fun FE_ref i = cur_to_ref (shape_fun_cur i).
-Proof.
-intros i; rewrite shape_fun_cur_correct.
-apply cur_to_ref_comp. 
-Qed.
-
-
-Definition local_interp_cur : FRd d_cur -> FRd d_cur := 
-  fun v => local_interp FE_cur v.
-
-(* From Aide-memoire EF Alexandre Ern : Eq 4.13 p. 79-80 *)
-Lemma local_interp_cur_ref : forall v : FRd dd,
-  local_interp_ref (cur_to_ref v) = 
-    cur_to_ref (local_interp_cur v).
-Proof.
-intros v.
-unfold local_interp_ref, local_interp_cur, local_interp.
-rewrite linear_mapping_comb_lin_compat; try easy.
-apply comb_lin_scalF_compat, extF; intro; f_equal.
-apply extF; intro; apply shape_fun_cur_correct_rev.
-Qed.
-
-End FE_Current_Simplex.
-
-(** FE QUAD *)
-(* 
-Section FE_Current_Quad.
-
-Roughly needs to duplicate previous section and replace "P1" by "Q1"...
-
-End FE_Current_Quad.
-*)
-
-Section FE_Nodal.
-
-Variable dn : nat.
-
-Variable nnodes : nat.
-
-Hypothesis nnodes_pos : (0 < nnodes)%coq_nat.
-
-Variable nodes : '('R^dn)^nnodes.
-
-Definition ndof_nodal := nnodes.
-
-Lemma ndof_nodal_pos : (0 < ndof_nodal)%coq_nat.
-Proof. easy. Qed.
-
-Definition Sigma_nodal : '(FRd dn -> R)^ndof_nodal := 
-  fun i (p : FRd dn) => p (nodes i).
-
-Lemma Sigma_nodal_lin_map : forall i : 'I_ndof_nodal,
-   is_linear_mapping (Sigma_nodal i).
-Proof.
-intros; apply is_linear_mapping_pt_eval.
-Qed.
-
-End FE_Nodal.
diff --git a/FEM/P_approx_k_new.v b/FEM/P_approx_k_new.v
deleted file mode 100644
index a7843dd7bd221942905e7d90086d31a76550fa4f..0000000000000000000000000000000000000000
--- a/FEM/P_approx_k_new.v
+++ /dev/null
@@ -1,2049 +0,0 @@
-(**
-This file is part of the Elfic 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.
-*)
-
-From FEM.Compl Require Import stdlib.
-
-Set Warnings "-notation-overridden".
-From FEM.Compl Require Import ssr.
-
-(* Next import provides Reals, Coquelicot.Hierarchy, functions to module spaces,
- and linear mappings. *)
-From LM Require Import linear_map.
-Set Warnings "notation-overridden".
-
-From Lebesgue Require Import Subset Function.
-
-From FEM Require Import Compl Algebra binomial_compl MonoidMult.
-From FEM Require Import monomial multi_index_new poly_Lagrange_new.
-
-
-(** "For simplices (Pk in dim d)", with x = (x_i)_{i=1..d}:
-
-  Pk,d = span ( x1^alpha_1 . x1^alpha_1...xd^alpha_d )
-       such that 0 <= alpha_1...alpha_d <= k /\ sum \alpha_i <= k
-
-   p  = comb_lin L x_i^(alpha_i) \in Pk,d *)
-
-(** "For simplices (P1 in dim d)", with x = (x_i)_{i=1..d}:
-   P1,d = span <1,x1,...,xd> = span LagP1_d_ref
-
-    p = comb_lin L x \in P1,d *)
-
-Local Open Scope R_scope.
-
-
-Section P_approx_k_d_Def.
-
-(* on a une déf des multinômes
-   on a pas explicitement de déf de degré ; 
-   on a presque que c'est tous les multinômes de degré <= k
-   on n'a pas de différentielle
-   on n'a pas que c'est toutes les fns dont la k+1-ème différentielle est nulle
-   on a que c'est un EV de dimension finie
-   on aura que c'est de dimension dim_Pk_d
-   on veut l'ordre gravlax (~~)
-*)
-
-(* multinomial
-   on a EV, on a de dimension finie (mais majorée nettement)
-   on a la formal derivative
-   ordre sur multi-indices, mais pas exactement celui qu'on veut 
-   vect_n_k
-  https://github.com/math-comp/Coq-Combi/blob/master/theories/Combi/vectNK.v
-*)
-
-(*
-ON VEUT
-  un EV de dimension dim_Pk
-  le degré
-  ce sont ttes les fonctions d degré <= k
-  dérivée formelle
-  ce sont ttes les fonctions de différentielle (k+1)eme nulle
-  formule de Taylor : x, x_0 \in R^d
-    p(x) = p(x_0) + Dp(x_0) (x-x_0) + D^2p(x_0) (x-x_0,x-x_0) + ...
-  Dp(x_0) est une matrice / une appli linéaire
-      = \sum_{alpha , vecteur de somme 1} d^alpha p(x_0) 
-      = \delta p / \delta x_1 ++ \delta_p / \delta x_2 ++ ... d
-*)
-
-(* Basis_Pk_d est une base de P_approx_k_d, c'est-à-dire une famille de fonctions. *)
-
-(* TODO MM (11/04/2023) : Pour la defintion de Basis_Pk_d, essayer de comprendre les multinomes de Florent Hivert. *)
-(** "Livre Vincent Definition 1593 - p30." *)
-Definition Basis_Pk_d d k : '(FRd d)^((pbinom d k).+1) :=
-  fun (ipk : 'I_((pbinom d k).+1)) (x : 'R^d) =>
-    f_mono x (A_d_k d k ipk).
-
-(** "Livre Vincent Definition 1594 - p31." *)
-Definition P_approx_k_d d k : FRd d -> Prop := span (Basis_Pk_d d k).
-
-(** "Livre Vincent Lemma 1596 - p31." *)
-Definition P_approx_1_d d : FRd d -> Prop := P_approx_k_d d 1.
-
-(** "Livre Vincent Definition 1545 - p19." *)
-Definition P_approx_k_1 k : FRd 1 -> Prop := P_approx_k_d 1 k.
-
-(** "Livre Vincent Lemma 1597 - p31." *)
-Lemma P_approx_k_d_compatible : forall d k,
-  compatible_ms (P_approx_k_d d k).
-Proof.
-intros.
-apply span_compatible_ms.
-Qed.
-
-Definition Pkd := fun d k => sub_ms (P_approx_k_d_compatible d k).
-
-
-End P_approx_k_d_Def.
-
-Section Pkd_mult.
-
-Lemma P_approx_k_d_ext : forall {d} k p q,
-     (forall x, p x = q x) ->
-    P_approx_k_d d k p -> P_approx_k_d d k q.
-Proof.
-intros d k p q H1 H2.
-replace q with p; try easy.
-apply fun_ext; easy.
-Qed.
-
-Lemma P_approx_k_d_comb_lin :  forall {d} {n} k p,
-   (forall i, P_approx_k_d d k (p i)) ->
-       forall (L:'R^n), P_approx_k_d d k (comb_lin L p).
-Proof.
-intros d n k p H L.
-apply span_comb_lin_closed; easy.
-Qed.
-
-Lemma P_approx_k_d_f_mono : forall d k ipk,
-  P_approx_k_d d k (fun x => f_mono x (A_d_k d k ipk)).
-Proof.
-intros d k ipk; apply span_ex.
-exists (itemF _ 1 ipk).
-rewrite comb_lin_itemF_l.
-rewrite scal_one; easy.
-Qed.
-
-Lemma Basis_Pk_0 : forall k,
-   Basis_Pk_d O k = fun _ _ => 1.
-Proof.
-intros k; unfold Basis_Pk_d.
-apply extF; intros i; rewrite A_0_k_eq.
-apply fun_ext; intros x; unfold f_mono, prod_R.
-rewrite sum_nil; easy.
-Qed.
-
-Lemma P_approx_0_k_eq : forall k p,
-    P_approx_k_d 0 k p.
-Proof.
-intros k p; unfold P_approx_k_d.
-rewrite Basis_Pk_0.
-apply span_ex.
-exists (fun _ => p zero).
-apply fun_ext; intros x.
-rewrite fct_comb_lin_r_eq.
-rewrite comb_lin_ones_r.
-assert (T: (S (pbinom O k)) = S O).
-apply pbinomS_0_l.
-rewrite -(sum_castF T).
-rewrite sum_singleF.
-apply f_equal.
-apply fun_ext; intros i; exfalso; apply I_0_is_empty; apply (inhabits i).
-Qed.
-
-Lemma P_approx_k_d_monotone_S : forall {d} k p, 
-    P_approx_k_d d k p ->  P_approx_k_d d k.+1 p.
-Proof.
-intros d; case d.
-intros k p Hp.
-apply P_approx_0_k_eq.
-clear d; intros d k p H.
-inversion H as [L HL].
-apply span_ex.
-exists (castF (A_d_Sk_eq_aux d k) (concatF L zero)).
-unfold Basis_Pk_d.
-rewrite A_d_Sk_eq.
-rewrite (comb_lin_ext_r _ _ 
-((castF (A_d_Sk_eq_aux d k)
-    (concatF (fun ipk : 'I_(pbinom d.+1 k).+1 =>
-               f_mono^~ (A_d_k d.+1 k ipk))
-        (fun ipk => f_mono^~(C_d_k d.+1 k.+1 ipk)))))).
-rewrite comb_lin_castF.
-rewrite (comb_lin_concatF_zero_lr L); easy.
-intros i; unfold castF; unfold concatF.
-simpl (nat_of_ord (cast_ord _ i)).
-case (lt_dec _ _); intros Hi; easy.
-Qed.
-
-Lemma P_approx_k_d_monotone : forall {d} k1 k2 p, 
-     (k1 <= k2)%coq_nat ->
-    P_approx_k_d d k1 p ->  P_approx_k_d d k2 p.
-Proof.
-intros d k1 k2 p Hk H.
-pose (t:= (k2-k1)%coq_nat).
-assert (Ht: (k2 = k1 + t)%coq_nat) by auto with zarith.
-rewrite Ht.
-clear Hk Ht; generalize t; clear t k2.
-induction t.
-now rewrite Nat.add_0_r.
-replace (k1+t.+1)%coq_nat with ((k1+t)%coq_nat.+1)%coq_nat.
-2: now auto with zarith.
-now apply P_approx_k_d_monotone_S.
-Qed.
-
-Lemma Basis_P0_k : forall d,
-   Basis_Pk_d d 0 = fun _ _ => 1.
-Proof.
-intros d; case d; unfold Basis_Pk_d.
-rewrite A_0_k_eq; apply extF; intros i; apply fun_ext; intros x.
-apply f_mono_zero_ext_r; easy.
-clear d; intros d; apply extF; intros i.
-unfold A_d_k; rewrite concatnF_one.
-apply fun_ext; intros x.
-rewrite C_d_0_eq; unfold castF; simpl.
-apply f_mono_zero_ext_r; try easy.
-apply (inhabits zero).
-Qed.
-
-Lemma P_approx_d_0_eq : forall {d} (p:FRd d), 
-    P_approx_k_d d 0 p <-> p = fun _ => p zero.
-Proof.
-intros d p; unfold P_approx_k_d.
-rewrite Basis_P0_k; split; intros H.
-inversion H as [L HL].
-apply fun_ext; intros x.
-now repeat rewrite fct_comb_lin_r_eq.
-apply span_ex.
-exists (fun _ => p zero).
-rewrite H.
-apply fun_ext; intros x.
-rewrite fct_comb_lin_r_eq.
-rewrite comb_lin_ones_r.
-assert (T: (S (pbinom d 0)) = S O).
-apply pbinomS_0_r.
-rewrite -(sum_castF T).
-now rewrite sum_singleF.
-Qed.
-
-Lemma P_approx_Sk_split_aux1 : forall {d n} k (p :'I_n -> FRd d.+1) L,
-    (forall i, exists p0, exists p1,
-      P_approx_k_d d k.+1 p0 /\ P_approx_k_d d.+1 k p1 /\
-      p i = fun x:'R^d.+1 => p0 (widenF_S x) + x ord_max * p1 x) ->
-   exists p0, exists p1,
-      P_approx_k_d d k.+1 p0 /\ P_approx_k_d d.+1 k p1 /\
-      comb_lin L p = fun x:'R^d.+1 => p0 (widenF_S x) + x ord_max * p1 x.
-Proof.
-intros d n k p L H.
-apply choice in H; destruct H as (p0,H).
-apply choice in H; destruct H as (p1,H).
-exists (comb_lin L p0); exists (comb_lin L p1); split.
-apply P_approx_k_d_comb_lin; apply H.
-split.
-apply P_approx_k_d_comb_lin; apply H.
-apply fun_ext; intros x.
-rewrite 3!fct_comb_lin_r_eq.
-replace (_ + _) with (comb_lin L (p0^~ (widenF_S x)) +
-    scal (x ord_max) (comb_lin L ((p1^~ x))))%M; try easy.
-rewrite -comb_lin_scal_r -comb_lin_plus_r.
-apply comb_lin_ext_r.
-intros i; rewrite (proj2 (proj2 (H i))); easy.
-Qed.
-
-Lemma P_approx_Sk_split_aux2 : forall {d} k 
-  (i : 'I_(pbinom d.+1 k.+1).+1),
-exists (p0 : FRd d) (p1 : FRd d.+1),
-  P_approx_k_d d k.+1 p0 /\
-  P_approx_k_d d.+1 k p1 /\
-  f_mono^~ (A_d_k d.+1 k.+1 i) =
-  (fun x : 'R^d.+1 =>
-   p0 (widenF_S x) + x ord_max * p1 x).
-Proof.
-intros d k i.
-case (Nat.eq_dec (A_d_k d.+1 k.+1 i ord_max) O); intros H.
-(* monôme sans ord_max *)
-pose (j:= A_d_k_inv d k.+1 (widenF_S (A_d_k d.+1 k.+1 i))).
-exists (f_mono^~ (A_d_k d k.+1 j)).
-exists (fun _ => 0).
-split; try split.
-apply P_approx_k_d_f_mono.
-apply P_approx_k_d_monotone with O; auto with arith.
-apply P_approx_d_0_eq; easy.
-apply fun_ext; intros x.
-rewrite Rmult_0_r Rplus_0_r.
-unfold j; rewrite A_d_k_inv_correct_r.
-rewrite {1}(concatF_splitF_Sp1 x).
-rewrite {1}(concatF_splitF_Sp1 (A_d_k d.+1 k.+1 i)).
-rewrite f_mono_castF f_mono_concatF H.
-rewrite (f_mono_zero_ext_r (singleF _)).
-rewrite Rmult_1_r; easy.
-intros l; rewrite singleF_0; easy.
-apply Nat.add_le_mono_r with (A_d_k d.+1 k.+1 i ord_max).
-replace (_ + _)%coq_nat with
-    (sum (widenF_S (A_d_k d.+1 k.+1 i)) + A_d_k d.+1 k.+1 i ord_max)%M; try easy.
-replace (k.+1 + _)%coq_nat with (k.+1 + A_d_k d.+1 k.+1 i ord_max)%M; try easy.
-rewrite -sum_ind_r H plus_zero_r; apply A_d_k_sum.
-(* monôme avec ord_max *)
-exists (fun _ => 0).
-pose (j:=A_d_k_inv d.+1 k 
-        (replaceF (A_d_k d.+1 k.+1 i)
-                  (A_d_k d.+1 k.+1 i ord_max).-1 ord_max)).
-exists (f_mono^~ (A_d_k d.+1 k j)).
-split; try split.
-apply P_approx_k_d_monotone with O; auto with arith.
-apply P_approx_d_0_eq; easy.
-apply P_approx_k_d_f_mono.
-apply fun_ext; intros x.
-rewrite Rplus_0_l.
-case (Req_dec (x ord_max) 0); intros Hz.
-(* . *)
-rewrite Hz Rmult_0_l.
-apply f_mono_zero_compat.
-exists ord_max.
-rewrite powF_correct.
-rewrite Hz pow_i; auto with zarith.
-(* . *)
-unfold j; rewrite A_d_k_inv_correct_r.
-apply Rmult_eq_reg_l with ((x ord_max)^(A_d_k d.+1 k.+1 i ord_max).-1).
-rewrite -Rmult_assoc.
-rewrite -{3}(pow_1 (x ord_max)) -Rdef_pow_add.
-rewrite Nat.add_1_r Nat.succ_pred_pos; auto with zarith.
-rewrite fmono_replaceF_r; easy.
-apply pow_nonzero; easy.
-apply Nat.add_le_mono_l with (A_d_k d.+1 k.+1 i ord_max).
-replace (_ + _)%coq_nat with (A_d_k d.+1 k.+1 i ord_max +
-  sum (replaceF (A_d_k d.+1 k.+1 i) (A_d_k d.+1 k.+1 i ord_max).-1
-       ord_max))%M; try easy.
-rewrite sum_replaceF.
-replace (_ + _)%M with
-   ((A_d_k d.+1 k.+1 i ord_max).-1 + sum (A_d_k d.+1 k.+1 i))%coq_nat; try easy.
-generalize (A_d_k_sum d.+1 k.+1 i); lia.
-Qed.
-
-Lemma P_approx_Sk_split : forall {d} k (p:FRd d.+1),
-   P_approx_k_d d.+1 k.+1 p ->
-    exists p0, exists p1,
-      P_approx_k_d d k.+1 p0 /\ P_approx_k_d d.+1 k p1 /\
-      p = fun x:'R^d.+1 => p0 (widenF_S x) + x ord_max * p1 x.
-Proof.
-intros d k p H.
-inversion H as (L,HL).
-apply P_approx_Sk_split_aux1.
-intros i; unfold Basis_Pk_d.
-apply P_approx_Sk_split_aux2.
-Qed.
-
-Lemma P_approx_k_d_mult_const : forall {d} k (p q:FRd d),
-    P_approx_k_d d k p ->
-    (q = fun _ => q zero) ->
-    P_approx_k_d d k (p*q)%K.
-Proof.
-intros d k p q H1 H2.
-replace (p*q)%K with (scal (q zero) p).
-apply span_scal_closed; easy.
-apply fun_ext; intros x; rewrite H2; simpl.
-unfold mult; simpl; unfold fct_mult; simpl.
-unfold scal; simpl; unfold fct_scal; simpl.
-unfold scal; simpl; unfold mult; simpl.
-rewrite Rmult_comm; easy.
-Qed.
-
-Lemma P_approx_k_d_mul_var : forall {d} k (p:FRd d.+1) i,
-   P_approx_k_d d.+1 k p ->
-     P_approx_k_d d.+1 k.+1 (fun x => (x i) * p x).
-Proof.
-intros d k p i H; inversion H.
-apply P_approx_k_d_ext with
-   (comb_lin L (fun j x => x i * Basis_Pk_d d.+1 k j x)).
-intros x.
-apply trans_eq with (scal (x i) (comb_lin L (Basis_Pk_d d.+1 k) x)); try easy.
-rewrite fct_comb_lin_r_eq.
-rewrite comb_lin_scal_r.
-f_equal; now rewrite fct_comb_lin_r_eq.
-(* *)
-apply P_approx_k_d_comb_lin.
-intros j; unfold Basis_Pk_d.
-apply P_approx_k_d_ext with
-   (fun x => f_mono x (A_d_k d.+1 k.+1
-             (A_d_k_inv d.+1 k.+1 
-                 (replaceF (A_d_k d.+1 k j)  (A_d_k d.+1 k j i).+1%coq_nat i)))).
-2: apply P_approx_k_d_f_mono.
-intros x; rewrite A_d_k_inv_correct_r.
-case (Req_dec (x i) 0); intros Hxi.
-rewrite Hxi; rewrite Rmult_0_l.
-apply f_mono_zero_compat.
-exists i; unfold powF, map2F; rewrite Hxi.
-rewrite pow_ne_zero; try easy.
-rewrite replaceF_correct_l; auto with arith.
-apply Rmult_eq_reg_l with ((x i)^((A_d_k d.+1 k j i))).
-rewrite fmono_replaceF_r.
-rewrite -tech_pow_Rmult; ring.
-apply pow_nonzero; easy.
-(* *)
-apply Nat.add_le_mono_l with (A_d_k d.+1 k j i).
-replace (_ + _)%coq_nat with
-   (A_d_k d.+1 k j i +
-  sum (replaceF (A_d_k d.+1 k j) (A_d_k d.+1 k j i).+1 i))%M; try easy.
-rewrite sum_replaceF.
-replace (_ + _)%M with ((A_d_k d.+1 k j i).+1 + sum (A_d_k d.+1 k j))%coq_nat; try easy.
-generalize (A_d_k_sum d.+1 k j); lia.
-Qed.
-
-Lemma P_approx_k_d_widen :  forall {d} k (p:FRd d), (* used *)
-   P_approx_k_d d k p ->
-     P_approx_k_d d.+1 k (fun x => p (widenF_S x)).
-Proof.
-intros d k p H; inversion H.
-apply P_approx_k_d_ext with
-   (comb_lin L (fun i x => Basis_Pk_d d k i (widenF_S x))).
-intros x.
-now rewrite 2!fct_comb_lin_r_eq.
-apply P_approx_k_d_comb_lin.
-intros i; unfold Basis_Pk_d.
-apply P_approx_k_d_ext with
-   (fun x => f_mono x (A_d_k d.+1 k
-             (A_d_k_inv d.+1 k
-                 (castF (Nat.add_1_r d) (concatF (A_d_k d k i) (singleF zero)))))).
-2: apply P_approx_k_d_f_mono.
-intros x; rewrite A_d_k_inv_correct_r.
-assert (T: x = (castF (Nat.add_1_r d)
-          (concatF (widenF_S x) (singleF (x ord_max))))).
-rewrite concatF_splitF_Sp1'.
-apply extF; intros j; unfold castF, castF_Sp1, castF.
-f_equal; apply ord_inj; easy.
-rewrite {1}T.
-rewrite f_mono_castF.
-rewrite f_mono_concatF.
-rewrite (f_mono_zero_ext_r (singleF _)); try ring.
-intros j; apply singleF_0.
-(* *)
-rewrite sum_castF sum_concatF.
-rewrite sum_singleF plus_zero_r.
-apply A_d_k_sum.
-Qed.
-
-Lemma P_approx_k_d_mult_le : forall {d} n k l p q,
-    P_approx_k_d d k p ->  P_approx_k_d d l q
-    -> (k+l <= n)%coq_nat
-     ->   P_approx_k_d d n (p*q)%K.
-Proof.
-intros d n ; apply nat2_ind_strong with
-   (P:= fun d n => forall k l p q,
-    P_approx_k_d d k p ->  P_approx_k_d d l q
-    -> (k+l <= n)%coq_nat
-     ->   P_approx_k_d d n (p*q)%K); clear d n.
-(* d=0 *)
-intros d; case d.
-intros n Hrec k l p q H1 H2 H3.
-apply P_approx_0_k_eq.
-clear d; intros d n Hrec k.
-case k; clear k.
-(* k=0 *)
-clear; intros l p q H1 H2 H3.
-apply P_approx_k_d_monotone with l; auto with arith.
-replace (p*q)%K with (q*p)%K.
-apply P_approx_k_d_mult_const; try easy.
-apply P_approx_d_0_eq; easy.
-apply fun_ext; intros x.
-unfold mult; simpl; unfold fct_mult; simpl.
-unfold mult; simpl; auto with real.
-intros k l.
-case l; clear l.
-(* l=0 *)
-clear; intros p q H1 H2 H3.
-apply P_approx_k_d_monotone with k.+1.
-apply Nat.le_trans with (2:=H3).
-auto with arith.
-apply P_approx_k_d_mult_const; try easy.
-apply P_approx_d_0_eq; easy.
-(* d.+1 k.+1 l.+1 *)
-intros l p q Hp Hq Hn.
-assert (Hn2: (1 < n)%coq_nat).
-apply Nat.lt_le_trans with (2:=Hn).
-case k; case l; auto with arith.
-destruct (P_approx_Sk_split _ p Hp) as (p1,(p2,(Yp1,(Yp2,Yp3)))).
-destruct (P_approx_Sk_split _ q Hq) as (q1,(q2,(Yq1,(Yq2,Yq3)))).
-replace (p*q)%K with
-     ((fun x => (p1*q1)%K (widenF_S x)) 
-     + (fun x => x ord_max * (p1 (widenF_S x) * q2 x + p2 x * q1 (widenF_S x)))
-     + (fun x => x ord_max * (x ord_max * (p2*q2)%K x)))%M.
-repeat apply: span_plus_closed.
-(* . p1 q1 *)
-apply P_approx_k_d_widen.
-apply: (Hrec d n _ _ _ k.+1 l.+1); auto with arith.
-(* . *)
-replace n with ((n.-1).+1) by auto with zarith.
-apply P_approx_k_d_mul_var.
-apply: span_plus_closed.
-(* . p1 q2*)
-apply: (Hrec d.+1 n.-1 _ _ _ k.+1 l); auto with arith.
-apply P_approx_k_d_widen; easy.
-apply le_S_n; apply Nat.le_trans with n; auto with zarith.
-apply Nat.le_trans with (2:=Hn); auto with arith.
-(* . p2 q1*)
-apply: (Hrec d.+1 n.-1 _ _ _ k l.+1); auto with arith.
-apply P_approx_k_d_widen; easy.
-apply le_S_n; apply Nat.le_trans with n; auto with zarith.
-(* . p2 * q2 *)
-replace n with ((n.-2).+2) by auto with zarith.
-apply P_approx_k_d_mul_var.
-apply P_approx_k_d_mul_var.
-apply: (Hrec d.+1 n.-2 _ _ _ k l); auto with zarith arith.
-apply le_S_n, le_S_n; apply Nat.le_trans with n; auto with zarith.
-apply Nat.le_trans with (2:=Hn); apply PeanoNat.Nat.eq_le_incl.
-rewrite -PeanoNat.Nat.add_succ_r; auto with zarith arith.
-(* *)
-apply fun_ext; intros x; unfold plus, mult; simpl.
-unfold fct_plus, fct_mult; simpl.
-unfold mult; simpl; unfold plus; simpl.
-rewrite Yp3 Yq3; ring.
-Qed.
-
-Lemma P_approx_k_d_mult : forall {d} k l p q,
-    P_approx_k_d d k p ->  P_approx_k_d d l q
-     ->   P_approx_k_d d (k+l)%coq_nat (p*q)%K.
-Proof.
-intros d k l p q Hp Hq.
-apply P_approx_k_d_mult_le with k l; auto.
-Qed.
-
-Lemma P_approx_k_d_mult_iter : forall {d n} (k:'I_n -> nat) p m,
-  (forall i, P_approx_k_d d (k i) (p i)) ->
-    (sum k <= m)%coq_nat ->
-    P_approx_k_d d m (fun x => prod_R (fun i => p i x)).
-Proof.
-intros d n; induction n.
-(* *)
-intros k p m Hi Hm.
-apply P_approx_k_d_monotone with O; auto with arith.
-apply P_approx_d_0_eq.
-apply fun_ext; intros x.
-unfold prod_R; now rewrite 2!sum_nil.
-(* *)
-intros k p m Hi Hm.
-apply P_approx_k_d_ext with 
- ( (fun x => (p^~ x) ord0) * (fun x => prod_R (liftF_S (p^~ x)))%M)%K.
-intros x; rewrite prod_R_ind_l; simpl; easy.
-apply P_approx_k_d_mult_le with (k ord0) (sum (liftF_S k)).
-apply Hi.
-apply IHn with (liftF_S k); try easy.
-intros i; apply Hi.
-apply Nat.le_trans with (2:=Hm).
-rewrite sum_ind_l; auto with arith.
-Qed.
-
-Lemma is_affine_mapping_P_approx_1_d : forall {n d}
-  (f : fct_ModuleSpace (*'R_ModuleSpace^n*) -> fct_ModuleSpace) (*'R_ModuleSpace^d) *) (l:'I_d),
-  is_affine_mapping f -> P_approx_k_d n 1 (fun x : 'R^n  => f x l).
-Proof.
-intros n; case n.
-intros d f l Hf.
-apply P_approx_0_k_eq.
-(* *)
-clear n; intros n d f l Hf.
-destruct ((proj1 (is_affine_mapping_ms_equiv)) Hf) as (g,(t,(Hg1,Hg2))).
-apply P_approx_k_d_ext with ( (g^~l) + (fun _ => t l))%M.
-intros x; rewrite Hg2; easy.
-apply: span_plus_closed.
-2: apply P_approx_k_d_monotone with O; auto with arith.
-2: apply P_approx_d_0_eq; easy.
-rewrite is_linear_mapping_is_comb_lin; try easy.
-eapply P_approx_k_d_ext.
-2: eapply P_approx_k_d_comb_lin.
-intros x; rewrite fct_comb_lin_r_eq; try easy.
-intros i.
-apply P_approx_k_d_ext with (fun x => (x i) * 1).
-2: apply P_approx_k_d_mul_var.
-intros x; simpl; auto with real.
-apply P_approx_d_0_eq; easy.
-Qed.
-
-Lemma P_approx_k_d_pow_affine : forall {n d}
-  (f : (*'R^n*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace) (l:'I_n) m,
-  is_affine_mapping f -> 
-     P_approx_k_d d m (fun x : 'R^d => pow (f x l) m).
-Proof.
-intros n d f l m Hf.
-apply P_approx_k_d_ext with 
-  (fun x => prod_R (fun i:'I_m => f x l)).
-intros x.
-clear; induction m.
-simpl; now rewrite prod_R_nil.
-rewrite prod_R_ind_l IHm -tech_pow_Rmult; easy.
-apply P_approx_k_d_mult_iter with (fun _ => S O).
-intros j.
-now apply is_affine_mapping_P_approx_1_d.
-rewrite sum_constF_nat; auto with zarith.
-Qed.
-
-Lemma P_approx_k_d_compose_affine_mapping : forall {n d} k (p : FRd d) 
-  (f : (*'R^n*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace),
-  is_affine_mapping f -> 
-  (P_approx_k_d d k) p -> (P_approx_k_d n k) (compose p f).
-Proof.
-intros n d k p f Hf Hp.
-inversion Hp as [L HL].
-apply P_approx_k_d_ext with (comb_lin L (fun i => compose (Basis_Pk_d d k i) f)).
-intros x; unfold compose.
-rewrite 2!fct_comb_lin_r_eq; easy.
-apply P_approx_k_d_comb_lin.
-intros i.
-unfold Basis_Pk_d, compose.
-unfold f_mono.
-apply P_approx_k_d_mult_iter with (A_d_k d k i).
-2: apply A_d_k_sum.
-intros j.
-unfold powF, map2F.
-now apply P_approx_k_d_pow_affine.
-Qed.
-
-(* finally useless *)
-Lemma P_approx_k_d_affine_mapping_rev : forall {n d} k (p : FRd d) 
-  (f : (*'R^n*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace),
-   is_affine_mapping f -> bijective f ->
-    (P_approx_k_d n k) (compose p f) -> (P_approx_k_d d k) p.
-Proof.
-intros n d k p f Hf1 Hf2 H.
-replace p with (compose (compose p f) (f_inv Hf2)).
-apply P_approx_k_d_compose_affine_mapping; try easy.
-now apply is_affine_mapping_bij_compat.
-unfold compose; apply fun_ext; intros x.
-now rewrite f_inv_can_r.
-Qed.
-
-Lemma P_approx_k_d_affine_mapping_compose_basis : forall {d} k 
-   (B : '(FRd d)^(pbinom d k).+1)
-   (f : (*'R^d*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace),
-  is_basis (P_approx_k_d d k) B -> 
-  is_affine_mapping f -> bijective f ->
-  P_approx_k_d d k = span (fun i => compose (B i) f).
-Proof.
-intros d k B f HB Hf1 Hf2.
-apply subset_ext_equiv; split; intros p Hp.
-(* *)
-generalize (is_affine_mapping_bij_compat Hf2 Hf1); intros Hfi1.
-generalize (P_approx_k_d_compose_affine_mapping _ p _ Hfi1 Hp); intros H1.
-rewrite (proj1 HB) in H1.
-inversion H1 as (L,HL).
-apply span_ex; exists L; apply fun_ext; intros x.
-apply trans_eq with (compose (compose p (f_inv Hf2)) f x).
-unfold compose; now rewrite f_inv_can_l.
-rewrite -HL; unfold compose.
-now rewrite 2!fct_comb_lin_r_eq.
-(* *)
-inversion Hp as [L HL].
-apply P_approx_k_d_comb_lin; intros i.
-apply P_approx_k_d_compose_affine_mapping; try easy.
-apply (is_basis_inclF HB).
-Qed.
-
-End  Pkd_mult.
-
-
-
-
-
-
-Section DeriveGen_and_lemmas.
-
-Lemma is_derive_ext':
-  forall {K : AbsRing} {V : NormedModule K} (f : K -> V) 
-    (x : K) (l1 l2 : V),
-    l1 = l2 -> is_derive f x l1 -> is_derive f x l2.
-Proof.
-intros ; subst; easy.
-Qed.
-
-Lemma ex_derive_comb_lin : 
-  forall {n} (f :'I_n -> (R->R)) (L:'R^n),
-    (forall i x, ex_derive (f i) x) ->
-      forall x, ex_derive (comb_lin L f) x.
-Proof.
-intros n f L H.
-assert (H0: comb_lin_closed (fun (g:R->R) => forall x, ex_derive g x)).
-2: now apply H0.
-apply compatible_ms_comb_lin.
-apply plus_scal_closed_compatible_ms.
-exists (fun _ => 0); intros x.
-apply ex_derive_const.
-intros g h H1 H2 x.
-apply: ex_derive_plus; easy.
-intros g l H1 x.
-apply ex_derive_scal; easy.
-Qed.
-
-Lemma is_derive_comb_lin : 
-  forall {n} (f :'I_n -> (R->R)) (L:'R^n) (d :'I_n -> (R->R)),
-    (forall i x, is_derive (f i) x (d i x)) ->
-      forall x, is_derive (comb_lin L f) x (comb_lin L d x).
-Proof.
-intros n; induction n.
-intros f L d H x.
-rewrite 2!comb_lin_nil fct_zero_eq.
-unfold zero; simpl; unfold fct_zero.
-eapply is_derive_ext';[| apply is_derive_const]; easy.
-intros f L d H x.
-rewrite 2!comb_lin_ind_l.
-apply: is_derive_plus.
-apply is_derive_scal; easy.
-apply IHn; try easy.
-intros i y; unfold liftF_S; apply H.
-Qed.
-
-
-(* FC (14/12/2023) suggestion : rendre ces proprietes uniformes.
- C'est-a-dire remplacer "fun ... x => ..." par "fun ... => forall x, ..." *)
-
-Definition ex_derive_onei {n} :=
-  fun (i:'I_n) (f: 'R^n -> R) (x:'R^n) =>
-     ex_derive (fun y => f (replaceF x y i)) (x i).
-
-Definition is_derive_onei {n} :=
-  fun (i:'I_n) (f: 'R^n -> R) (x:'R^n) (l:R) =>
-     is_derive (fun y => f (replaceF x y i)) (x i) l.
-
-Definition Derive_onei {n} :=
-   fun (i:'I_n) (f: 'R^n -> R) (x:'R^n) =>
-      Derive (fun y => f (replaceF x y i)) (x i).
-
-Definition ex_derive_multii {n} :=
-  fun (i:'I_n) (j:nat) (f: 'R^n -> R) (x:'R^n) =>
-      ex_derive_n (fun y => f (replaceF x y i)) j (x i).
-
-Definition is_derive_multii {n} :=
-  fun (i:'I_n) (j:nat) (f: 'R^n -> R) (x:'R^n) (l:R) =>
-      is_derive_n (fun y => f (replaceF x y i)) j (x i) l.
-
-Definition Derive_multii {n} (i:'I_n) (j:nat) (f: 'R^n -> R) (x:'R^n):=
-   Derive_n (fun y => f (replaceF x y i)) j (x i).
-
-Lemma ex_derive_onei_comb_lin : 
-  forall {n m} (j:'I_n) (f :'I_m -> ('R^n->R)) (L:'R^m),
-    (forall i x, ex_derive_onei j (f i) x) ->
-      forall x, ex_derive_onei j (comb_lin L f) x.
-Proof.
-intros n m j f L; unfold ex_derive_onei; intros H x.
-apply ex_derive_ext with 
- (comb_lin L (fun (i : 'I_m) (y : R) => f i (replaceF x y j))).
-intros t; rewrite 2!fct_comb_lin_r_eq; easy.
-apply ex_derive_comb_lin.
-intros i y; specialize (H i (replaceF x y j)).
-rewrite replaceF_correct_l in H; try easy.
-apply ex_derive_ext with (2:=H).
-intros t; f_equal; apply extF; intros k.
-unfold replaceF; case (ord_eq_dec _ _); try easy.
-Qed.
-
-Lemma is_derive_onei_comb_lin : 
-  forall {n m} (j:'I_n) (f :'I_m -> ('R^n->R)) (L:'R^m) (d:'I_m -> ('R^n -> R)),
-    (forall i x, is_derive_onei j (f i) x (d i x)) ->
-      forall x, is_derive_onei j (comb_lin L f) x (comb_lin L d x).
-Proof.
-intros n m j f L d; unfold is_derive_onei; intros H x.
-apply is_derive_ext with 
- (comb_lin L (fun (i : 'I_m) (y : R) => f i (replaceF x y j))).
-intros t; rewrite 2!fct_comb_lin_r_eq; easy.
-apply is_derive_ext' with (comb_lin L (fun i y => d i (replaceF x y j)) (x j)).
-rewrite 2! fct_comb_lin_r_eq.
-apply comb_lin_ext_r.
-intros i; f_equal.
-apply replaceF_id.
-apply is_derive_comb_lin.
-intros i y; specialize (H i (replaceF x y j)).
-rewrite replaceF_correct_l in H; try easy.
-apply is_derive_ext with (2:=H).
-intros t; f_equal; apply extF; intros k.
-unfold replaceF; case (ord_eq_dec _ _); try easy.
-Qed.
-
-Lemma is_derive_onei_unique : forall {n} i (f:'R^n->R) x l,
-   is_derive_onei i f x l -> Derive_onei i f x = l.
-Proof.
-intros n i f x l; unfold is_derive_onei, Derive_onei; intros H.
-apply is_derive_unique; easy.
-Qed.
-
-
-Lemma is_derive_multii_unique : forall {n} (i:'I_n) j f x l,
-    is_derive_multii i j f x l -> Derive_multii i j f x = l.
-Proof.
-intros n i j f x l; unfold is_derive_multii, Derive_multii; intros H.
-apply is_derive_n_unique; easy.
-Qed.
-
-Lemma is_derive_multii_scal : forall {n} (i:'I_n) j f x l (k:R),
-     is_derive_multii i j f x l ->  
-     is_derive_multii i j (scal k f) x (scal k l).
-Proof.
-intros; apply is_derive_n_scal_l; easy.
-Qed.
-
-Lemma Derive_multii_scal : forall {n} (i:'I_n) j f x (k:R),
-     Derive_multii i j (scal k f) x 
-       = scal k (Derive_multii i j f x).
-Proof.
-intros n i j f x k; unfold Derive_multii.
-rewrite Derive_n_scal_l; easy.
-Qed.
-
-Definition Derive_alp {n} (alpha : 'nat^n) : '(('R^n->R) -> ('R^n->R))^n :=
-  fun i => Derive_multii i (alpha i).
-
-
-Definition DeriveF_part {n} (alpha : 'nat^n) (j:'I_n.+1) : ('R^n->R) -> ('R^n->R) :=
-  comp_n_part (Derive_alp alpha) j.
-(* was:
-     \big[ssrfun.comp/ssrfun.id]_(i < j) let ii := (widen_ord (leq_ord j) i) in
-       (Derive_multii ii (alpha ii)).*)
-
-Lemma DeriveF_part_ext_alp :
-  forall {n} (alpha1 alpha2 : 'nat^n) j,
-    eqAF (widenF (leq_ord j) alpha1) (widenF (leq_ord j) alpha2) ->
-    DeriveF_part alpha1 j = DeriveF_part alpha2 j.
-Proof.
-move=>> H; apply comp_n_part_ext; move=>>; apply fun_ext; intro.
-unfold widenF, Derive_alp in *; rewrite H; easy.
-Qed.
-
-Lemma DeriveF_part_extf : forall {n} (alpha:'nat^n) j f1 f2,
-    same_fun f1 f2 -> DeriveF_part alpha j f1 = DeriveF_part alpha j f2.
-Proof.
-move=>> /fun_ext Hf; subst; easy.
-Qed.
-
-Lemma DeriveF_part_0 :
-  forall {n} (alpha:'nat^n) j, j = ord0 -> DeriveF_part alpha j = ssrfun.id.
-Proof. intros; apply comp_n_part_0; easy. Qed.
-
-Lemma DeriveF_part_nil :
-  forall {n} (alpha:'nat^n) j, n = 0%nat -> DeriveF_part alpha j = ssrfun.id.
-Proof. intros; apply comp_n_part_nil; easy. Qed.
-
-Lemma DeriveF_part_full :
-  forall {n} (alpha:'nat^n) j,
-    j = ord_max -> DeriveF_part alpha j = comp_n (Derive_alp alpha).
-Proof. intros; apply comp_n_part_max; easy. Qed.
-
-Lemma DeriveF_part_ind_l :
-  forall {n} (alpha:'nat^n.+1) {j} (H : j <> ord0),
-    DeriveF_part alpha j =
-      Derive_alp alpha ord0 \o
-      comp_n_part (liftF_S (Derive_alp alpha)) (lower_S H).
-Proof. intros; apply comp_n_part_ind_l; easy. Qed.
-
-Lemma DeriveF_part_ind_r :
-  forall {n} (alpha : 'nat^n) (j:'I_n),
-    DeriveF_part alpha (lift_S j) =
-      DeriveF_part alpha (widen_S j) \o Derive_alp alpha j.
-Proof. intros; apply comp_n_part_ind_r. Qed.
-
-Definition DeriveF {n} (alpha : 'nat^n) : ('R^n->R) -> ('R^n->R) :=
-  comp_n (Derive_alp alpha).
-
-Lemma DeriveF_correct :
-  forall {n} (alpha : 'nat^n), DeriveF alpha = DeriveF_part alpha ord_max.
-Proof. intros; apply eq_sym, DeriveF_part_full; easy. Qed.
-
-Lemma DeriveF_ext_alp :
-  forall {n} (alpha1 alpha2 : 'nat^n),
-    eqAF alpha1 alpha2 -> DeriveF alpha1 = DeriveF alpha2.
-Proof.
-intros; rewrite !DeriveF_correct; apply DeriveF_part_ext_alp.
-rewrite !widenF_full; easy.
-Qed.
-
-Lemma DeriveF_extf : forall {n} (alpha : 'nat^n) f1 f2,
-    same_fun f1 f2 -> DeriveF alpha f1 = DeriveF alpha f2.
-Proof. move=>> /fun_ext Hf; subst; easy. Qed.
-
-Lemma DeriveF_nil :
-  forall {n} (alpha : 'nat^n), n = 0%nat -> DeriveF alpha = ssrfun.id.
-Proof. intros; apply comp_n_nil; easy. Qed.
-
-Lemma DeriveF_ind_l :
-  forall {n} (alpha : 'nat^n.+1),
-    DeriveF alpha =
-      Derive_alp alpha ord0 \o comp_n (liftF_S (Derive_alp alpha)).
-Proof. intros; apply comp_n_ind_l; easy. Qed.
-
-Lemma DeriveF_ind_r :
-  forall {n} (alpha : 'nat^n.+1),
-    DeriveF alpha =
-      comp_n (widenF_S (Derive_alp alpha)) \o Derive_alp alpha ord_max.
-Proof. intros; apply comp_n_ind_r. Qed.
-
-
-(* f1 does not depend upon (x i) therefore is a constant when deriving *)
-Lemma Derive_multii_scal_fun :  forall {n} (i:'I_n) j f1 f2,
-    (forall x y, f1 x = f1 (replaceF x y i)) ->
-     Derive_multii i j (fun x => f1 x* f2 x)
-       = (fun x => f1 x*(Derive_multii i j f2 x)).
-Proof.
-intros n i j f1 f2 H1.
-apply fun_ext; intros x; unfold Derive_multii.
-rewrite ->Derive_n_ext with (g:=fun y => f1 x * f2 (replaceF x y i)).
-2: intros t; rewrite -H1; easy.
-now rewrite Derive_n_scal_l.
-Qed.
-
-(* could have been insertF *)
-Definition narrow_ord_max := fun {n:nat} (f:'R^n.+1 -> R) (x:'R^n) => 
-   f (castF (eq_sym (addn1_sym n)) (concatF x (singleF 0))).
-
-Lemma narrow_ord_max_correct : forall {n:nat} f,
-   (forall (x:'R^n.+1) y, f x = f (replaceF x y ord_max)) ->
-   (forall x:'R^n.+1, f x = narrow_ord_max f (widenF_S x)).
-Proof.
-intros n f H x; rewrite (H x 0).
-unfold narrow_ord_max; f_equal.
-apply extF; intros i; unfold replaceF.
-case (ord_eq_dec _ _); intros Hi.
-subst; unfold castF; rewrite concatF_correct_r; easy.
-unfold castF; rewrite concatF_correct_l; simpl; try easy.
-destruct i as (j,Hj); simpl.
-apply ord_neq_compat in Hi; simpl in Hi.
-assert (j < n.+1)%coq_nat; [ now apply /ltP | now lia].
-intros H1; unfold widenF_S; f_equal; apply ord_inj; now simpl.
-Qed.
-
-Lemma narrow_ord_max_Derive_multii : 
-   forall {n} (f:'R^n.+1->R) i j (H: i<> ord_max),
-   (forall (x:'R^n.+1) y, f x = f (replaceF x y ord_max)) ->
-    (narrow_ord_max (Derive_multii i j f)) =
-       Derive_multii (narrow_S H) j (narrow_ord_max f).
-Proof.
-intros n f i j H H1.
-assert (Hi : (i < n)%coq_nat).
-generalize H; destruct i as (ii, Hii); simpl.
-intros T; apply ord_neq_compat in T; simpl in T.
-assert (ii < n.+1)%coq_nat; [now apply /ltP | lia].
-unfold narrow_ord_max, Derive_multii; apply fun_ext; intros x; f_equal.
-apply fun_ext; intros y; f_equal.
-apply extF; intros m; unfold replaceF.
-case (ord_eq_dec m i); intros Hm.
-subst; unfold castF; rewrite concatF_correct_l; try easy.
-case (ord_eq_dec _ _); try easy.
-intros T; apply ord_neq_compat in T; simpl in T; easy.
-unfold castF, concatF.
-case (lt_dec _ _); intros H2; try easy.
-case (ord_eq_dec _ _); try easy.
-intros T; contradict T.
-apply ord_neq; simpl; apply ord_neq_compat; easy.
-unfold castF; rewrite concatF_correct_l; try easy.
-f_equal; apply ord_inj; now simpl.
-Qed.
-
-Lemma DeriveF_part_scal_fun : forall {n} i (alpha:'nat^n.+1) (Hi: i<>ord_max) (g1:R->R) (g2: 'R^n.+1 -> R),
-  (forall (x:'R^n.+1) y, g2 x = g2 (replaceF x y ord_max)) ->
-  DeriveF_part alpha i (fun x:'R^n.+1 => g1 (x ord_max) * g2 x)
-     = (fun x:'R^n.+1 => g1 (x ord_max) 
-          * DeriveF_part (widenF_S alpha) (narrow_S Hi) (narrow_ord_max g2) (widenF_S x)).
-Proof.
-intros n (i,Hi); induction i.
-intros alpha Hi0 g1 g2 H1; apply fun_ext; intros x.
-rewrite DeriveF_part_0; try rewrite DeriveF_part_0; try easy; f_equal.
-now apply narrow_ord_max_correct.
-apply ord_inj; simpl; easy.
-apply ord_inj; simpl; easy.
-intros alpha Hi0 g1 g2 H1.
-assert (Hi' : (i < n.+1)%nat).
-apply /ltP; apply Arith_prebase.lt_S_n.
-now apply /ltP.
-assert (Hi'' : (i < n)%nat).
-apply /ltP; apply ord_neq_compat in Hi0; simpl in Hi0.
-assert (i < n.+1)%coq_nat by now apply /ltP.
-now auto with zarith.
-assert (Hi0'' : (i <> n)).
-generalize Hi''; move => /ltP; lia.
-replace (@Ordinal (n.+2) (i.+1) Hi) with (lift_S (Ordinal Hi')) at 1.
-2: apply ord_inj; easy.
-rewrite DeriveF_part_ind_r comp_correct; unfold Derive_alp.
-rewrite Derive_multii_scal_fun.
-rewrite IHi.
-apply ord_neq; simpl.
-apply Nat.lt_neq; now apply /ltP.
-intros H0; apply fun_ext; intros x; f_equal.
-replace (narrow_S Hi0) with (lift_S (Ordinal Hi'')).
-2: apply ord_inj; simpl; easy.
-rewrite DeriveF_part_ind_r comp_correct; f_equal; try easy.
-apply ord_inj; simpl; easy.
-rewrite narrow_ord_max_Derive_multii; try easy.
-apply ord_neq; now simpl.
-intros H2; unfold Derive_alp; f_equal; try easy.
-apply ord_inj; now simpl.
-unfold widenF_S; f_equal; apply ord_inj; now simpl.
-intros x y; unfold Derive_multii; f_equal.
-apply fun_ext; intros z.
-fold (replace2F x y z ord_max (Ordinal Hi')).
-rewrite replace2F_equiv_def; try easy.
-apply ord_neq; simpl; easy.
-rewrite replaceF_correct_r; try easy.
-apply ord_neq; simpl; easy.
-intros x y; rewrite replaceF_correct_r; try easy.
-apply ord_neq; simpl; apply sym_not_eq; easy.
-Qed.
-
-
-Lemma DeriveF_ind_r_scal_fun : forall {n} (alpha : 'nat^n.+1) f (g1:R->R) (g2: 'R^n.+1 -> R),
-   (forall (x:'R^n.+1), Derive_alp alpha ord_max f x = g1 (x ord_max) * g2 x) ->
-   (forall (x:'R^n.+1) y, g2 x = g2 (replaceF x y ord_max)) ->
-   DeriveF alpha f = fun x => g1 (x ord_max) * DeriveF (widenF_S alpha) (narrow_ord_max g2) (widenF_S x).
-Proof.
-intros n alpha f g1 g2 H1 H2.
-rewrite DeriveF_correct.
-rewrite -lift_S_max.
-rewrite DeriveF_part_ind_r comp_correct.
-apply fun_ext_equiv in H1; rewrite H1.
-rewrite DeriveF_part_scal_fun; try easy.
-apply ord_neq; simpl; easy.
-intros H; apply fun_ext; intros x; f_equal.
-rewrite DeriveF_correct; f_equal.
-apply ord_inj; easy.
-Qed.
-
-
-
-Definition is_Poly {n} (f: 'R^n -> R) := exists k, P_approx_k_d n k f.
-
-Lemma is_Poly_ext : forall {n} (f1 f2 : 'R^n -> R),
-  f1 = f2 -> is_Poly f1 -> is_Poly f2.
-Proof.
-intros; subst; easy.
-Qed.
-
-
-Lemma is_Poly_zero : forall {n}, @is_Poly n zero.
-Proof.
-intros n; exists O.
-apply P_approx_d_0_eq; easy.
-Qed.
-
-Lemma is_Poly_scal : forall {n} l (f : 'R^n -> R),
-    is_Poly f -> is_Poly (scal l f).
-Proof.
-intros n l f (k,Hk).
-exists k; apply span_scal_closed; easy.
-Qed.
-
-Lemma is_Poly_plus : forall {n} (f1 f2 : 'R^n -> R),
-  is_Poly f1 -> is_Poly f2 -> is_Poly (f1+f2)%M.
-Proof.
-intros n f1 f2 (k1,Hk1) (k2,Hk2).
-exists (max k1 k2).
-apply: span_plus_closed.
-apply P_approx_k_d_monotone with k1; auto with arith.
-apply P_approx_k_d_monotone with k2; auto with arith.
-Qed.
-
-Lemma is_Poly_comb_lin  : forall {n m} (f : 'I_m -> 'R^n -> R) L,
-  (forall i, is_Poly (f i)) -> is_Poly (comb_lin L f).
-Proof.
-intros n m; induction m.
-intros f L H.
-rewrite comb_lin_nil.
-apply is_Poly_zero.
-intros f L H.
-rewrite comb_lin_ind_l.
-apply is_Poly_plus.
-apply is_Poly_scal; easy.
-apply IHm.
-intros i; unfold liftF_S; apply H.
-Qed.
-
-
-Lemma is_Poly_Basis_Pk_d : forall {d k} i,
-    is_Poly (Basis_Pk_d d k i).
-Proof.
-intros d k i; exists k.
-apply span_inclF; intros j; now exists j.
-Qed.
-
-
-Lemma is_Poly_f_mono : forall {d} (beta : 'nat^d),
-   is_Poly (fun x => f_mono x beta).
-Proof.
-intros d beta.
-pose (k:= sum beta).
-apply is_Poly_ext with (Basis_Pk_d d k (A_d_k_inv d k beta)).
-2: apply is_Poly_Basis_Pk_d.
-unfold Basis_Pk_d; rewrite A_d_k_inv_correct_r; easy.
-Qed.
-
-
-Lemma is_derive_f_mono : forall {n} (beta:'nat^n) i x,
-    is_derive_onei i (fun y => f_mono y beta) x
-      (INR (beta i) * f_mono x (replaceF beta (beta i).-1 i)).
-Proof.
-intros n; induction n.
-intros beta i; exfalso; apply I_0_is_empty; apply (inhabits i).
-intros beta i x; unfold f_mono, is_derive_onei.
-eapply is_derive_ext.
-intros t; rewrite prod_R_ind_l; easy.
-case (ord_eq_dec i ord0); intros Hi.
-(* *)
-subst; unfold liftF_S.
-apply is_derive_ext with
-  (fun t => (prod_R
-      (fun i : 'I_n =>
-       powF x beta (lift_S i)) * t^(beta ord0))).
-intros t; unfold plus; rewrite Rmult_comm; simpl; f_equal.
-unfold powF, map2F; now rewrite replaceF_correct_l.
-f_equal; apply extF; intros i.
-unfold powF, map2F; rewrite replaceF_correct_r; easy.
-apply is_derive_ext' with ( (prod_R (fun i : 'I_n => powF x beta (lift_S i))) *
-       (INR (beta ord0)*1*x ord0^(beta ord0).-1)).
-rewrite Rmult_comm Rmult_assoc Rmult_1_r.
-f_equal; rewrite (prod_R_ind_l); unfold plus; simpl; f_equal.
-unfold powF, map2F; rewrite replaceF_correct_l; try easy.
-f_equal; apply extF; intros i.
-unfold powF, map2F, liftF_S.
-rewrite replaceF_correct_r; easy.
-apply is_derive_scal.
-apply is_derive_pow.
-apply is_derive_ext' with  (@one (AbsRing.Ring R_AbsRing)); try easy.
-apply is_derive_id.
-(* *)
-apply is_derive_ext with
- (fun t => ( (x ord0)^(beta ord0) * 
-            (prod_R ((powF (replaceF (liftF_S x) t (lower_S Hi)) (liftF_S beta)))))).
-intros t; unfold plus; simpl; f_equal.
-unfold powF, map2F; rewrite replaceF_correct_r; try easy.
-apply sym_not_eq; easy.
-f_equal; apply extF; intros j.
-unfold powF, map2F, liftF_S; f_equal.
-unfold replaceF; case (ord_eq_dec _ _); intros Hj.
-rewrite Hj  lift_lower_S; case (ord_eq_dec _ _); easy.
-case (ord_eq_dec _ _); intros Hj'; try easy.
-absurd (lift_S j = (lift_S (lower_S Hi))).
-intros H; apply Hj.
-unfold lift_S in H; apply (lift_inj H).
-now rewrite lift_lower_S.
-apply is_derive_ext' with ( (x ord0)^(beta ord0) * 
-         (INR (beta i) * prod_R (powF (liftF_S x) 
-                                (replaceF (liftF_S beta) (beta i).-1 (lower_S Hi))))).
-rewrite Rmult_comm Rmult_assoc; f_equal; rewrite Rmult_comm.
-rewrite prod_R_ind_l; unfold plus; simpl; f_equal.
-unfold powF, map2F; rewrite replaceF_correct_r; try easy.
-apply sym_not_eq; easy.
-f_equal; apply extF; intros j.
-unfold powF, map2F, liftF_S; f_equal.
-unfold replaceF; case (ord_eq_dec _ _); intros Hj.
-rewrite Hj  lift_lower_S; case (ord_eq_dec _ _); easy.
-case (ord_eq_dec _ _); intros Hj'; try easy.
-absurd (lift_S j = (lift_S (lower_S Hi))).
-intros H; apply Hj.
-unfold lift_S in H; apply (lift_inj H).
-now rewrite lift_lower_S.
-apply is_derive_scal.
-specialize (IHn (liftF_S beta) (lower_S Hi) (liftF_S x)).
-unfold f_mono, is_derive_onei in IHn.
-replace (liftF_S beta (lower_S Hi)) with (beta i) in IHn.
-replace (liftF_S x (lower_S Hi)) with (x i) in IHn.
-exact IHn.
-unfold liftF_S; now rewrite lift_lower_S.
-unfold liftF_S; now rewrite lift_lower_S.
-Qed.
-
-Lemma is_Poly_ex_derive : forall {n} (f: 'R^n -> R), 
-   is_Poly f -> (forall i x, ex_derive_onei i f x).
-Proof.
-intros n f (k,Hf) i x; destruct Hf.
-apply ex_derive_onei_comb_lin.
-intros j y; unfold Basis_Pk_d; eexists.
-apply is_derive_f_mono.
-Qed.
-
-Lemma is_Poly_Derive_is_Poly : forall {n} (f: 'R^n -> R), 
-   is_Poly f -> (forall i, is_Poly (Derive_onei i f)).
-Proof.
-intros n; case n.
-intros f H i.
-exfalso; apply I_0_is_empty; apply (inhabits i).
-clear n; intros n f (k,Hk) i; inversion Hk.
-eapply is_Poly_ext.
-apply eq_sym; apply fun_ext; intros x.
-apply is_derive_onei_unique.
-apply is_derive_onei_comb_lin.
-intros j y; unfold Basis_Pk_d.
-apply is_derive_f_mono.
-exists k.
-apply span_span; intros j.
-apply: span_scal_closed.
-apply span_ub with
-  (A_d_k_inv n.+1 k (replaceF (A_d_k n.+1 k j) (A_d_k n.+1 k j i).-1 i)).
-unfold Basis_Pk_d.
-rewrite A_d_k_inv_correct_r; try easy.
-apply Nat.add_le_mono_l with (A_d_k n.+1 k j i).
-replace (_ +_)%coq_nat with 
- (A_d_k n.+1 k j i + sum (replaceF (A_d_k n.+1 k j) (A_d_k n.+1 k j i).-1 i))%M by easy.
-rewrite sum_replaceF.
-generalize (A_d_k_sum n.+1 k j).
-unfold plus; simpl; auto with zarith.
-Qed.
-
-Lemma is_Poly_Derive_n_is_Poly : forall {n} (f: 'R^n -> R), 
-   is_Poly f -> (forall i m, is_Poly (Derive_multii i m f)).
-Proof.
-intros n f H i; unfold Derive_multii; induction m; simpl; try easy.
-apply is_Poly_ext with (2:=H).
-apply fun_ext; intros x.
-now rewrite replaceF_id.
-eapply is_Poly_ext.
-2: apply is_Poly_Derive_is_Poly.
-2: apply IHm.
-apply fun_ext; intros x; unfold Derive_onei.
-f_equal; apply fun_ext; intros y.
-rewrite replaceF_correct_l; try easy.
-f_equal; apply fun_ext; intros z; f_equal.
-unfold replaceF; apply extF; intros j.
-case (ord_eq_dec _ _); easy.
-Qed.
-
-Lemma is_Poly_ex_derive_n : forall {n} (f: 'R^n -> R), 
-   is_Poly f -> (forall i m x, ex_derive_multii i m f x).
-Proof.
-intros n f H i m x; unfold ex_derive_multii.
-induction m; try easy; simpl.
-assert (H1: ex_derive_onei i (Derive_multii i m f) x).
-apply is_Poly_ex_derive.
-now apply is_Poly_Derive_n_is_Poly.
-apply ex_derive_ext with (2:=H1).
-intros t; unfold ex_derive_onei, Derive_multii; f_equal.
-apply fun_ext; intros y; f_equal.
-unfold replaceF; apply extF; intros j.
-case (ord_eq_dec _ _); easy.
-now apply replaceF_correct_l.
-Qed.
-
-
-(*  d^beta x^alpha = Prod_{i=0}^{d} 
-    (Prod_{j=0}^{beta_i - 1}(alpha_i - j)) x_i ^(alpha_i - beta_i). *)
-
-Lemma Derive_multii_f_mono : forall {n} (A:'nat^n) i m, exists C, 
-  Derive_multii i m (fun x => f_mono x A) 
-     = (fun x => C* f_mono x (replaceF A (A i-m)%coq_nat i)) 
-   /\ (C = 0 <-> (A i < m)%coq_nat).
-Proof.
-intros n A i; induction m.
-exists 1%R; split.
-apply fun_ext; intros x; unfold Derive_multii, Derive_n; simpl.
-rewrite Rmult_1_l; rewrite Nat.sub_0_r.
-now rewrite replaceF_id replaceF_id.
-split; intros H; contradict H; auto with arith.
-destruct IHm as (C,(H1,H2)).
-exists (C * INR (A i - m)%coq_nat); split.
-unfold Derive_multii; unfold Derive_multii in H1.
-apply fun_ext; intros x; simpl.
-generalize (fun_ext_rev H1); intros H1'.
-rewrite ->Derive_ext with
-   (g:=fun z => C * f_mono (replaceF x z i) (replaceF A (A i - m)%coq_nat i)).
-rewrite Derive_scal.
-rewrite Rmult_assoc; f_equal.
-apply is_derive_unique.
-eapply is_derive_ext'.
-2: apply: is_derive_f_mono.
-rewrite replaceF_correct_l; try easy; f_equal; try easy.
-f_equal; unfold replaceF; apply extF; intros j.
-case (ord_eq_dec _ _); try easy.
-intros _; auto with zarith.
-intros t; rewrite -H1'.
-rewrite replaceF_correct_l; try easy.
-f_equal; apply fun_ext; intros y; f_equal.
-unfold replaceF; apply extF; intros j.
-case (ord_eq_dec _ _); easy.
-split; intros H3.
-case (Rmult_integral _ _ H3); intros H4.
-specialize (proj1 H2 H4); auto with arith.
-case (Nat.le_gt_cases m.+1 (A i)); try easy.
-intros H5; contradict H4; apply not_0_INR.
-assert (1 <= A i -m)%coq_nat; auto with zarith arith.
-apply PeanoNat.Nat.le_add_le_sub_l; auto with zarith.
-replace (A i -m)%coq_nat with O; auto with zarith real.
-Qed.
-
-Lemma DeriveF_f_mono : forall {n} (alpha B :'nat^n), exists C, 
-  DeriveF alpha (fun x => f_mono x B) 
-     = (fun x => C* f_mono x (fun i => (B i- alpha i)%coq_nat))
-   /\ (C = 0 <-> brEF lt B alpha).
-             (* (exists i, (B i < alpha i)%coq_nat)).*)
-Proof.
-intros n; induction n.
-intros alpha B; exists 1; split.
-rewrite DeriveF_nil; try easy.
-apply fun_ext; intros x; rewrite Rmult_1_l.
-unfold f_mono; rewrite 2!prod_R_nil; easy.
-split; intros H.
-contradict H; easy.
-exfalso; destruct H as (i,Hi).
-exfalso; apply I_0_is_empty; apply (inhabits i).
-(* *)
-intros alpha B.
-destruct (Derive_multii_f_mono B ord_max (alpha ord_max)) as
-  (C1, (Y1,Z1)); fold (Derive_alp alpha ord_max) in Y1.
-destruct (IHn (widenF_S alpha) (widenF_S B)) as (C2,(Y2,Z2)).
-exists (C1*C2); split.
-rewrite ->DeriveF_ind_r_scal_fun with 
-  (g1:= fun t => C1 * t^(B ord_max - alpha ord_max))
-  (g2:= fun t => f_mono (widenF_S t) (widenF_S B)).
-(* . *)
-apply fun_ext; intros x.
-rewrite 2!Rmult_assoc; f_equal.
-rewrite ->DeriveF_extf with (f2:=f_mono^~ (widenF_S B)).
-rewrite Y2.
-rewrite Rmult_comm Rmult_assoc; f_equal.
-unfold f_mono; rewrite prod_R_ind_r.
-unfold plus; simpl; f_equal.
-intros t; unfold narrow_ord_max, f_mono; f_equal; f_equal.
-apply extF; intros i; unfold widenF_S, castF.
-rewrite concatF_correct_l; simpl; try easy.
-apply /ltP; destruct i; easy.
-intros H0; f_equal; apply ord_inj; now simpl.
-(* . *)
-intros x; rewrite Y1.
-rewrite Rmult_assoc; f_equal.
-unfold f_mono; rewrite prod_R_ind_r.
-unfold plus; simpl; rewrite Rmult_comm; f_equal.
-unfold powF, map2F; rewrite replaceF_correct_l; try easy.
-f_equal; apply extF; intros i.
-unfold widenF_S, powF, map2F; rewrite replaceF_correct_r; try easy.
-apply widen_S_not_last.
-(* . *)
-intros x y; f_equal; apply extF; intros i.
-unfold widenF_S; f_equal.
-rewrite replaceF_correct_r; try easy.
-apply widen_S_not_last.
-(* *)
-split; intros H.
-case (Rmult_integral C1 C2 H); intros H'.
-exists ord_max; apply Z1; easy.
-destruct ((proj1 Z2) H') as (j,Hj).
-exists (widen_S j); easy.
-destruct H as (j,Hj).
-case (ord_eq_dec j ord_max); intros H'.
-replace C1 with 0; try ring.
-apply eq_sym, Z1; subst; easy.
-replace C2 with 0; try ring.
-apply eq_sym, Z2.
-exists (narrow_S H').
-unfold widenF_S; rewrite widen_narrow_S; easy.
-Qed.
-
-
-Lemma Derive_alp_scal :
-  forall {n} (alpha : 'nat^n) i, f_scal_compat (Derive_alp alpha i).
-Proof. move=>>; apply fun_ext; intro; apply Derive_n_scal_l. Qed.
-
-Lemma DeriveF_part_scal :
-  forall {n} (alpha : 'nat^n) j, f_scal_compat (DeriveF_part alpha j).
-Proof. intros; apply comp_n_part_f_scal_compat, Derive_alp_scal. Qed.
-
-(* note SB : peut-être changer ordre paramètres de f_mono *)
-
-
-Lemma DeriveF_zero : forall {n} (alpha:'nat^n), (* SB TODO  *)
-     DeriveF alpha zero = zero.
-Proof.
-intros n; induction n.
-intros alpha; unfold DeriveF.
-rewrite comp_n_nil; easy.
-intros alpha.
-rewrite ->DeriveF_ind_r_scal_fun with (g1:=zero) (g2:=zero); try easy.
-apply fun_ext; intros x.
-rewrite fct_zero_eq; unfold mult, fct_zero, zero ; simpl.
-rewrite Rmult_0_l; easy.
-intros x; unfold Derive_alp, Derive_multii.
-rewrite fct_zero_eq Rmult_0_l.
-rewrite ->Derive_n_ext with (g:=fun _ => 0); try easy.
-case (alpha ord_max); try easy.
-intros m; apply Derive_n_const.
-Qed.
-
-Lemma DeriveF_scal : forall {n} (alpha:'nat^n) l f,
-     DeriveF alpha (scal l f) = scal l (DeriveF alpha f).
-Proof.
-intros n alpha l f; unfold DeriveF.
-apply comp_n_f_scal_compat.
-intros i y g; unfold Derive_alp; apply fun_ext; intros x.
-rewrite Derive_multii_scal; try easy.
-Qed.
-
-Lemma DeriveF_plus : forall {n} (alpha:'nat^n) f1 f2,
-   is_Poly f1 ->  is_Poly f2 -> 
-     DeriveF alpha (f1+f2)%M = (DeriveF alpha f1 + DeriveF alpha f2)%M.
-Proof.
-intros n alpha f1 f2 H1 H2; unfold DeriveF.
-assert (H: f_plus_compat_sub is_Poly (comp_n (Derive_alp alpha))).
-2: apply H; easy.
-apply comp_n_f_plus_compat_sub.
-intros i g (g1,Hg1); unfold Derive_alp.
-apply is_Poly_Derive_n_is_Poly; try easy.
-intros i g1 g2 Hg1 Hg2.
-unfold Derive_alp, Derive_multii.
-apply fun_ext; intros x.
-rewrite Derive_n_plus; try easy.
-exists (mkposreal 1 Rlt_0_1); intros y Hy k Hk.
-generalize (is_Poly_ex_derive_n g1 Hg1 i k (replaceF x y i)); unfold ex_derive_multii.
-rewrite replaceF_correct_l; try easy.
-intros T; apply: (ex_derive_n_ext _ (fun x0 : R => g1 (replaceF x x0 i))).
-2: apply T.
-intros t; simpl; unfold replaceF; f_equal; apply extF; intros i0.
-case (ord_eq_dec i0 i); try easy.
-exists (mkposreal 1 Rlt_0_1); intros y Hy k Hk.
-generalize (is_Poly_ex_derive_n g2 Hg2 i k (replaceF x y i)); unfold ex_derive_multii.
-rewrite replaceF_correct_l; try easy.
-intros T; apply: (ex_derive_n_ext _ (fun x0 : R => g2 (replaceF x x0 i))).
-2: apply T.
-intros t; simpl; unfold replaceF; f_equal; apply extF; intros i0.
-case (ord_eq_dec i0 i); try easy.
-Qed.
-
-
-Lemma DeriveF_comb_lin_Poly : forall {n m} (alpha:'nat^n) f (L:'R^m),
-   (forall i, is_Poly (f i)) ->
-    DeriveF alpha (comb_lin L f) = comb_lin L (fun i => DeriveF alpha (f i)).
-Proof.
-intros n m; induction m.
-intros alpha f L H.
-rewrite 2!comb_lin_nil.
-apply DeriveF_zero.
-intros alpha f L H.
-rewrite comb_lin_ind_l.
-rewrite DeriveF_plus.
-rewrite DeriveF_scal.
-rewrite IHm.
-now rewrite comb_lin_ind_l.
-intros i; apply H; easy.
-now apply is_Poly_scal.
-apply is_Poly_comb_lin.
-intros i; unfold liftF_S; apply H.
-Qed.
-
-
-Lemma Basis_Pk_d_is_free_aux1 : forall d k alpha i,
-     alpha = A_d_k d k i ->
-    DeriveF alpha (Basis_Pk_d d k i) zero <> zero.
-Proof.
-intros d k alpha i H; rewrite H; unfold Basis_Pk_d.
-destruct (DeriveF_f_mono (A_d_k d k i) (A_d_k d k i)) as (C,(HC1,HC2)).
-rewrite HC1.
-rewrite f_mono_zero_compat_r.
-rewrite Rmult_1_r; unfold zero; simpl.
-intros T; apply HC2 in T; destruct T as (j,Hj).
-contradict Hj; auto with arith.
-apply extF; intros j; rewrite constF_correct; auto with arith.
-Qed.
-
-
-Lemma Basis_Pk_d_is_free_aux2 : forall d k alpha i,
-    alpha <> A_d_k d k i ->
-    DeriveF alpha (Basis_Pk_d d k i) zero = zero.
-Proof.
-intros d k alpha i H; unfold Basis_Pk_d.
-destruct (DeriveF_f_mono alpha (A_d_k d k i)) as (C,(HC1,HC2)).
-rewrite HC1; unfold zero at 2; simpl.
-apply nextF_rev in H; destruct H as (j,Hj); unfold neq in Hj.
-apply not_eq in Hj; destruct Hj.
-(* . *)
-rewrite f_mono_zero_compat; try ring.
-exists j; unfold powF, map2F.
-unfold zero; simpl.
-apply eq_sym, pow_i; auto with zarith.
-(* . *)
-rewrite (proj2 HC2); try ring.
-now exists j.
-Qed.
-
-
-End DeriveGen_and_lemmas.
-
-Section P_approx_k_d_Prop.
-
-Variable d k : nat.
-
-Lemma P_approx_k_d_poly : forall (p : FRd d), 
-  (P_approx_k_d d k) p -> 
-    {L : 'R^((pbinom d k).+1) | p = comb_lin L (Basis_Pk_d d k)}.
-Proof.
-intros p Hp; apply span_EX; easy.
-Qed.
-
-Lemma P_approx_k_d_poly_ex : forall (p : FRd d), 
-  (P_approx_k_d d k) p ->
-    exists L : 'R^((pbinom d k).+1), 
-        p = comb_lin L (Basis_Pk_d d k).
-Proof.
-intros p Hp.
-destruct (P_approx_k_d_poly p) as [L HL].
-apply Hp.
-exists L; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1612 - p34." *)
-Lemma Basis_Pk_d_is_free : is_free (Basis_Pk_d d k).
-Proof.
-intros L HL.
-apply extF; intros ipl.
-rewrite zeroF.
-assert (HL2 : DeriveF (A_d_k d k ipl) (comb_lin L (Basis_Pk_d d k)) zero 
-        = DeriveF (A_d_k d k ipl)  zero zero).
-f_equal; easy.
-rewrite DeriveF_zero in HL2; rewrite fct_zero_eq in HL2.
-rewrite DeriveF_comb_lin_Poly in HL2.
-2: intros i; apply is_Poly_Basis_Pk_d.
-rewrite fct_comb_lin_r_eq in HL2.
-rewrite (comb_lin_one_r _ _ ipl) in HL2.
-unfold scal in HL2; simpl in HL2; unfold mult in HL2; simpl in HL2.
-case (Rmult_integral _ _ HL2); try easy; intros H.
-contradict H.
-apply Basis_Pk_d_is_free_aux1; easy.
-apply extF; intros i; rewrite zeroF; unfold skipF.
-apply Basis_Pk_d_is_free_aux2.
-intros H; apply A_d_k_inj in H; apply eq_sym in H.
-generalize H; apply skip_ord_correct_m.
-Qed.
-
-Lemma Basis_Pk_d_is_generator : is_generator (P_approx_k_d d k) (Basis_Pk_d d k).
-Proof. easy. Qed.
-
-(** "Livre Vincent Lemma 1613 - p34." *)
-Lemma Basis_Pk_d_is_basis : is_basis (P_approx_k_d d k) (Basis_Pk_d d k).
-Proof.
-apply is_basis_span_equiv, Basis_Pk_d_is_free.
-Qed.
-
-(** "Livre Vincent Lemma 1614 - p34." *)
-Lemma P_approx_k_d_compat_fin : has_dim (P_approx_k_d d k) ((pbinom d k).+1).
-Proof.
-apply is_free_has_dim_span, Basis_Pk_d_is_free.
-Qed.
-
-Lemma affine_independent_decomp_unique : forall dL (vtx_cur : 'R^{dL.+1,dL}) 
-  (x : 'R^dL) L,
-  affine_independent vtx_cur ->
-    x = comb_lin L vtx_cur -> sum L = 1 -> L = LagP1_d_cur vtx_cur^~ x.
-Proof.
-intros dL vtx_cur x L Hvtx H1 H2.
-unfold LagP1_d_cur.
-rewrite H1.
-rewrite T_geom_inv_transports_convex_baryc; try easy.
-apply extF; intros i.
-rewrite -LagP1_d_ref_comb_lin; easy.
-Qed. 
-
-Lemma affine_independent_decomp : forall dL (vtx_cur : 'R^{dL.+1,dL}) 
-  (x : 'R^dL),
-  affine_independent vtx_cur ->
-    x = comb_lin (LagP1_d_cur vtx_cur^~ x) vtx_cur.
-Proof.
-intros dL vtx_cur x Hvtx.
-destruct (affine_independent_generator _ has_dim_Rn Hvtx x) as [L [HL1 HL2]].
-rewrite HL2.
-f_equal.
-rewrite -HL2.
-apply affine_independent_decomp_unique; easy.
-Qed. 
-
-End P_approx_k_d_Prop.
-
-Section P_approx_1_d_Prop.
-
-Variable d : nat.
-
-Lemma Basis_P1_d_is_free : is_free (Basis_Pk_d d 1).
-Proof.
-apply Basis_Pk_d_is_free.
-Qed.
-
-Definition Basis_P1_d :=
-  fun (ipk : 'I_d.+1) (x : 'R^d) => 
-    match (ord_eq_dec ipk ord0) with
-    | left _ => 1
-    | right H => x (lower_S H)
-    end.
-
-Lemma Basis_P1_d_0 : Basis_Pk_d d 1 ord0 = fun _ => 1.
-Proof.
-unfold Basis_Pk_d.
-apply fun_ext; intros x.
-apply f_mono_zero_ext_r.
-intros i; rewrite (A_d_1_eq d).
-unfold castF; rewrite concatF_correct_l; easy.
-Qed.
-
-(*
-Lemma Basis_P1_d_neq0 : forall ipk
-  (H : (cast_ord (pbinomS_1_r d)) ipk <> ord0),
-  Basis_Pk_d d 1 ipk = fun x => x (lower_S H).
-*)
-(* FIXME 19/12/23 : use x (lower_S H) instead et cast_ord. *)
-Lemma Basis_P1_d_neq0 : forall (ipk : 'I_((pbinom d 1).+1)) 
-  (H : nat_of_ord ipk <> O),
-  Basis_Pk_d d 1 ipk = fun x => 
-    x (Ordinal (ordS_lt_minus_1 ((cast_ord (pbinomS_1_r d)) ipk) H)).
-  (* use x (lower_S H) instead *)
-Proof.
-intros ipk Hipk; unfold Basis_Pk_d.
-apply fun_ext; intros x. 
-(* *)
-rewrite A_d_1_neq0.
-apply ord_neq; simpl; easy.
-intros H.
-rewrite (f_mono_one x _ 1 (cast_ord (pbinom_1_r d) (lower_S H))); try easy.
-rewrite pow_1; f_equal; apply ord_inj; simpl; easy.
-Qed.
-
-Lemma P_approx_1_d_eq_ref : P_approx_1_d d = span (LagP1_d_ref d).
-Proof.
-apply span_ext; intro ipk.
-  (* <= *)
-destruct (ord_eq_dec ipk ord0) as [Hipk | Hipk].
-(* ipk = ord0 *)
-apply span_ex.
-pose (L := concatF (singleF 1) (@ones _ d)).
-assert (Hd : (1 + d)%coq_nat = (pbinom d 1).+1). 
-rewrite pbinomS_1_r; easy.
-exists L.
-rewrite Hipk.
-rewrite Basis_P1_d_0; try easy.
-apply fun_ext; intros x.
-rewrite fct_comb_lin_r_eq.
-rewrite comb_lin_ind_l.
-unfold liftF_S.
-unfold L at 1; rewrite concatF_correct_l singleF_0.
-rewrite LagP1_d_ref_0; try easy.
-rewrite scal_one.
-replace (comb_lin _ _) with (sum x).
-unfold plus; simpl; ring.
-rewrite comb_lin_comm_R.
-replace (fun i : 'I_d => L (lift_S i)) with (@ones R_Ring d).
-replace (fun i : 'I_d => LagP1_d_ref d (lift_S i) x) with x; try easy.
-rewrite comb_lin_ones_r; easy.
-apply extF; intros i.
-rewrite LagP1_d_ref_neq0; try easy.
-intros H; f_equal; rewrite lower_lift_S; easy.
-unfold L; apply extF; intros i.
-unfold concatF; simpl; f_equal.
-apply ord_inj; simpl.
-rewrite bump_r; auto with arith.
-(* ipk <> ord0 *)
-replace (Basis_Pk_d d 1 ipk) with (LagP1_d_ref d (cast_ord (pbinomS_1_r d) ipk)).
-apply span_inclF_diag.
-rewrite Basis_P1_d_neq0.
-contradict Hipk; apply ord_inj; easy.
-intros H; rewrite LagP1_d_ref_neq0.
-apply ord_neq; easy.
-intros H1; apply fun_ext; intros x.
-f_equal; unfold lower_S.
-f_equal; easy.
-  (* => *)
-destruct (ord_eq_dec ipk ord0) as [Hipk | Hipk]. 
-apply span_ex.
-(* ipk = ord0 *)
-pose (L := concatF (singleF 1) (opp (@ones _ d))).
-assert (Hd : (1 + d)%coq_nat = (pbinom d 1).+1). 
-rewrite pbinomS_1_r; easy.
-exists (castF Hd L).
-rewrite LagP1_d_ref_0; try easy.
-apply fun_ext; intros x.
-rewrite fct_comb_lin_r_eq.
-rewrite -(comb_lin_castF (pbinomS_1_r d)).
-rewrite comb_lin_ind_l.
-unfold castF.
-replace (L (cast_ord (eq_sym Hd) (cast_ord (eq_sym (pbinomS_1_r d)) ord0))) with (L ord0).
-2: f_equal; apply ord_inj; easy.
-assert (nat_of_ord (cast_ord (eq_sym (pbinomS_1_r d)) ord0) = 0%N).
-easy.
-replace (Basis_Pk_d d 1 (cast_ord (eq_sym (pbinomS_1_r d)) ord0) x) with
-  (Basis_Pk_d d 1 ord0 x).
-rewrite Basis_P1_d_0. 
-unfold liftF_S.
-rewrite scal_one_r.
-unfold L at 1; rewrite concatF_correct_l singleF_0.
-rewrite -(opp_opp (comb_lin (fun i : 'I_d => L _) _)).
-rewrite -comb_lin_opp_l.
-rewrite comb_lin_comm_R.
-replace (opp _) with (@ones R_Ring d).
-unfold Rminus, plus, opp; simpl; do 3 f_equal.
-rewrite comb_lin_ones_r.
-f_equal.
-apply extF; intros i.
-rewrite Basis_P1_d_neq0; try easy.
-intros H0; f_equal; apply ord_inj; simpl.
-rewrite bump_r; auto with arith.
-unfold L; apply extF; intros i.
-rewrite fct_opp_eq opp_opp; simpl; f_equal.
-apply ord_inj; simpl.
-rewrite bump_r; auto with arith.
-f_equal; apply ord_inj; easy.
-(* i<>0 *)
-replace (LagP1_d_ref d ipk) with 
-  (Basis_Pk_d d 1 (cast_ord (eq_sym (pbinomS_1_r d)) ipk)).
-apply span_inclF_diag.
-rewrite Basis_P1_d_neq0; simpl.
-contradict Hipk; apply ord_inj; rewrite Hipk; easy.
-intros H; apply fun_ext; intros x.
-rewrite LagP1_d_ref_neq0.
-f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma LagP1_d_ref_is_generator : is_generator (P_approx_1_d d) (LagP1_d_ref d).
-Proof.
-rewrite P_approx_1_d_eq_ref; easy.
-Qed.
-
-Lemma LagP1_d_ref_is_basis : is_basis (P_approx_1_d d) (LagP1_d_ref d).
-Proof.
-rewrite P_approx_1_d_eq_ref.
-apply is_basis_span_equiv.
-apply LagP1_d_ref_is_free.
-Qed.
-
-Lemma P_approx_1_d_compatible : compatible_ms (P_approx_1_d d).
-Proof.
-apply span_compatible_ms.
-Qed.
-
-Lemma P_approx_1_d_compat_fin : has_dim (P_approx_1_d d) (d.+1).
-Proof.
-rewrite P_approx_1_d_eq_ref.
-apply is_free_has_dim_span.
-apply LagP1_d_ref_is_free.
-Qed.
-
-Lemma LagP1_d_ref_is_poly : inclF (LagP1_d_ref d) (P_approx_1_d d).
-Proof.
-rewrite P_approx_1_d_eq_ref.
-apply span_inclF_diag.
-Qed.
-
-Lemma P_approx_1_d_eq_cur : forall vtx_cur, 
-  affine_independent vtx_cur ->
-  P_approx_1_d d = span (LagP1_d_cur vtx_cur).
-Proof.
-intros v Hvtx.
-(* Hint: composee de deux fcts affines, la composition avec une fonction affine reste dans le meme ev, et le degre de polynome ne change pas. *)
-apply span_ext.
-intros i.
-destruct (ord_eq_dec i ord0) as [H | H].
-(* i = ord0 *)
-rewrite H.
-rewrite Basis_P1_d_0.
-apply span_ex.
-exists ones.
-rewrite comb_lin_ones_l.
-apply fun_ext; intros x.
-rewrite sum_fun_compat.
-rewrite LagP1_d_cur_sum_1; easy.
-(* i <> ord0 *)
-rewrite Basis_P1_d_neq0.
-contradict H; apply ord_inj; easy.
-intros H1. 
-pose (j := Ordinal (n:=d) (m:=i - 1)
-          (ordS_lt_minus_1
-             (cast_ord (pbinomS_1_r d) i) H1)).
-fold j.
-apply span_ex.
-unfold LagP1_d_cur.
-generalize P_approx_1_d_eq_ref; intros H2.
-rewrite fun_ext_equiv in H2.
-specialize (H2 ((T_geom v)^~ j)).
-destruct (span_EX (LagP1_d_ref d) ((T_geom v)^~ j)) as [A HA].
-rewrite -H2.
-apply is_affine_mapping_P_approx_1_d.
-apply T_geom_is_affine_mapping.
-exists A.
-apply fun_ext; intros x. 
-apply trans_eq with ((comb_lin A (LagP1_d_ref d)) (T_geom_inv v x)).
-rewrite -HA.
-rewrite -T_geom_comp; easy.
-rewrite 2!fct_comb_lin_r_eq; easy.
-(* *)
-unfold LagP1_d_cur.
-intros i.
-apply (P_approx_k_d_compose_affine_mapping 1 (LagP1_d_ref d i)
-  (T_geom_inv v)).
-apply T_geom_inv_is_affine_mapping; easy.
-apply LagP1_d_ref_is_poly.
-Qed.
-
-Lemma LagP1_d_cur_is_basis : forall vtx_cur,
-  affine_independent vtx_cur -> 
-    is_basis (P_approx_1_d d) (LagP1_d_cur vtx_cur).
-Proof.
-intros vtx_cur Hvtx.
-rewrite (P_approx_1_d_eq_cur vtx_cur); try easy.
-apply is_basis_span_equiv.
-apply LagP1_d_cur_is_free; easy.
-Qed.
-
-End P_approx_1_d_Prop.
-
-Section P_approx_k_1_Prop.
-
-Variable k : nat.
-
-Hypothesis k_pos : (0 < k)%coq_nat.
-
-(** "Livre Vincent Lemma 1547 - p19." *)
-Lemma Basis_Pk_1_is_free : is_free (Basis_Pk_d 1 k).
-Proof.
-apply Basis_Pk_d_is_free.
-Qed.
-
-Lemma Basis_Pk_1_0 : forall ipk,
-  nat_of_ord ipk = O -> Basis_Pk_d 1 k ipk = fun _ => 1.
-Proof.
-intros ipk Hipk; unfold Basis_Pk_d.
-apply fun_ext; intros x.
-rewrite A_1_k_eq.
-apply f_mono_zero_ext_r.
-intros i; easy.
-Qed.
-
-(* MQ : i0 = ord0 -> Akd 1 k i0 i = i 
-   MQ : big mult pour ord0 *)
-Lemma Basis_Pk_1_neq0 : forall i,
-  Basis_Pk_d 1 k i = fun x => (x ord0)^i.
-Proof.
-intros i.
-unfold Basis_Pk_d.
-apply fun_ext; intros x.
-rewrite A_1_k_eq.
-rewrite (f_mono_one _ _ i ord0); try easy.
-apply fun_ext; intros y.
-unfold constF, itemF.
-rewrite replaceF_singleF_0.
-easy.
-Qed.
-
-Lemma P_approx_k_1_compatible : compatible_ms (P_approx_k_1 k).
-Proof.
-apply span_compatible_ms.
-Qed.
-
-(** "Livre Vincent Lemma 1548 - p20." *)
-Lemma P_approx_k_1_compat_fin : has_dim (P_approx_k_1 k) (k.+1).
-Proof.
-rewrite <-pbinomS_1_l; try easy.
-apply is_free_has_dim_span.
-apply Basis_Pk_d_is_free. 
-Qed.
-
-Lemma LagPk_1_ref_is_poly : inclF (LagPk_1_ref k) (P_approx_k_1 k).
-Proof.
-intros i.
-unfold P_approx_k_1, LagPk_1_ref, LagPk_1_cur.
-eapply P_approx_k_d_ext.
-2: apply span_scal_closed.
-intros x; unfold Rdiv; rewrite Rmult_comm; easy.
-unfold LagPk_1_cur_aux.
-apply P_approx_k_d_mult_iter with (k:=fun _ => S O).
-intros j.
-eapply P_approx_k_d_ext.
-2: apply span_minus_closed.
-2: apply (P_approx_k_d_mul_var _ (fun _ => 1) ord0).
-2: apply P_approx_d_0_eq; easy.
-2: apply P_approx_k_d_monotone with O; auto with arith.
-2: apply P_approx_d_0_eq.
-intros y; unfold minus; simpl; unfold opp, plus, fct_opp; simpl; unfold fct_opp, fct_plus; simpl.
-rewrite constF_correct Rmult_1_r; easy.
-easy.
-rewrite sum_constF_nat Nat.mul_1_r.
-rewrite pbinom_1_l; apply Nat.le_refl.
-Qed.
-
-(** "Livre Vincent Lemma 1550 - p20." *)
-Lemma LagPk_1_ref_is_basis : is_basis (P_approx_k_1 k) (LagPk_1_ref k).
-Proof.
-apply is_free_is_basis.
-rewrite pbinomS_1_l; try easy.
-apply P_approx_k_1_compat_fin.
-apply LagPk_1_ref_is_poly.
-apply LagPk_1_ref_is_free; easy.
-Qed.
-
-Lemma P_approx_k_1_eq : P_approx_k_1 k = span (LagPk_1_ref k).
-Proof.
-apply LagPk_1_ref_is_basis.
-Qed.
-
-Lemma LagPk_1_ref_is_generator : is_generator (P_approx_k_1 k) (LagPk_1_ref k).
-Proof.
-rewrite P_approx_k_1_eq; easy.
-Qed.
-
-Lemma P_approx_k_1_poly : forall (p : FRd 1), 
-  (P_approx_k_1 k) p -> {L : 'R^((pbinom 1 k).+1) | 
-          p = comb_lin L (LagPk_1_ref k)}.
-Proof.
-intros p Hp; apply span_EX. 
-rewrite P_approx_k_1_eq in Hp; easy.
-Qed.
-
-Lemma P_approx_k_1_poly_ex : forall (p : FRd 1), 
-  (P_approx_k_1 k) p -> exists L : 'R^((pbinom 1 k).+1), 
-        p = comb_lin L (LagPk_1_ref k).
-Proof.
-intros p Hp.
-destruct (P_approx_k_1_poly p) as [L HL]; try easy.
-exists L; easy.
-Qed.
-
-Lemma P_approx_k_1_poly_aux : forall p : FRd 1,
-  P_approx_k_1 k p ->
-      p = comb_lin (fun i : 'I_((pbinom 1 k).+1) => 
-            p (node_ref_aux 1 k i)) (LagPk_1_ref k).
-Proof.
-intros p Hp.
-destruct (P_approx_k_1_poly_ex p) as [L HL]; try easy.
-rewrite HL.
-f_equal.
-rewrite {1}(comb_lin_kronecker_basis L).
-apply extF; intros i.
-rewrite fct_comb_lin_r_eq.
-rewrite (fct_comb_lin_r_eq _ (LagPk_1_ref k)).
-f_equal.
-apply extF; intros j.
-rewrite LagPk_1_ref_kron_nodes; try easy.
-apply kronecker_sym.
-Qed.
- 
-Lemma P_approx_k_1_eq_cur' : forall (vtx_cur : 'R^{2,1}),
-  affine_independent vtx_cur ->
-  P_approx_k_1 k =
-    span (fun (i : 'I_(pbinom 1 k).+1) (x : 'R^1) =>
-       LagPk_1_ref k i (T_geom_inv vtx_cur x)).
-Proof.
-intros vtx_cur Hvtx; unfold P_approx_k_1.
-rewrite (P_approx_k_d_affine_mapping_compose_basis k (LagPk_1_ref k) (T_geom_inv vtx_cur)); try easy.
-apply LagPk_1_ref_is_basis.
-now apply T_geom_inv_is_affine_mapping.
-rewrite T_geom_inv_eq.
-apply f_inv_bij.
-Qed.
-
-Lemma P_approx_k_1_eq_cur : forall (vtx_cur : 'R^{2,1}),
-  affine_independent vtx_cur ->
-  P_approx_k_1 k = span (LagPk_1_cur k vtx_cur).
-Proof.
-intros vtx_cur Hvtx.
-rewrite LagPk_1_cur_eq; try easy.
-apply P_approx_k_1_eq_cur'; try easy.
-Qed.
-
-Lemma LagPk_1_cur_is_basis : forall vtx_cur,
-  affine_independent vtx_cur ->
-  is_basis (P_approx_k_1 k) (LagPk_1_cur k vtx_cur).
-Proof.
-intros vtx_cur Hvtx.
-rewrite (P_approx_k_1_eq_cur vtx_cur); try easy.
-apply is_basis_span_equiv.
-apply LagPk_1_cur_is_free; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1550 - p20." *)
-Lemma LagPk_1_cur_sum_1 : forall (vtx_cur : 'R^{2,1}) (x : 'R^1),
-  affine_independent vtx_cur -> 
-    sum (fun i => LagPk_1_cur k vtx_cur i x) = 1.
-Proof.
-intros vtx_cur x Hvtx.
-assert (H:P_approx_k_1 k 1%K).
-apply P_approx_k_d_monotone with O; try auto with arith.
-apply P_approx_d_0_eq; easy.
-rewrite (P_approx_k_1_eq_cur vtx_cur Hvtx) in H.
-inversion H.
-rewrite -comb_lin_ones_l.
-generalize (fun_ext_rev H1); intros H2; specialize (H2 x).
-unfold one in H2; simpl in H2; unfold fct_one in H2.
-rewrite fct_comb_lin_r_eq in H2.
-unfold one in H2; simpl in H2.
-rewrite -H2.
-apply comb_lin_ext_l; intros i; unfold ones.
-rewrite constF_correct; apply eq_sym.
-generalize (fun_ext_rev H1 (node_cur_aux 1 k vtx_cur i)); intros H3.
-unfold one in H3; simpl in H3; unfold  fct_one in H3; simpl in H3.
-rewrite -H3.
-rewrite fct_comb_lin_r_eq.
-erewrite comb_lin_eq_r.
-2: rewrite LagPk_1_cur_kron_nodes; try easy.
-rewrite {1}(comb_lin_kronecker_basis L).
-rewrite fct_comb_lin_r_eq.
-apply comb_lin_ext_r; intros j.
-apply kronecker_sym.
-Qed.
-
-Lemma LagPk_1_ref_sum_1 : forall x,
-  sum ((LagPk_1_ref k)^~ x) = 1.
-Proof.
-intros x.
-unfold LagPk_1_ref.
-apply LagPk_1_cur_sum_1.
-apply (vtx_simplex_ref_affine_ind _ k); easy.
-Qed.
-
-End P_approx_k_1_Prop.
-
-Section Phi_fact.
-
-(** "Livre Vincent Lemma 1659 - p52." *)
-Lemma Phi_compose : forall {d1} k (p : FRd d1.+1) 
-  (vtx_cur : 'R^{d1.+2,d1.+1}), affine_independent vtx_cur -> 
-    (P_approx_k_d d1.+1 k) p ->
-      (P_approx_k_d d1 k) (compose p (Phi d1 vtx_cur)).
-Proof.
-intros d1 k p vtx_cur Hvtx Hp.
-apply P_approx_k_d_compose_affine_mapping; try easy.
-apply Phi_is_affine_mapping.
-Qed.
-
-(** "Livre Vincent Lemma 1661 - p54." *)
-Lemma Phi_d_0_is_affine_mapping : forall {d1} (vtx_cur : 'R^{d1.+1,d1}),
-   is_affine_mapping (Phi_d_0 d1 vtx_cur).
-Proof.
-intros d1 vtx_cur.
-apply T_geom_is_affine_mapping.
-Qed.
-
-Lemma Phi_d_0_inv_is_affine_mapping : forall {d1} (vtx_cur : 'R^{d1.+1,d1})
-  (Hvtx : affine_independent vtx_cur),
-  is_affine_mapping (Phi_d_0_inv d1 vtx_cur Hvtx).
-Proof.
-intros d1 vtx_cur Hvtx.
-apply is_affine_mapping_bij_compat.
-apply Phi_d_0_is_affine_mapping.
-Qed.
-
-Lemma Phi_d_0_compose : forall {d1} k (p : FRd d1) 
-  (vtx_cur : 'R^{d1.+1,d1}), affine_independent vtx_cur -> 
-    (P_approx_k_d d1 k) p ->
-    (P_approx_k_d d1 k) (compose p (Phi_d_0 d1 vtx_cur)).
-Proof.
-intros d1 k p vtx_cur Hvtx Hp.
-apply P_approx_k_d_compose_affine_mapping; try easy.
-apply Phi_d_0_is_affine_mapping; easy.
-Qed.
-
-Lemma Phi_d_0_inv_compose : forall {d1} k (p : FRd d1) 
-  (vtx_cur : 'R^{d1.+1,d1}) (Hvtx : affine_independent vtx_cur),
-    (P_approx_k_d d1 k) p ->
-      (P_approx_k_d d1 k) (compose p (Phi_d_0_inv d1 vtx_cur Hvtx)).
-Proof.
-intros d1 k p vtx_cur Hvtx Hp.
-apply P_approx_k_d_compose_affine_mapping; try easy.
-apply Phi_d_0_inv_is_affine_mapping.
-Qed.
-
-End Phi_fact.
diff --git a/FEM/multi_index_new.v b/FEM/multi_index_new.v
deleted file mode 100644
index d8ce7421f2d5432466a56abd1160c5d2db75c0c3..0000000000000000000000000000000000000000
--- a/FEM/multi_index_new.v
+++ /dev/null
@@ -1,957 +0,0 @@
-(**
-This file is part of the Elfic 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.
-*)
-
-From FEM.Compl Require Import stdlib.
-
-Set Warnings "-notation-overridden".
-From FEM.Compl Require Import ssr.
-
-(* Next import provides Arith, Coquelicot.Hierarchy, functions to monoids. *)
-From LM Require Import linear_map.
-Set Warnings "notation-overridden".
-
-From FEM Require Import Compl Algebra binomial_compl.
-
-
-Section lexico_MO.
-
-Fixpoint MOn {n} (x y : 'nat^n) : Prop :=
-  match n as p return (n = p -> _) with
-    | 0 => fun H => False
-    | S m => fun H => (sum x < sum y)%coq_nat \/
-          (sum x = sum y /\ MOn (skipF (castF H x) ord0) (skipF (castF H y) ord0))
-  end erefl.
-
-Lemma sum_lt_MOn : forall {n} (x y : 'nat^n.+1),
-  (sum x < sum y)%coq_nat -> MOn x y.
-Proof.
-intros n x y H; simpl; left; easy.
-Qed.
-
-Lemma MOn_correct1 : forall x y : 'nat^1, MOn x y = (x ord0 < y ord0)%coq_nat.
-Proof.
-intros x y; simpl; rewrite 2!sum_1.
-assert (H : forall P Q, (P \/ Q /\ False) = P)
-    by (intros; apply prop_ext; tauto).
-apply H.
-Qed.
-
-(* For test.
-Definition MO2 (x y : 'nat^2) : Prop :=
-  ((x ord0 + x ord_max)%coq_nat < (y ord0 + y ord_max)%coq_nat)%coq_nat
-  \/
-  (((x ord0 + x ord_max)%coq_nat = (y ord0 + y ord_max)%coq_nat) /\ (x ord_max < y ord_max)%coq_nat).
-(*  lexico lt (coupleF (x ord0 + x ord_max)%coq_nat (x ord_max))
-         (coupleF (y ord0 + y ord_max)%coq_nat (y ord_max)).*)
-
-(* (0,0) < (n,0) *)
-Lemma MO2_correct1 : forall n : nat, (0 < n)%coq_nat -> MO2 (coupleF 0 0) (coupleF n 0).
-Proof.
-intros; unfold MO2; rewrite !coupleF_0 !coupleF_1 2!Nat.add_0_r; left; easy.
-Qed.
-
-(* (n,0) < (0,n) *)
-Lemma MO2_correct2 : forall n : nat, (0 < n)%coq_nat -> MO2 (coupleF n 0) (coupleF 0 n).
-Proof.
-intros; unfold MO2; rewrite !coupleF_0 !coupleF_1 Nat.add_0_r Nat.add_0_l; right; easy.
-Qed.
-
-Lemma MOn_correct2 : forall x y : 'nat^2, MOn x y = MO2 x y.
-Proof.
-intros x y; simpl; rewrite !sum_2 !sum_1 !castF_id !skipF_2l0.
-unfold MO2; f_equal.
-assert (H : forall P Q R, (P /\ (Q \/ R /\ False)) = (P /\ Q))
-    by (intros; apply prop_ext; tauto).
-apply H.
-Qed.
-*)
-
-Lemma MOn_trans : forall {n} (x y z:'nat^n),
-   MOn x y -> MOn y z -> MOn x z.
-Proof.
-intros n; induction n.
-simpl; easy.
-intros x y z H1 H2.
-case H1.
-intros H3; left.
-apply Nat.lt_le_trans with (1:= H3).
-case H2; [idtac | intros (H4,_); rewrite H4]; now auto with arith.
-intros (H3,H4).
-case H2.
-intros H5; left.
-rewrite H3; easy.
-intros (H5,H6).
-right; split.
-now rewrite H3.
-apply IHn with (1:=H4); easy.
-Qed.
-
-Lemma MOn_asym : forall  {n} (x y:'nat^n), 
-    MOn x y -> MOn y x -> False.
-Proof.
-intros n; induction n.
-simpl; intros; easy.
-intros x y H1 H2.
-case H1.
-intros H3.
-case H2.
-intros H4; now auto with zarith.
-intros (H4,_); now auto with zarith.
-intros (H3,H4).
-case H2.
-intros H5; now auto with zarith.
-intros (H5,H6).
-apply IHn with (1:=H4); easy.
-Qed.
-
-Lemma MOn_irrefl : forall {n} (x : 'nat^n), ~ MOn x x.
-Proof. intros n x H; apply (MOn_asym x x); easy. Qed.
-
-Lemma MOn_total_strict :
-  forall  {n} (x y : 'nat^n), x <> y -> MOn x y \/ MOn y x.
-Proof.
-intros n; induction n.
-simpl; intros x y H; contradict H; apply hat0F_unit.
-intros x y H; destruct (lt_eq_lt_dec (sum x) (sum y)) as [[H1 | H1] | H1].
-(* sum x < sum y *)
-left; simpl; left; easy.
-(* sum x = sum y *)
-assert (H2 : skipF x ord0 <> skipF y ord0).
-  contradict H; apply extF_skipF with ord0; [| easy].
-  apply nat_plus_reg_r with (sum (skipF x ord0)).
-  rewrite <- (sum_skipF x), H, <- (sum_skipF y); easy.
-simpl; rewrite !castF_id.
-destruct (IHn (skipF x ord0) (skipF y ord0) H2) as [H3 | H3].
-left; right; easy.
-right; right; easy.
-(* sum y < sum x *)
-right; simpl; left; easy.
-Qed.
-
-End lexico_MO.
-
-
-Section MI_defs.
-
-Definition Slice_op {d:nat} (i:nat)  
-      := fun alpha : 'nat^d => 
-          castF (add1n d) (concatF (singleF i) alpha).
-    (* of type 'nat^(d.+ 1) *)
-
-Lemma Slice_op_sum: forall d k i (alpha:'nat^d),
-   (i <= k)%coq_nat -> (sum alpha = k-i)%coq_nat -> sum (Slice_op i alpha) = k.
-Proof.
-intros dd k i alpha H0 H1; unfold Slice_op.
-rewrite sum_castF sum_concatF.
-rewrite sum_singleF H1.
-unfold singleF, constF.
-unfold plus; simpl; unfold m_plus; simpl.
-auto with arith zarith.
-Qed.
-
-(* exists unique, useful? *)
-Lemma Slice_op_correct : forall {d:nat} k (alpha: 'nat^(d.+1)),
-    sum alpha = k ->
-     exists (i:nat) (beta : 'nat^d),
-          (i <= k)%coq_nat /\ (sum beta = k-i)%coq_nat /\ Slice_op i beta =  alpha.
-Proof.
-intros d k alpha H.
-exists (alpha ord0).
-exists (liftF_S alpha); split; try split.
-(* *)
-apply sum_le_nat_le_one; try easy.
-now apply Nat.eq_le_incl.
-(* *)
-apply Arith_prebase.plus_minus_stt.
-rewrite <- H.
-rewrite -skipF_first.
-apply (sum_skipF alpha ord0).
-(* *)
-unfold Slice_op; apply extF; intros i; unfold castF; simpl.
-case (Nat.eq_0_gt_0_cases i); intros Hi.
-rewrite concatF_correct_l.
-simpl; rewrite Hi; auto with arith.
-intros V; simpl; rewrite singleF_0; f_equal.
-apply ord_inj; now simpl.
-rewrite concatF_correct_r.
-simpl; auto with arith.
-intros V; unfold liftF_S; simpl; f_equal.
-apply ord_inj; simpl; unfold bump; simpl; auto with arith.
-Qed.
-
-Definition Slice_fun {d n:nat} (u:nat) (a:'I_n -> 'nat^d) : 'I_n -> 'nat^(d.+1)
-   := mapF (Slice_op u) a.
-
-Lemma Slice_fun_skipF0: forall {d n} u (a:'I_n -> 'nat^d.+1) i,
-   skipF (Slice_fun u a i) ord0 = a i.
-Proof.
-intros d n u a i.
-unfold Slice_fun; rewrite mapF_correct; unfold Slice_op.
-apply extF; intros j.
-unfold skipF, castF, concatF.
-case (lt_dec _ _).
-intros V; contradict V.
-simpl; unfold bump; simpl; auto with arith.
-intros V; f_equal.
-apply ord_inj; simpl; unfold bump; simpl; auto with arith.
-Qed.
-
-Lemma MOn_Slice_fun_aux : forall {d n} u (alpha:'I_n -> 'nat^d)
-     (i j:'I_n), (i < j)%coq_nat ->
-     MOn (alpha i) (alpha j) -> 
-     MOn (Slice_fun u alpha i) (Slice_fun u alpha j).
-Proof.
-intros d; induction d.
-intros n u alpha i j H1 H; simpl in H.
-exfalso; easy.
-(* *)
-intros n u alpha i j H1 H'.
-assert (H'2 : MOn (alpha i) (alpha j)) by assumption.
-simpl in H'; rewrite castF_id in H'; case H'.
-intros H2.
-left.
-rewrite (Slice_op_sum _ (sum (alpha i)+u)%coq_nat u); auto with arith.
-rewrite (Slice_op_sum _ (sum (alpha j)+u)%coq_nat u); auto with arith.
-now rewrite Nat.add_sub.
-now rewrite Nat.add_sub.
-intros (H2,H3).
-right; rewrite castF_id; split.
-rewrite (Slice_op_sum _ (sum (alpha i)+u)%coq_nat u); auto with arith.
-rewrite (Slice_op_sum _ (sum (alpha j)+u)%coq_nat u); auto with arith.
-now rewrite Nat.add_sub.
-now rewrite Nat.add_sub.
-rewrite 2!Slice_fun_skipF0; easy.
-Qed.
-
-Lemma MOn_Slice_fun : forall {d n} u (alpha:'I_n -> 'nat^d),
-   sortedF MOn alpha -> sortedF MOn (Slice_fun u alpha).
-Proof.
-intros d n u alpha H i j H1.
-apply MOn_Slice_fun_aux; try easy.
-apply H; easy.
-Qed.
-
-(* was
-Lemma C_d_k_aux : forall (d k :nat),
-  sum (succF (fun i : 'I_k.+1 => (pbinom i d.-1)))
-     = (pbinom k (d.+1.-1)).+1.
-that is wrong for d=0 *)
-Lemma C_d_k_aux : forall (d dd k :nat) (H:d = dd.+1),
-  sum (succF (fun i : 'I_k.+1 => (pbinom i d.-1)))
-     = (pbinom k (d.+1.-1)).+1.
-Proof.
-intros d dd k H; subst; simpl.
-rewrite -(sum_ext (fun i => (pbinom i dd).+1)).
-rewrite pbinomS_rising_sum_r; easy.
-intros; rewrite succF_correct; easy.
-Qed.
-
-Lemma C_d_k_aux1 : forall (d k :nat),
-  sum (succF (fun i : 'I_k.+1 => (pbinom i d.+1.-1)))
-     = (pbinom k (d.+2.-1)).+1.
-Proof.
-intros d k.
-rewrite (C_d_k_aux d.+1 d k); try easy.
-Qed.
-
-Lemma C_d_k_aux2 : forall (d k:nat),
-  (sum (succF (fun i : 'I_k.+1 => pbinom i d))).-1 = pbinom k d.+1.
-Proof.
-intros d k.
-rewrite -(sum_ext (succF (fun i => pbinom i (d.+1.-1)))); try easy.
-rewrite (C_d_k_aux d.+1 d k); try easy.
-Qed.
-
-(* \cal C^d_k *)
-Fixpoint C_d_k (d k :nat) {struct d} : 'I_((pbinom k d.-1).+1) -> 'nat^d
-   := match d with
-    | O    => fun _ _ => 0
-    | S dd => match dd as n return (dd = n -> _) with
-               | O => fun H => fun _ _ => k
-               | S ddd => fun H => castF (C_d_k_aux dd ddd k H)
-                    (concatnF (fun i:'I_k.+1 => Slice_fun (k-i)%coq_nat (C_d_k dd i)))
-               end erefl
-     end.
-
-(* when d=0 it is 'I_1 -> 'nat^0 *)
-
-(* TODO SB : 1) virer d=0 pour déf de C_d_k et patcher A
-             2) changer taille de C pour d=k=0 1 ; sinon 0
-*)
-
-Lemma C_0_k_eq : forall k, C_d_k 0 k = fun _ _ => 0.
-Proof.
-easy.
-Qed.
-
-Lemma C_1_k_eq : forall k, C_d_k 1 k = fun _ _ => k.
-Proof.
-easy.
-Qed.
-
-Lemma C_d_k_eq : forall d k,
-  C_d_k d.+2 k = castF (C_d_k_aux1 d k)
-                    (concatnF (fun i:'I_k.+1 => Slice_fun (k-i)%coq_nat (C_d_k d.+1 i))).
-Proof.
-intros d k.
-apply extF; intros i; simpl; unfold castF; f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma C_d_k_ext : forall d k1 k2 i1 i2, 
-    k1 = k2 -> nat_of_ord i1 = nat_of_ord i2 ->
-       C_d_k d k1 i1 = C_d_k d k2 i2.
-Proof.
-intros d k1 k2 i1 i2 Hk Hi; subst.
-f_equal; apply ord_inj; easy.
-Qed.
-
-Lemma C_d_k_sum : forall d k i, (0 < d)%coq_nat -> sum (C_d_k d k i) = k.
-Proof.
-intros d; case d.
-intros k i H; contradict H; auto with arith.
-clear d; intros d k i _; generalize k i; clear k i; induction d.
-intros k i.
-rewrite sum_1.
-rewrite C_1_k_eq; easy.
-(* *)
-intros k i.
-rewrite C_d_k_eq.
-unfold castF.
-rewrite (splitn_ord (cast_ord (eq_sym (C_d_k_aux1 d k)) i)).
-rewrite concatn_ord_correct.
-unfold Slice_fun; rewrite mapF_correct.
-apply Slice_op_sum.
-auto with arith zarith.
-rewrite IHd.
-assert (splitn_ord1
-  (cast_ord (eq_sym (C_d_k_aux1 d k)) i)< k.+1)%coq_nat.
-apply /ltP; easy.
-auto with arith zarith.
-apply eq_sym, Nat.add_sub_eq_l.
-auto with arith zarith.
-Qed.
-
-Lemma C_d_0_eq : forall d, C_d_k d 0 = fun _ => constF d 0.
-Proof.
-intros d; case d.
-rewrite C_0_k_eq; easy.
-clear d; intros d.
-apply extF; intros i.
-apply extF; intros j.
-rewrite constF_correct.
-assert (V: sum (C_d_k d.+1 0 i) = 0).
-apply C_d_k_sum; auto with arith.
-case_eq (C_d_k d.+1 0 i j); try easy.
-intros m Hm.
-absurd (1 <= sum (C_d_k d.+1 0 i))%coq_nat.
-rewrite V; auto with arith.
-apply Nat.le_trans with (2:=sum_le_one_nat _ j).
-rewrite Hm; auto with arith.
-Qed.
-
-Lemma C_d_1_eq_aux : forall d, (0 < d)%coq_nat -> d = (pbinom 1 d.-1).+1.
-Proof.
-intros d Hd; rewrite pbinomS_1_l; auto with zarith.
-Qed.
-
-Lemma C_d_1_eq : forall d (Hd: (0 < d)%coq_nat),
-  C_d_k d 1 =  castF (C_d_1_eq_aux d Hd) (itemF d 1).
-Proof.
-intros d; case d.
-intros Hd; contradict Hd; auto with arith.
-clear d; intros d Hd; induction d.
-rewrite C_1_k_eq.
-apply extF; intros i; apply extF; intros j.
-rewrite !ord1; unfold castF.
-rewrite itemF_correct_l; try easy.
-apply ord_inj; easy.
-(* *)
-rewrite C_d_k_eq; auto with arith.
-rewrite concatnF_two.
-2: apply (inhabits zero).
-simpl (nat_of_ord ord0); simpl (nat_of_ord ord_max).
-replace (1-0)%coq_nat with 1 by auto with arith.
-replace (1-1)%coq_nat with 0 by auto with arith.
-rewrite C_d_0_eq IHd.
-rewrite (itemF_ind_l d.+1).
-rewrite castF_comp.
-apply: concatF_castF_eq.
-apply pbinomS_0_l.
-apply pbinomS_1_l.
-intros K1; apply extF; intros i; unfold castF, Slice_fun; simpl.
-rewrite mapF_correct; unfold Slice_op.
-unfold singleF; rewrite constF_correct.
-unfold itemF.
-apply extF; intros j; unfold castF.
-case (ord_eq_dec j ord0); intros Hj.
-rewrite replaceF_correct_l; try easy.
-rewrite concatF_correct_l; try easy.
-rewrite Hj; simpl; auto with arith.
-rewrite replaceF_correct_r; try easy.
-rewrite concatF_correct_r; try easy.
-simpl; assert (nat_of_ord j <> 0)%coq_nat; auto with arith.
-intros T; apply Hj; apply ord_inj; easy.
-apply Nat.le_ngt; auto with zarith.
-intros K1; rewrite mapF_correct.
-apply extF; intros i.
-unfold castF, Slice_fun; simpl.
-rewrite mapF_correct; unfold Slice_op.
-apply extF; intros j; unfold castF.
-f_equal.
-f_equal.
-apply ord_inj; easy.
-apply ord_inj; easy.
-Qed.
-
-Lemma C_d_k_head : forall d k,
-   C_d_k d.+1 k ord0 = itemF d.+1 k ord0.
-Proof.
-intros d; induction d.
-intros k; rewrite C_1_k_eq.
-apply extF; intros i.
-unfold itemF, replaceF; simpl.
-rewrite ord1; case (ord_eq_dec _ _); easy.
-intros k; rewrite C_d_k_eq.
-unfold castF; apply extF; intros i.
-rewrite concatnF_splitn_ord.
-unfold Slice_fun; rewrite mapF_correct; unfold Slice_op, castF.
-rewrite splitn_ord2_0; try easy; auto with arith.
-rewrite IHd.
-rewrite splitn_ord1_0; try easy; auto with arith.
-case (ord_eq_dec i ord0); intros Hi.
-rewrite Hi concatF_correct_l singleF_0.
-rewrite itemF_diag; simpl; auto with arith.
-rewrite concatF_correct_r.
-simpl; intros V; apply Hi; apply ord_inj; simpl; auto with zarith.
-intros K.
-rewrite itemF_zero_compat; try easy.
-rewrite fct_zero_eq.
-rewrite itemF_correct_r; try easy.
-Qed.
-
-Lemma C_d_k_last : forall d k,
-   C_d_k d.+1 k ord_max = itemF d.+1 k ord_max.
-Proof.
-intros d; induction d.
-intros k; rewrite C_1_k_eq.
-apply extF; intros i.
-unfold castF; simpl; rewrite 2!ord1; simpl.
-rewrite itemF_diag; try easy.
-(* *)
-intros k; rewrite C_d_k_eq.
-generalize (C_d_k_aux2 d k); intros H1.
-unfold castF.
-rewrite concatnF_splitn_ord.
-rewrite splitn_ord2_max; try easy.
-unfold Slice_fun, Slice_op; rewrite mapF_correct.
-rewrite IHd.
-replace ((k -
-   splitn_ord1
-     (cast_ord (eq_sym (C_d_k_aux1 d k)) ord_max))) with 0 at 1.
-unfold castF; apply extF; intros i.
-rewrite splitn_ord1_max; simpl; try easy.
-case (ord_eq_dec i ord_max); intros Hi.
-rewrite Hi concatF_correct_r.
-simpl; auto with zarith.
-intros K; replace (concat_r_ord K) with (ord_max:'I_d.+1).
-rewrite 2!itemF_diag; simpl; auto with arith.
-apply ord_inj; simpl; auto with arith.
-rewrite itemF_correct_r; try easy.
-case (ord_eq_dec i ord0); intros Hi2.
-rewrite Hi2; rewrite concatF_correct_l; try easy.
-rewrite concatF_correct_r; try easy.
-simpl; intros V; apply Hi2; apply ord_inj; simpl; auto with zarith.
-intros K; rewrite itemF_correct_r; try easy.
-apply ord_neq; simpl; rewrite -minusE; intros V; apply Hi.
-apply ord_inj; simpl.
-assert (nat_of_ord i <> 0); auto with zarith arith.
-intros V'; apply Hi2; apply ord_inj; easy.
-rewrite splitn_ord1_max; simpl; try easy; auto with arith.
-Qed.
-
-Lemma C_d_k_MOn_aux : forall {n} (A B :'nat^n.+1) i,
-   sum A = sum B -> (B i < A i)%coq_nat -> 
-     (sum (skipF A i) < sum (skipF B i))%coq_nat.
-Proof.
-intros n A B i H1 H2.
-apply Nat.add_lt_mono_l with (A i).
-apply Nat.le_lt_trans with (sum A).
-rewrite (sum_skipF A i); unfold plus; simpl; auto with arith.
-rewrite H1; rewrite (sum_skipF B i).
-unfold plus; simpl.
-apply Nat.add_lt_mono_r; auto with arith.
-Qed.
-
-Lemma C_d_k_MOn : forall d k, (0 < d)%coq_nat -> sortedF MOn (C_d_k d k).
-Proof.
-intros d; case d.
-intros k H; contradict H; auto with arith.
-clear d; intros d k _; generalize k; clear k; induction d.
-intros k; apply (sortedF_castF_rev (pbinomS_0_r _)).
-intros i j H.
-contradict H; rewrite 2!ord1; auto with arith.
-(* *)
-intros k; rewrite C_d_k_eq.
-apply sortedF_castF.
-apply concatnF_order.
-apply MOn_trans.
-intros i.
-apply MOn_Slice_fun.
-apply IHd.
-intros i Him.
-unfold Slice_fun, Slice_op; rewrite 2!mapF_correct.
-rewrite C_d_k_head.
-rewrite C_d_k_last.
-right.
-rewrite castF_id.
-assert (i < k)%coq_nat.
-assert (nat_of_ord i <> k)%coq_nat.
-intros V; apply Him.
-apply ord_inj; rewrite V; simpl; auto with arith.
-assert (i < k.+1)%coq_nat; try auto with zarith.
-apply /ltP; easy.
-split.
-(* . *)
-rewrite (Slice_op_sum _ k); try auto with arith zarith.
-rewrite (Slice_op_sum _ k); try auto with arith zarith.
-rewrite sum_itemF.
-simpl; rewrite bump_r; auto with zarith.
-rewrite sum_itemF; simpl; auto with arith zarith.
-(* . *)
-left.
-apply C_d_k_MOn_aux.
-rewrite (Slice_op_sum _ k); try auto with zarith.
-rewrite (Slice_op_sum _ k); try auto with zarith.
-rewrite sum_itemF.
-simpl; rewrite bump_r; auto with zarith arith.
-rewrite sum_itemF; simpl; auto with zarith.
-unfold castF.
-rewrite 2!concatF_correct_l; simpl.
-rewrite 2!singleF_0.
-rewrite bump_r; auto with zarith.
-Qed.
-
-Lemma C_d_k_surj : forall d k,  forall b : 'nat^d, 
-   (0 < d)%coq_nat ->
-    sum b = k -> exists i, b = C_d_k d k i.
-Proof.
-intros d; case d; clear d.
-intros k b H; contradict H; auto with arith.
-intros d k b _; generalize k b; clear k b; induction d.
-intros k b.
-rewrite sum_1; intros H.
-exists ord0.
-rewrite C_1_k_eq.
-apply extF; intros i.
-rewrite ord1; easy.
-(* *)
-intros k b Hb.
-destruct (Slice_op_correct k b Hb) as (u,(beta,(Hu1,(Hu2,Hu3)))).
-destruct (IHd (k-u)%coq_nat beta Hu2) as (i1,Hi1).
-rewrite C_d_k_eq.
-assert (Vu : (k - u < k.+1)).
-apply /ltP; rewrite -minusE; auto with arith zarith.
-assert (K : ((sum (succF (fun i : 'I_k.+1 => pbinom i d))) = 
-           (pbinom k (d.+2.-1)).+1)).
-rewrite -C_d_k_aux2.
-assert (T: (0 < sum (succF (fun i : 'I_k.+1 => pbinom i d)))%coq_nat).
-apply Nat.lt_le_trans with ((pbinom 0 d).+1); auto with arith.
-apply (sum_le_one_nat (succF (fun i : 'I_k.+1 => pbinom i d)) ord0).
-generalize T; case (sum (succF (fun i : 'I_k.+1 => pbinom i d))); auto with zarith arith.
-exists (cast_ord K (concatn_ord _ (Ordinal Vu) i1)).
-apply extF; intros z; unfold castF.
-rewrite (concatn_ord_correct' _ _ (Ordinal Vu) i1).
-2: now simpl.
-rewrite -Hu3 Hi1.
-unfold Slice_fun; rewrite mapF_correct; unfold Slice_op.
-unfold castF; f_equal; f_equal; simpl.
-apply eq_sym, Nat.add_sub_eq_l; auto with arith zarith.
-apply Nat.sub_add; easy.
-Qed.
-
-Lemma A_d_k_aux : forall d k dd, (d = dd.+1) ->
-   sum (fun i : 'I_k.+1 => (pbinom i (d.-1)).+1)
-        = (pbinom d k).+1.
-Proof.
-intros d k dd H; rewrite C_d_k_aux1; subst; simpl.
-apply pbinomS_sym.
-Qed.
-
-(** "Livre Vincent Definition 1575 - p24." *)
-Definition A_d_k (d k :nat) : 'I_((pbinom d k).+1) -> 'nat^d
-  := match d as n return (d = n -> _) with
-    | 0 => fun H => zero
-    | S dd => fun H => castF (A_d_k_aux d k dd H)
-        (concatnF (fun i:'I_k.+1 => C_d_k d i))
-   end erefl.
-
-(** "Livre Vincent Lemma 1585 - p28." *)
-Lemma A_0_k_eq : forall k, A_d_k O k = zero.
-Proof.
-intros k; easy.
-Qed.
-
-Lemma A_d_Sk_eq_aux : forall d k, 
-    ((pbinom d.+1 k).+1 +
-        (pbinom k.+1 d).+1)%coq_nat =
-        (pbinom d.+1 k.+1).+1.
-Proof.
-intros d k.
-rewrite (pbinomS_sym k.+1) Nat.add_comm.
-apply pbinomS_pascal.
-Qed.
-
-Lemma A_d_Sk_eq : forall d k,
-    A_d_k d.+1 k.+1 
-       = castF (A_d_Sk_eq_aux d k) (concatF (A_d_k d.+1 k)  (C_d_k d.+1 k.+1)).
-Proof.
-intros d k; unfold A_d_k.
-rewrite concatnF_ind_r.
-rewrite castF_comp.
-apply: concatF_castF_eq.
-apply A_d_k_aux with d; easy.
-intros K.
-apply extF; intros i; unfold castF; f_equal.
-apply ord_inj; easy.
-now rewrite castF_id.
-Qed.
-
-Lemma A_d_k_ext : forall d k1 k2 i1 i2, 
-    k1 = k2 -> nat_of_ord i1 = nat_of_ord i2 ->
-       A_d_k d k1 i1 = A_d_k d k2 i2.
-Proof.
-intros d k1 k2 i1 i2 Hk Hi; subst.
-f_equal; apply ord_inj; easy.
-Qed.
-
-Lemma A_d_1_eq_aux : forall d, (1 + d = (pbinom d 1).+1).
-Proof.
-intros d.
-rewrite pbinomS_1_r; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1585 - p28." *)
-Lemma A_d_1_eq : forall d,
-     A_d_k d 1 = castF (A_d_1_eq_aux d) 
-              (concatF (singleF (constF d 0)) (* could be "zero"  *)
-                       (itemF d 1)).
-Proof.
-intros d; case d.
-(* equal when d=0 thanks to definitions *)
-rewrite A_0_k_eq; simpl.
-apply extF; intros i; unfold castF, singleF, constF.
-rewrite concatF_nil_r.
-unfold castF; simpl; easy.
-(* *)
-clear d; intros d.
-unfold A_d_k, singleF.
-rewrite concatnF_two.
-2: apply (inhabits zero).
-rewrite C_d_0_eq.
-rewrite C_d_1_eq.
-rewrite castF_comp.
-(*apply: concatF_castF_eq.*)
-assert (K: (pbinom 0 d.+1.-1).+1 = 1) by apply pbinomS_0_l.
-apply concatF_castF_eq with (H3:=K)
-  (H4:= eq_sym ((C_d_1_eq_aux d.+1 (Nat.lt_0_succ d)))).
-unfold constF; easy.
-apply extF; intros i; unfold castF; f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma A_d_1_neq0 : forall d ipk (H : ipk <> ord0),
-   A_d_k d 1 ipk = itemF d 1 (cast_ord (pbinom_1_r d) (lower_S H)).
-Proof.
-intros d ipk H.
-rewrite A_d_1_eq; unfold castF.
-rewrite concatF_correct_r.
-simpl; intros K; apply H.
-apply ord_inj; simpl; auto with zarith.
-intros K; f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma A_d_k_sum : forall d k i,
-    (sum (A_d_k d k i) <= k)%coq_nat.
-Proof.
-intros d; case d; clear d.
-intros k i; rewrite A_0_k_eq.
-rewrite sum_zero; simpl; auto with arith.
-intros d k i.
-unfold A_d_k, castF.
-rewrite (splitn_ord (cast_ord (eq_sym (A_d_k_aux d.+1 k d _)) i)).
-rewrite concatn_ord_correct.
-rewrite C_d_k_sum; auto with arith.
-assert ( splitn_ord1
-   (cast_ord (eq_sym (A_d_k_aux d.+1 k d (erefl d.+1))) i)< k.+1)%coq_nat; auto with arith.
-apply /ltP; easy.
-Qed.
-
-Lemma A_d_k_le : forall d k i j,
-    (A_d_k d k i j <= k)%coq_nat.
-Proof.
-intros d k i j.
-apply Nat.le_trans with (2:= A_d_k_sum d k i).
-apply sum_le_one_nat.
-Qed.
-
-Lemma A_d_k_surj : forall d k (b:'nat^d),
-   (sum b <= k)%coq_nat -> exists i, b = A_d_k d k i.
-Proof.
-intros d; case d; clear d.
-intros k b H.
-exists ord0.
-apply extF; intros [i Hi]; easy.
-(* *)
-intros d k b Hb.
-destruct (C_d_k_surj d.+1 (sum b) b) as(j,Hj); try auto with arith.
-assert (V: (sum b < k.+1)).
-apply /ltP; auto with arith.
-exists (cast_ord (A_d_k_aux d.+1 k d (erefl d.+1))
-      (concatn_ord (fun i : 'I_k.+1 => (pbinom i (d.+1.-1)).+1) 
-            (Ordinal V) j)).
-unfold A_d_k, castF.
-rewrite cast_ord_comp; unfold etrans; rewrite cast_ord_id.
-rewrite concatn_ord_correct.
-easy.
-Qed.
-
-Lemma A_d_k_MOn : forall d k,
-    sortedF MOn (A_d_k d k).
-Proof.
-intros d; case d; clear d.
-intros k; apply (sortedF_castF_rev (pbinomS_0_l _)).
-intros i j H.
-contradict H; rewrite !ord1; easy.
-(* *)
-intros d k; unfold A_d_k.
-apply sortedF_castF.
-apply concatnF_order.
-apply MOn_trans.
-intros i; apply C_d_k_MOn; auto with arith.
-intros i Him.
-apply sum_lt_MOn.
-rewrite C_d_k_sum; auto with arith.
-rewrite C_d_k_sum; auto with arith.
-Qed.
-
-Lemma A_d_k_inj :  forall d k,
-    injective (A_d_k d k).
-Proof.
-intros d k; apply sortedF_inj with MOn.
-apply MOn_irrefl.
-apply A_d_k_MOn.
-Qed.
-
-Definition A_d_k_inv (d k:nat) (b:'nat^d) : 'I_((pbinom d k).+1) :=
-   match (le_dec (sum b) k) with
-     | left H => 
-        proj1_sig (ex_EX _ (A_d_k_surj d k b H))
-     | right _ => ord0
-   end.
-
-Lemma A_d_k_inv_correct_r : forall d k (b:'nat^d),
-   (sum b <= k)%coq_nat ->
-     A_d_k d k (A_d_k_inv d k b) = b.
-Proof.
-intros d k b H; unfold A_d_k_inv.
-case (le_dec (sum b) k); try easy.
-intros H'.
-destruct (ex_EX _ _) as (i,Hi); easy.
-Qed.
-
-Lemma A_d_k_inv_correct_l : forall d k i, 
-   A_d_k_inv d k (A_d_k d k i) = i.
-Proof.
-intros d k i; unfold A_d_k_inv.
-case (le_dec _ k); intros H; simpl.
-destruct (ex_EX _ _) as (j,Hj); try easy.
-simpl; apply A_d_k_inj; easy.
-contradict H; apply A_d_k_sum.
-Qed.
-
-Lemma A_d_k_0 : forall d k, 
-  A_d_k d k ord0 = zero.
-Proof.
-intros d k; unfold A_d_k; case d; try easy.
-clear d; intros d; unfold castF; rewrite concatnF_splitn_ord.
-rewrite splitn_ord2_0; try easy.
-rewrite splitn_ord1_0; try easy.
-rewrite C_d_0_eq; easy.
-Qed.
-
-(** "Livre Vincent Definition 1540 - p18." *)
-Lemma A_1_k_eq' : forall k,
-  A_d_k 1 k = fun i j => i.
-Proof.
-intros k; induction k.
-apply extF; intros i; apply extF; intros j.
-unfold A_d_k, castF; rewrite concatnF_one.
-2: apply (inhabits zero).
-rewrite C_d_0_eq; unfold castF; simpl.
-rewrite constF_correct.
-rewrite ord1; easy.
-(* *)
-apply extF; intros i; apply extF; intros j.
-rewrite A_d_Sk_eq; unfold castF.
-rewrite IHk C_1_k_eq.
-case (ord_eq_dec i ord_max); intros Hi.
-rewrite concatF_correct_r.
-rewrite Hi; simpl.
-rewrite pbinom_1_l pbinomS_1_l; auto with arith.
-rewrite Hi; simpl.
-rewrite pbinom_1_l; easy.
-rewrite concatF_correct_l; try easy.
-simpl.
-replace _.+1 with k.+1 by now rewrite pbinomS_1_l.
-apply Nat.lt_succ_r, nat_le_S_neq.
-apply Nat.lt_succ_r; apply /ltP.
-rewrite -(pbinomS_1_l k.+1); easy.
-contradict Hi; apply ord_inj; rewrite Hi.
-rewrite pbinom_1_l; easy.
-Qed.
-
-(** "Livre Vincent Definition 1540 - p18." *)
-Lemma A_1_k_eq : forall k,
-  A_d_k 1 k = constF 1.
-Proof.
-intros k; apply extF; intros i; apply extF; intros j.
-rewrite constF_correct.
-unfold A_d_k, castF.
-rewrite concatnF_splitn_ord C_1_k_eq.
-assert (H: (pbinom 1 k).+1 = k.+1) by apply pbinomS_1_l.
-apply trans_eq with (nat_of_ord (cast_ord H i)); try easy; f_equal.
-(* *)
-assert (K: i < sum (succF (fun i:'I_k.+1 => (pbinom i 1.-1)))).
-simpl.
-rewrite (sum_eq _ (constF _ 1)).
-rewrite sum_constF_nat Nat.mul_1_r.
-rewrite -(pbinomS_1_l k); easy.
-apply extF; intros z; rewrite constF_correct.
-rewrite succF_correct.
-apply pbinomS_0_r.
-apply splitn_ord1_inj with (k:= Ordinal K).
-replace (nat_of_ord (Ordinal K))
-  with (nat_of_ord (cast_ord (eq_sym (A_d_k_aux 1 k 0 (erefl 1))) i)); try easy.
-apply splitn_ord1_correct.
-simpl; split; unfold sum_part.
-rewrite (sum_eq _ (constF _ 1)).
-rewrite sum_constF_nat.
-simpl; auto with zarith.
-simpl; apply extF; intros z.
-rewrite constF_correct.
-unfold castF_nip, firstF, castF; simpl.
-rewrite succF_correct; simpl.
-apply pbinomS_0_r.
-rewrite (sum_eq _ (constF _ 1)).
-rewrite sum_constF_nat.
-simpl; auto with zarith.
-simpl; apply extF; intros z.
-rewrite constF_correct.
-unfold castF_nip, firstF, castF; simpl.
-rewrite succF_correct; simpl.
-apply pbinomS_0_r.
-Qed.
-
-Lemma A_d_k_last_layer : forall d k ipk,
-   (0 < d)%coq_nat -> (0 < k)%coq_nat ->
-   (sum (A_d_k d k ipk) = k)%coq_nat <-> 
-      ((pbinom d k.-1).+1 <= ipk)%coq_nat.
-Proof.
-intros d; case d; try easy; clear d.
-intros d k ; case k; try easy; clear k.
-intros k i _ _ ; unfold A_d_k; unfold castF.
-pose (i':=(cast_ord (eq_sym (A_d_k_aux d.+1 k.+1 d (erefl d.+1))) i)).
-assert (Hi : nat_of_ord i = nat_of_ord i') by easy.
-rewrite (sum_ext _ (concatnF (C_d_k d.+1) i')).
-2: intros j; easy.
-rewrite concatnF_splitn_ord.
-rewrite C_d_k_sum; auto with arith.
-split; intros H.
-destruct (splitn_ord1_correct i') as (Y1,_).
-rewrite Hi.
-apply Nat.le_trans with (2:=Y1).
-apply Nat.add_le_mono_r with ((pbinom (splitn_ord1 i') d.+1.-1).+1).
-apply Nat.eq_le_incl.
-generalize (sum_part_ind_r (fun i0 : 'I_k.+2 => (pbinom i0 d.+1.-1).+1) 
-    (splitn_ord1 i')); unfold plus; simpl(AbelianMonoid.plus _ _).
-intros T; rewrite -T; clear T.
-replace (lift_S (splitn_ord1 i')) with (ord_max:'I_k.+3).
-rewrite sum_part_ord_max.
-rewrite (A_d_k_aux d.+1 k.+1 d (erefl d.+1)) H.
-rewrite -pbinomS_pascal Nat.add_comm pbinomS_sym; easy. 
-apply ord_inj.
-rewrite lift_S_correct H; easy.
-(* *)
-apply trans_eq with (nat_of_ord (ord_max:'I_k.+2)); try easy; f_equal.
-apply splitn_ord1_inj with i'.
-apply splitn_ord1_correct.
-split.
-rewrite -Hi.
-apply Nat.le_trans with (2:=H).
-apply Nat.add_le_mono_r with ((pbinom (ord_max:'I_k.+2) d.+1.-1).+1).
-apply Nat.eq_le_incl.
-generalize (sum_part_ind_r (fun i0 : 'I_k.+2 => (pbinom i0 d.+1.-1).+1) 
-    (ord_max)); unfold plus; simpl(AbelianMonoid.plus _ _).
-intros T; rewrite -T; clear T.
-replace (lift_S (ord_max)) with (ord_max:'I_k.+3).
-2: apply ord_inj; easy.
-rewrite sum_part_ord_max.
-rewrite (A_d_k_aux d.+1 k.+1 d (erefl d.+1)).
-rewrite -pbinomS_pascal Nat.add_comm pbinomS_sym; easy.
-replace (lift_S ord_max) with (ord_max:'I_k.+3).
-2: apply ord_inj; easy.
-rewrite sum_part_ord_max.
-rewrite -Hi.
-apply Nat.lt_le_trans with ((pbinom d.+1 k.+1).+1).
-apply /ltP; easy.
-apply Nat.eq_le_incl.
-rewrite -(A_d_k_aux d.+1 k.+1 d (erefl d.+1)).
-apply sum_ext; easy.
-Qed.
-
-Lemma A_d_k_previous_layer : forall d k i1 (i2 : 'I_(pbinom d k).+1),
-      nat_of_ord i1 = i2 ->
-        A_d_k d k.-1 i1 = A_d_k d k i2.
-Proof.
-intros d; case d; clear d.
-intros k i1 i2 H.
-rewrite 2!A_0_k_eq; easy.
-intros d k; case k; clear k.
-intros i1 i2 H.
-apply A_d_k_ext; easy.
-intros k i1 i2 H.
-rewrite A_d_Sk_eq; unfold castF.
-rewrite concatF_correct_l.
-simpl; rewrite -H.
-apply /ltP; easy.
-intros K; f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma A_d_k_kron : forall d k i,
-  mapF INR (A_d_k d k (A_d_k_inv d k (itemF d k i))) =
-    (fun j => (INR k * kronecker i j)%R).
-Proof.
-intros d k i.
-rewrite A_d_k_inv_correct_r.
-rewrite -itemF_kronecker_eq.
-apply mapF_itemF_0; easy.
-rewrite sum_itemF; easy.
-Qed.
-
-End MI_defs.
diff --git a/FEM/poly_Lagrange_new.v b/FEM/poly_Lagrange_new.v
deleted file mode 100644
index ee4e40120a1029c8e5e04c81d25344224c61b69f..0000000000000000000000000000000000000000
--- a/FEM/poly_Lagrange_new.v
+++ /dev/null
@@ -1,2165 +0,0 @@
-(**
-This file is part of the Elfic 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.
-*)
-
-From FEM.Compl Require Import stdlib.
-From Coq Require Import Reals Lra.
-
-Set Warnings "-notation-overridden".
-From FEM.Compl Require Import ssr.
-
-(* Next import provides Reals, Coquelicot.Hierarchy, functions to module spaces,
- and linear mappings. *)
-From LM Require Import linear_map.
-Set Warnings "notation-overridden".
-
-From Lebesgue Require Import Function.
-
-From FEM Require Import Compl Algebra binomial_compl geometry multi_index_new.
-
-
-Local Open Scope R_scope.
-
-
-Section R_compl.
-
-Lemma P_INR : forall n : nat, (0 < n)%coq_nat ->
-  INR n.-1 = INR n - 1.
-Proof.
-intros n Hn.
-replace (n.-1) with (n - 1)%coq_nat; auto with zarith.
-rewrite minus_INR; auto with arith.
-Qed.
-
-Lemma INR_inv_eq : forall n : nat, (0 < n)%coq_nat ->
-  / INR n = (1 - INR n.-1 / INR n)%G.
-Proof.
-intros n Hn.
-replace 1 with (INR n * / INR n).
-unfold minus; simpl.
-unfold plus, opp; simpl.
-apply trans_eq with ((INR n - INR n.-1) / INR n). 
-assert (H : INR n - INR n.-1 = 1).
-rewrite P_INR; try easy; ring.
-rewrite H.
-field.
-apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith.
-rewrite P_INR; auto with arith.
-rewrite RIneq.Rdiv_minus_distr.
-unfold Rdiv.
-field.
-apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith.
-field.
-apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith.
-Qed. 
-
-Lemma Rmult_0_reg_r : forall a b : R, a <> 0 -> a * b = 0 -> b = 0.
-Proof.
-intros a b Ha H; destruct (mult_zero_rev_l _ _ H) as [Ha' | ]; try easy.
-contradict Ha'; apply invertible_equiv_R; easy.
-Qed.
-
-End R_compl.
-
-
-Section vertices_nodes_k_d.
-
-Variable d k : nat.
-
-Hypothesis k_pos : (0 < k)%coq_nat.
-
-Definition vtx_simplex_ref : '('R^d)^(S d) :=
-  fun i => match (ord_eq_dec i ord0) with
-    | left _ => zero
-    | right H => kronecker (i - 1)%coq_nat
-    end.
-
-(* TODO do we need all these hypotheses ? 
-  oui car kronecker peut etre egale a 0 aussi.*)
-Lemma vtx_simplex_ref_0: forall (i : 'I_d.+1) (j : 'I_d), 
-  i = ord0 \/ (i <> ord0 /\ (i - 1)%coq_nat <> j) ->
-     vtx_simplex_ref i j = 0.
-Proof.
-intros  i j H. 
-destruct H as [H|(H1,H2)]; unfold vtx_simplex_ref.
-case (ord_eq_dec i ord0); try easy.
-case (ord_eq_dec i ord0); try easy.
-intros; now apply kronecker_is_0.
-Qed.
-
-Lemma vtx_simplex_ref_neq0 : forall (i : 'I_d.+1) (j : 'I_d), 
-  (i <> ord0)%coq_nat -> (i - 1)%coq_nat = j ->
-      vtx_simplex_ref i j = 1.
-Proof.
-intros i j H1 H2; unfold vtx_simplex_ref.
-case (ord_eq_dec i ord0); try easy; intros _.
-now apply kronecker_is_1.
-Qed.
-
-Lemma vtx_simplex_ref_affine_ind : affine_independent vtx_simplex_ref.
-Proof.
-intros L; unfold liftF_S, vtx_simplex_ref, constF; simpl.
-intros HL. 
-assert (H1 : comb_lin L
-       ((fun i j : 'I_d => kronecker i j) -
-        (fun=> 0%M))%G = 0%M).
-rewrite -HL.
-apply comb_lin_eq; try easy.
-f_equal.
-apply fun_ext; intros i.
-apply fun_ext; intros j.
-destruct (ord_eq_dec (lift_S i) ord0) as [Hi | Hi]; try easy.
-auto with zarith.
-apply fun_ext; intros i.
-destruct (ord_eq_dec ord0 ord0) as [Hi | Hi]; try easy.
-rewrite minus_zero_r in H1.
-rewrite -comb_lin_kronecker_basis in H1; easy.
-Qed.
-
-(* "a_alpha = v_0 + \sum (alpha_i / k) (v_i - v_0)" *)
-(* the choice for ord0 is arbitrary, it could be any k : 'I_d.+1 *)
-(** "Livre Vincent Definition 1642 - p47." *)
-Definition node_cur  (vtx_cur : '('R^d)^(S d)) :
- '('R^d)^((pbinom d k).+1) := fun (ipk : 'I_((pbinom d k).+1)) =>
-  (vtx_cur ord0 +
-    comb_lin (scal (/ INR k) (mapF INR (A_d_k d k ipk)))
-  (liftF_S vtx_cur - constF d (vtx_cur ord0))%G)%M.
-
-(* " a_alpha = (1 - |alpha|/k) v_0 + \sum (alpha_i / k) v_i " *)
-(** "Livre Vincent Lemma 1644 - p47." *)
-Definition node_cur_aux (vtx_cur : '('R^d)^(S d))
-  : 'R^{(pbinom d k).+1,d} := 
-  fun (ipk : 'I_((pbinom d k).+1)) =>
-    ((scal (1 - (comb_lin (scal (/ INR k) 
-      (mapF INR (A_d_k d k ipk))) ones))%G (vtx_cur ord0)) + 
-    comb_lin (scal (/ INR k) (mapF INR (A_d_k d k ipk))) 
-      (liftF_S vtx_cur))%M.
-
-Definition node_ref := fun (ipk : 'I_((pbinom d k).+1)) 
-  (i : 'I_d) =>
-  INR (A_d_k d k ipk i) / INR k.
-
-Definition node_ref_aux := node_cur_aux vtx_simplex_ref.
-
-Lemma node_ref_eq : 
-  node_ref = node_ref_aux.
-Proof.
-(* TODO : prove this lemma from node_cur_eq *)
-unfold node_ref, node_ref_aux, node_cur_aux.
-apply extF; intros ipk.
-rewrite (comb_lin_ext_r (scal (/ INR k) (mapF INR (A_d_k d k ipk)))
-   (liftF_S vtx_simplex_ref) kronecker).
-rewrite -comb_lin_kronecker_basis.
-apply extF; intros i.
-rewrite fct_plus_eq fct_scal_eq.
-rewrite vtx_simplex_ref_0; try easy.
-rewrite scal_zero_r plus_zero_l.
-unfold Rdiv.
-unfold scal; simpl.
-unfold fct_scal; simpl.
-unfold scal; simpl.
-rewrite mult_comm_R.
-unfold mult; simpl; f_equal.
-left; easy.
-intros i; unfold liftF_S, vtx_simplex_ref.
-destruct (ord_eq_dec (lift_S i) ord0) as [H | H]; try easy.
-apply extF; intros j; f_equal; simpl; auto with zarith.
-Qed.
-
-Lemma node_cur_eq : forall (vtx_cur : '('R^d)^(S d)),
-    affine_independent vtx_cur ->
-  node_cur vtx_cur = node_cur_aux vtx_cur.
-Proof.
-intros vtx_cur Hvtx.
-unfold node_cur, node_cur_aux, constF.
-apply fun_ext; intros ipk.
-rewrite comb_lin_minus_r.
-replace (scal (1 - comb_lin _ _)%G _) with 
-  (vtx_cur ord0 -
-  comb_lin
-    (scal (/ INR k) (mapF INR (A_d_k d k ipk)))
-    (fun=> vtx_cur ord0))%G.
-rewrite (plus_comm (vtx_cur ord0 - comb_lin (scal (/ INR k) (mapF INR (A_d_k d k ipk)))
-    (fun=> vtx_cur ord0))%G).
-rewrite 2!plus_assoc.
-f_equal.
-apply plus_comm.
-unfold scal at 2; simpl.
-rewrite comb_lin_ones_r.
-apply fun_ext; intros i. 
-rewrite fct_minus_eq fct_comb_lin_r_eq.
-unfold scal; simpl.
-unfold fct_scal, scal; simpl.
-rewrite mult_minus_distr_r mult_one_l.
-f_equal.
-unfold comb_lin, scalF, map2F.
-rewrite -scal_sum_distr_r; easy.
-Qed.
-
-Lemma node_cur_aux_inj : forall (vtx_cur : '('R^d)^(S d)),
-  affine_independent vtx_cur -> 
-  injective (node_cur_aux vtx_cur).
-Proof.
-intros vtx_cur Hvtx i j.
-rewrite -(node_cur_eq vtx_cur Hvtx).
-unfold node_cur.
-rewrite -plus_compat_l_equiv.
-rewrite -minus_zero_equiv.
-rewrite -comb_lin_minus_l.
-rewrite -scal_minus_r.
-rewrite comb_lin_scal_l.
-assert (H : / INR k <> 0).
-apply Rinv_neq_0_compat.
-apply not_0_INR, nesym, Arith_prebase.lt_0_neq_stt; easy.
-move => /(scal_zero_reg_r_R _ _ H).
-move => /Hvtx.
-rewrite minus_zero_equiv.
-move =>/(mapF_inj _ _ _ INR_eq).
-apply A_d_k_inj.
-Qed.
-
-Lemma vtx_cur_invalF : forall vtx_cur, 
-  invalF vtx_cur (node_cur_aux vtx_cur).
-Proof.
-intros vtx_cur i.
-destruct (ord_eq_dec i ord0) as [Hi | Hi].
-(* i = ord0 *)
-rewrite Hi.
-exists ord0.
-unfold node_cur_aux.
-rewrite (A_d_k_0 d k) !scal_zero_r !comb_lin_zero_l
-minus_zero_r scal_one plus_zero_r; easy.
-(* i <> ord0 *)
-exists (A_d_k_inv d k (itemF d k (lower_S Hi))).
-unfold node_cur_aux.
-rewrite A_d_k_kron !(comb_lin_eq_l _ (kronecker (lower_S Hi))).
-rewrite comb_lin_ones_r sum_kronecker_r minus_eq_zero
-scal_zero_l plus_zero_l comb_lin_kronecker_in_r
- liftF_lower_S; easy.
-1,2 : apply extF; intros j; rewrite fct_scal_eq.
-1,2 : unfold scal; simpl; unfold mult; simpl.
-1,2 : rewrite -Rmult_assoc Rinv_l; try field. 
-1,2 : apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith. 
-Qed.
-
-Lemma vtx_simplex_ref_inclF : invalF vtx_simplex_ref node_ref_aux.
-Proof.
-apply vtx_cur_invalF.
-Qed.
-
-End vertices_nodes_k_d.
-
-
-Section Poly_Lagrange_1_d_ref.
-
-Variable d : nat.
-
-(* FRd est un espace vectoriel de fonctions de dimension infinie *)
-Definition FRd := 'R^d -> R.
-
-(* TODO: Futur work,
-Local Definition F := 'R^d -> 'R^m.*)
-
-(* "LagP1_d_ref : 
-  For simplices (P1 in dim d), with x = (x_i)_{i=1..d}:
-  LagP1_d_ref 0 x = 1 - \sum_{i=1}^d x_i
-  LagP1_d_ref i x = x_(i-1)
-Geometries using P2 or higher are left aside..." *)
-(** "Livre Vincent Definition 1614 - p34." *)
-Definition LagP1_d_ref : '(FRd)^(S d) :=
-  fun j x => match (ord_eq_dec j ord0) with
-    | left _ => 1 - sum x
-    | right H => x (lower_S H)
-    end.
-
-Lemma vtx_node_P1_d_cur : forall (vtx_cur : 'R^{d.+1,d}) (ipk :'I_d.+1), 
-  vtx_cur ipk = node_cur_aux d 1 vtx_cur (cast_ord (eq_sym (pbinomS_1_r d)) ipk).
-Proof.
-intros vtx_cur i; unfold node_cur_aux.
-rewrite Rinv_1 scal_one.
-destruct (ord_eq_dec i ord0) as [Hi | Hi].
-(* i = ord0 *)
-rewrite Hi.
-replace (mapF INR (A_d_k d 1 (cast_ord (eq_sym (pbinomS_1_r d)) ord0))) with
-  (mapF INR (A_d_k d 1 ord0)).
-rewrite (A_d_k_0 d 1) !comb_lin_zero_l minus_zero_r 
-scal_one plus_zero_r; auto.
-f_equal; f_equal; apply ord_inj; easy.
-(* i <> ord0 *)
-rewrite A_d_1_eq.
-unfold castF.
-rewrite concatF_correct_r; simpl.
-apply ord_n0_nlt_equiv; easy.
-intros H.
-rewrite mapF_itemF_0// itemF_kronecker_eq; auto; simpl.
-replace (fun j : 'I_d => 1 * kronecker (i - 1) j) with
-  (fun j : 'I_d => kronecker (i - 1) j).
-rewrite comb_lin_ones_r. 
-replace (sum (fun j : 'I_d => kronecker (i - 1) j)) with 1.
-rewrite minus_eq_zero scal_zero_l plus_zero_l.
-apply eq_sym.
-rewrite (comb_lin_kronecker_in_r (lower_S Hi))
-liftF_lower_S; easy.
-rewrite (sum_kronecker_r (lower_S Hi)); easy.
-apply fun_ext; intros j.
-rewrite Rmult_1_l; easy.
-Qed.
-
-Lemma LagP1_d_ref_0 : forall (j:'I_d.+1),
-   (j = ord0)%coq_nat 
-     -> LagP1_d_ref j = fun x => 1 - sum x.
-Proof.
-intros j H; unfold LagP1_d_ref.
-case (ord_eq_dec _ _); easy.
-Qed.
-
-Lemma LagP1_d_ref_neq0 : forall (j:'I_d.+1)
-   (H: (j <> ord0)%coq_nat),
-      LagP1_d_ref j = fun x => x (lower_S H).
-Proof.
-intros j H; unfold LagP1_d_ref.
-case (ord_eq_dec _ _); try easy.
-intros H'.
-apply fun_ext; intros x; f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma LagP1_d_ref_neq0_liftF_S :
-  liftF_S LagP1_d_ref = (fun j (x : 'R^d) =>  x j).
-Proof.
-apply extF; intros j.
-unfold liftF_S.
-rewrite LagP1_d_ref_neq0; try easy.
-intros H.
-apply fun_ext; intros x; f_equal.
-apply ord_inj; simpl.
-rewrite bump_r.
-rewrite -addn1 addnK; easy.
-auto with arith.
-Qed.
-
-Lemma LagP1_d_ref_neq0_liftF_S_aux : forall (x : 'R^d),
-  liftF_S (fun j => LagP1_d_ref j x) = x.
-Proof.
-intros x.
-unfold liftF_S.
-apply extF; intros i.
-rewrite LagP1_d_ref_neq0; try easy.
-intros H.
-f_equal.
-simpl.
-apply ord_inj; simpl.
-rewrite bump_r.
-rewrite -addn1 addnK; easy.
-auto with arith.
-Qed.
-
-Lemma LagP1_d_ref_neq0_rev : forall (j:'I_d) x,
-  x j = LagP1_d_ref (Ordinal (ord_lt_S j)) x.
-Proof.
-intros j x; unfold LagP1_d_ref.
-case (ord_eq_dec _ _); try easy.
-simpl; intros H.
-f_equal; apply ord_inj; simpl; try easy.
-auto with arith.
-Qed.
-
-Lemma LagP1_d_ref_liftF_S : forall (i : 'I_d.+1) (x : 'R^d.+1),
-  sum x = 1 ->
-  LagP1_d_ref i (liftF_S x) = x i.
-Proof.
-intros i x Hx; unfold LagP1_d_ref.
-destruct (ord_eq_dec _ _) as [H | H].
-rewrite H.
-assert (H1 : 1 = x ord0 + sum (liftF_S x)).
-rewrite -Hx.
-apply (sum_ind_l x).
-rewrite H1; ring.
-(* *)
-unfold liftF_S; f_equal.
-apply lift_lower_S.
-Qed.
-
-(** "Livre Vincent Lemma 1615 - p34." *)
-Lemma LagP1_d_ref_kron : forall i j,
-  LagP1_d_ref j (vtx_simplex_ref d i) = kronecker i j.
-Proof.
-intros i j.
-unfold LagP1_d_ref, vtx_simplex_ref.
-destruct (ord_eq_dec j ord0) as [Hj | Hj];
-  destruct (ord_eq_dec i ord0) as [Hi | Hi]; simpl.
-(* *)
-rewrite Hi Hj kronecker_is_1; try easy.
-rewrite sum_zero.
-unfold zero; simpl; lra.
-(* *)
-rewrite Hj kronecker_is_0; try easy.
-assert (H : nat_of_ord i <> 0%N).
-contradict Hi; apply ord_inj; easy.
-pose (im1 := Ordinal (ordS_lt_minus_1 i H)).
-rewrite <- sum_eq with 
-  (u := fun i0 : 'I_d => kronecker im1 i0); try easy.
-rewrite sum_kronecker_r; unfold one; simpl; 
-apply Rminus_eq_0.
-contradict Hi; apply ord_inj; easy.
-(* *)
-rewrite Hi kronecker_is_0; try apply not_eq_sym; try easy.
-contradict Hj; apply ord_inj; rewrite Hj; easy.
-(* *)
-apply kronecker_pred_eq.
-contradict Hi; apply ord_inj; easy.
-contradict Hj; apply ord_inj; easy.
-Qed.
-
-(* FC (23/02/2023): for k=1, {nodes} = {vertices}, but for k>1, {vertices} \subset {nodes}.
-  Thus, for k=1, it is better to define nodes=vertices, and use nodes in lemmas when appropriate.*)
-
-(* TODO SB 17/03/23
-   SB pense que ce n'est peut-être pas vrai à cause de l'ordre des noeuds...
-   Les autres ne sont pas d'accord 
-   SB a raison 
-   Q : changer l'ordre lexico sur les multi-index ? *)
-Lemma vtx_node_P1_d_ref : forall (i:'I_d.+1), 
-  vtx_simplex_ref d i = node_ref_aux d 1 (cast_ord (eq_sym (pbinomS_1_r d)) i).
-Proof.
-apply vtx_node_P1_d_cur.
-Qed.
-
-Lemma LagP1_d_ref_kron_nodes : forall i j,
-  LagP1_d_ref j (node_ref_aux d 1 i) = kronecker i j.
-Proof.
-intros i j.
-rewrite <- (cast_ordKV (eq_sym (pbinomS_1_r d)) i) at 1.
-rewrite <- vtx_node_P1_d_ref.
-apply LagP1_d_ref_kron.
-Qed.
-
-(** "Livre Vincent Lemma 1615 - p34." *)
-Lemma LagP1_d_ref_sum_1 : forall x,
-  sum (LagP1_d_ref^~ x) = 1.
-Proof.
-intros x.
-rewrite -> sum_ind_l, LagP1_d_ref_0; try easy.
-unfold plus; simpl; rewrite Rplus_assoc.
-rewrite <- Rplus_0_r; f_equal.
-rewrite Rplus_comm.
-apply Rminus_diag_eq.
-apply sum_ext; intros i.
-unfold liftF_S, lift_S.
-rewrite LagP1_d_ref_neq0_rev; f_equal.
-apply ord_inj; easy.
-Qed.
-
-Lemma LagP1_d_ref_is_affine_mapping: forall i,
-  is_affine_mapping (LagP1_d_ref i : (* 'R^d*) fct_ModuleSpace -> R_ModuleSpace).
-Proof.
-intros i.
-pose (L := fun x => minus (LagP1_d_ref i x) (LagP1_d_ref i zero)).
-apply is_affine_mapping_ext with
-  (fun x => plus (L x) (LagP1_d_ref i zero)).
-intros x; unfold L, minus, plus, opp; simpl; ring.
-(* *)
-apply: is_linear_affine_mapping_ms.
-unfold L, LagP1_d_ref. 
-destruct (ord_eq_dec i ord0) as [Hi | Hi].
-rewrite sum_zero.
-unfold zero; simpl. 
-rewrite Rminus_0_r.
-apply is_linear_mapping_ext with 
-    (opp (fun x : 'R^d => comb_lin x (fun=> 1))).
-intros x.
-rewrite fct_opp_eq.
-unfold minus, plus, opp; simpl.
-rewrite -comb_lin_ones_r.
-ring_simplify; easy.
-apply is_linear_mapping_f_opp.
-apply is_linear_mapping_ext with 
-    (fun x : 'R^d => comb_lin (fun => 1) x).
-intros x.
-apply comb_lin_scalF_compat, scalF_comm_R.
-apply comb_lin_is_linear_mapping_r.
-(* *)
-apply is_linear_mapping_ext with 
-    (fun x : 'R^d => (x (lower_S Hi))).
-intros x; rewrite fct_zero_eq minus_zero_r; easy.
-apply component_is_linear_mapping.
-Qed.
-
-Lemma LagP1_d_ref_comb_lin : forall L i,
-  sum L = 1 ->
-   LagP1_d_ref i (comb_lin L (vtx_simplex_ref d)) = L i.
-Proof.
-intros L i H.
-rewrite is_affine_mapping_comb_aff_compat; try easy.
-2: apply LagP1_d_ref_is_affine_mapping.
-rewrite (comb_lin_one_r _ _ i); try easy.
-rewrite LagP1_d_ref_kron kronecker_is_1; try easy.
-unfold scal, mult; simpl; unfold mult; simpl; ring.
-erewrite skipF_compat.
-apply: kron_skipF_diag_l.
-intros j Hj; simpl.
-rewrite LagP1_d_ref_kron kron_sym; easy.
-Qed.
-
-(* MM probablement inutile pour l'instant *)
-Lemma LagP1_d_ref_is_non_neg : forall (i : 'I_d.+1) (x_ref : 'R^d), 
-  convex_envelop (vtx_simplex_ref d) x_ref -> 0 <= LagP1_d_ref i x_ref.
-Proof.
-intros i x [L HL1 HL2].
-rewrite LagP1_d_ref_comb_lin; easy.
-Qed.
-
-Lemma LagP1_d_ref_lt_1 : forall (i : 'I_d.+1) (x : 'R^d), 
-  convex_envelop (vtx_simplex_ref d) x -> LagP1_d_ref i x <= 1.
-Proof.
-intros i x [L HL1 HL2].
-rewrite LagP1_d_ref_comb_lin; try easy.
-rewrite -HL2; apply sum_nonneg_ub; easy.
-Qed.
-
-Lemma LagP1_d_ref_surj_vect : forall L : 'R^d.+1,
-  sum L = 1 ->
-  exists x : 'R^d, (fun i => LagP1_d_ref i x) = L.
-Proof.
-intros L H1.
-exists (fun i:'I_d => L (lift_S i)).
-assert (forall i:'I_d, 
-  LagP1_d_ref (lift_S i) (fun j : 'I_d => L (lift_S j)) = L (lift_S i)).
-intros i; unfold LagP1_d_ref.
-case (ord_eq_dec _ _); try easy.
-intros H; f_equal; f_equal.
-apply lower_lift_S.
-apply extF; intros i.
-case_eq (nat_of_ord i).
-intros H2; replace i with (@ord0 d).
-2: apply ord_inj; easy.
-unfold LagP1_d_ref.
-case (ord_eq_dec _ _); try easy; intros _.
-apply plus_reg_r with
-   (sum (fun i0 : 'I_d => L (lift_S i0))).
-apply trans_eq with 1.
-unfold minus; rewrite -plus_assoc.
-rewrite plus_opp_l plus_zero_r; easy.
-apply trans_eq with (sum L).
-rewrite H1; easy.
-rewrite sum_ind_l; f_equal.
-(* *)
-intros m Hm.
-assert (T: (m < d)%nat).
-clear -i Hm.
-assert (H:(i < d.+1)%nat); auto with arith.
-rewrite Hm in H; easy.
-replace i with (lift_S (Ordinal T)).
-apply H.
-apply ord_inj; simpl; easy.
-Qed.
-
-Lemma LagP1_d_ref_inj : forall (x y : 'R^d), 
-  (forall (i : 'I_d.+1), LagP1_d_ref i x = LagP1_d_ref i y) -> x = y.
-Proof.
-intros x y H; apply extF; intros i.
-rewrite 2!LagP1_d_ref_neq0_rev; apply H.
-Qed.
-
-Lemma LagP1_d_ref_is_free : is_free LagP1_d_ref.
-Proof.
-intros L HL.
-rewrite comb_lin_ind_l in HL.
-rewrite (LagP1_d_ref_0 ord0) in HL; try apply ord0_correct;
-try easy.
-rewrite LagP1_d_ref_neq0_liftF_S in HL.
-apply extF; intros i.
-destruct (ord_eq_dec i ord0) as [Hi | Hi].
-(* i = ord0 *)
-rewrite Hi.
-rewrite zeroF.
-replace (@zero (Ring.AbelianMonoid (AbsRing.Ring _))) with ((zero : FRd) zero); try easy.
-rewrite -HL; simpl.
-rewrite fct_plus_eq fct_scal_eq sum_zero Rminus_0_r
-  fct_comb_lin_r_eq comb_lin_zero_r plus_zero_r.
-rewrite scal_one_r; easy.
-(* i <> ord0 *)
-rewrite zeroF.
-replace (@zero (Ring.AbelianMonoid (AbsRing.Ring _))) with ((zero : FRd) (kronecker (lower_S Hi))); try easy.
-rewrite -HL.
-rewrite fct_plus_eq fct_scal_eq fct_comb_lin_r_eq.
-rewrite sum_kronecker_r.
-rewrite Rminus_diag_eq; try easy.
-rewrite scal_zero_r plus_zero_l.
-generalize (comb_lin_kronecker_basis (liftF_S L)).
-move=> /extF_rev H.
-specialize (H (lower_S Hi)).
-rewrite liftF_lower_S in H.
-rewrite H fct_comb_lin_r_eq.
-apply comb_lin_ext_r; intros.
-by rewrite kronecker_sym lower_S_correct.
-Qed.
-
-End Poly_Lagrange_1_d_ref.
-
-
-Section sub_vertex_Prop.
-
-Variable d k : nat.
-
-Hypothesis d_pos : (0 < d)%coq_nat.
-
-Hypothesis k_pos : (0 < k)%coq_nat.
-
-Variable vtx_cur : '('R^d)^(d.+1).
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-
-(* "a_alpha = v_0 + \sum (alpha_i / k) (v_i - v_0)
-           = (1 - |alpha|/k) v_0 + \sum (alpha_i / k) v_i
-           = baryc (1 - |alpha|/k, alpha_i/k) (v_i) "*)
-Definition node_cur_baryc :  
- '('R^d)^((pbinom d k).+1) := fun (l : 'I_((pbinom d k).+1)) =>
-  @barycenter _ _ (@ModuleSpace_AffineSpace _ _) _ 
-    (fun i => LagP1_d_ref d i 
-    (scal (/ (INR k)) (mapF INR (A_d_k d k l)))) vtx_cur.
-
-(* "sub_vertex = v_checks i = a_{(k-1)e^i} et v_checks 0 = vtx ord0" *)
-(** "Livre Vincent Lemma 1647 - p48." *)
-Definition sub_vertex  := fun (i : 'I_d.+1) => 
-  match (ord_eq_dec i ord0) with
-    | left _ => vtx_cur ord0
-    | right Hi => node_cur d k vtx_cur 
-        (A_d_k_inv d k (itemF d (k.-1) (lower_S Hi)))
-    end.
-
-Lemma sub_vertex_0 : forall (i:'I_d.+1), (i = ord0)%coq_nat -> 
-      sub_vertex i = vtx_cur ord0.
-Proof.
-intros i Hi; unfold sub_vertex.
-case (ord_eq_dec _ _); easy.
-Qed.
-
-Lemma sub_vertex_neq0 : forall (i:'I_d.+1) (H: ( i <> ord0)%coq_nat),
-     sub_vertex i = node_cur d k vtx_cur 
-        (A_d_k_inv d k (itemF d (k.-1) (lower_S H))).
-Proof.
-intros i H; unfold sub_vertex.
-destruct (ord_eq_dec _ _) as [Hi | Hi]; try easy.
-apply fun_ext; intros x; f_equal; f_equal; f_equal.
-unfold lower_S.
-apply ord_inj; easy.
-Qed.
-
-Lemma sub_vertex_k_1 : forall (i:'I_d.+1), k = 1%nat -> 
-      sub_vertex i = vtx_cur ord0.
-Proof.
-intros i Hk; unfold sub_vertex.
-destruct (ord_eq_dec _ _) as [Hi | Hi]; try easy.
-rewrite node_cur_eq; try easy.
-unfold node_cur_aux.
-rewrite A_d_k_inv_correct_r.
-rewrite !comb_lin_scal_l mapF_itemF_0// !comb_lin_itemF_l
-  liftF_lower_S Hk; simpl.
-rewrite scal_zero_l !scal_zero_r minus_zero_r scal_one
-Rinv_1 scal_zero_l scal_one plus_zero_r; easy.
-rewrite sum_itemF; auto with zarith.
-Qed.
-
-Lemma sub_vertex_k_1_aux : k = 1%nat ->
-      sub_vertex = constF _ (vtx_cur ord0).
-Proof.
-intros Hk.
-apply extF; intros i.
-apply sub_vertex_k_1; easy.
-Qed.
-
-(* "v_tilde i = 1/k v_0 + (k-1)/k v_i" *)
-Lemma sub_vertex_eq : forall (i : 'I_d.+1), i <> ord0 ->
-     sub_vertex i = (scal ( / INR k) (vtx_cur ord0) + scal (INR (k.-1) / INR k) (vtx_cur i))%M.
-Proof.
-intros i Hi; unfold sub_vertex.
-destruct (ord_eq_dec i ord0) as [H | H]; try easy.
-rewrite (node_cur_eq d k vtx_cur Hvtx). 
-unfold node_cur_aux.
-replace (1 - comb_lin _ _)%G with (/ INR k).
-replace (comb_lin _ _) with (scal (INR k.-1 / INR k) (vtx_cur i)); try easy.
-rewrite comb_lin_scal_l A_d_k_inv_correct_r.
-replace (comb_lin
-     (mapF INR (itemF d k.-1 (lower_S H)))
-     (liftF_S vtx_cur)) with (scal (INR k.-1) (vtx_cur i)).
-rewrite scal_assoc.
-f_equal.
-rewrite mult_comm_R; easy.
-rewrite mapF_itemF_0// comb_lin_itemF_l liftF_lower_S; easy.
-rewrite sum_itemF; auto with zarith.
-rewrite comb_lin_scal_l A_d_k_inv_correct_r.
-replace (comb_lin
-     (mapF INR (itemF d k.-1 (lower_S H))) ones) with (INR k.-1).
-unfold scal; simpl.
-rewrite mult_comm_R mapF_itemF_0// comb_lin_itemF_l.
-rewrite -> INR_inv_eq at 1; try easy.
-unfold ones, constF.
-rewrite scal_one_r; easy.
-rewrite mapF_itemF_0// comb_lin_itemF_l. 
-unfold ones, constF.
-rewrite scal_one_r; easy.
-rewrite sum_itemF; auto with arith.
-Qed.
-
-Lemma sub_vertex_eq_aux :
-    liftF_S sub_vertex = 
-      (constF d (scal (/ INR k) (vtx_cur ord0)) +
-         scal (INR k.-1 / INR k) (liftF_S vtx_cur))%M.
-Proof.
-apply fun_ext; intros j.
-apply sub_vertex_eq; try easy.
-Qed.
-
-Lemma node_cur_aux_comb_lin : forall (ipk : 'I_(pbinom d k).+1), 
-  comb_lin ((LagP1_d_ref d)^~ (node_ref d k ipk)) vtx_cur =
-    node_cur_aux d k vtx_cur ipk.
-Proof.
-intros ipk.
-rewrite comb_lin_ind_l.
-unfold node_cur_aux; f_equal.
-(* *)
-rewrite LagP1_d_ref_0; try easy.
-unfold node_ref; rewrite comb_lin_ones_r; f_equal.
-unfold Rdiv.
-rewrite -mult_sum_distr_r -scal_sum_distr_l.
-unfold scal; simpl.
-rewrite mult_comm_R; easy.
-(* *)
-apply comb_lin_eq_l. 
-apply extF; intros i.
-unfold liftF_S; rewrite LagP1_d_ref_neq0; try easy.
-intros H0.
-unfold node_ref, Rdiv, scal; simpl.
-unfold fct_scal, scal; simpl.
-rewrite mult_comm_R.
-unfold mult; simpl; f_equal.
-unfold mapF, mapiF.
-do 2!f_equal.
-apply lower_lift_S.
-Qed.
-
-End sub_vertex_Prop.
-
-
-Section sub_vertex_Prop_aux.
-
-Variable d k : nat.
-
-Hypothesis d_pos : (0 < d)%coq_nat.
-
-Hypothesis k_gt_1 : (1 < k)%coq_nat.
-Let k_pos : (0 < k)%coq_nat.
-Proof. apply Nat.lt_trans with 1%nat; [apply Nat.lt_0_1 | easy]. Qed.
-
-Variable vtx_cur : '('R^d)^(d.+1).
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-
-Lemma sub_vertex_affine_ind :
-    affine_independent (sub_vertex d k vtx_cur).
-Proof. 
-intros L HL.
-rewrite sub_vertex_0 in HL; try easy.
-unfold liftF_S, lift_S in HL.
-rewrite (comb_lin_ext_r L _ 
-  ((fun i : 'I_d => (scal (/ INR k) (vtx_cur ord0) +
-        scal (INR k.-1 / INR k) (vtx_cur (lift ord0 i)))%M) - 
-   constF d (vtx_cur ord0))%G) in HL.
-unfold constF in HL.
-unfold affine_independent, is_free in Hvtx.
-apply Hvtx.
-unfold liftF_S, lift_S, constF.
-replace (comb_lin L ((fun i : 'I_d => _)%G)) with 
-  (comb_lin L (fun i : 'I_d =>
-      (scal (INR k.-1 / INR k)) 
-        (vtx_cur (lift ord0 i) - (vtx_cur ord0))%G)) in HL.
-replace (comb_lin L _) with
-   (scal (INR k.-1 / INR k) (comb_lin L
-       (fun i : 'I_d =>
-          (vtx_cur (lift ord0 i) -
-           vtx_cur ord0)%G))) in HL.
-apply (scal_zero_reg_r (INR k.-1 / INR k) (comb_lin L
-          (fun i : 'I_d =>
-           (vtx_cur (lift ord0 i) -
-            vtx_cur ord0)%G))).
-apply invertible_equiv_R.
-apply Rmult_integral_contrapositive_currified.
-rewrite P_INR; auto with real.
-assert (INR k <> 1).
-apply not_1_INR, Nat.neq_sym, Nat.lt_neq; easy.
-auto with real.
-apply Rinv_neq_0_compat. 
-apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith. 
-easy.
-apply eq_sym, comb_lin_scal_r.
-apply comb_lin_ext_r; intros i.
-rewrite fct_minus_eq plus_comm convex_comb_2_eq.
-rewrite minus_plus_r; easy.
-rewrite INR_inv_eq; auto with zarith.
-rewrite minus_sym plus_assoc plus_opp_r plus_zero_l; easy.
-intros j; f_equal.
-apply fun_ext; intros n.
-rewrite sub_vertex_eq; auto with zarith.
-easy.
-Qed.
-
-(* "sub_node : 
-  a_checks i = (1 - |alpha|/(k-1) (v_checks 0) + (sum alpha_i/(k-1)) (v_checks i).
-            = baryc (1 - |alpha|/(k-1), alpha_i/(k-1)) (v_checks i)." *)
-Definition sub_node : '('R^d)^((pbinom d k.-1).+1) := 
-    node_cur_aux d (k.-1) (sub_vertex d k vtx_cur). 
-
-(* "a_checks = a_alpha" *)
-Lemma sub_node_cur_eq : forall (ipk : 'I_((pbinom d k.-1).+1)),
-    sub_node ipk = node_cur_aux d k vtx_cur 
-        (widen_ord (pbinomS_monot_pred d k k_pos) ipk).
-Proof.
-intros ipk; unfold sub_node.
-unfold node_cur_aux at 1.
-pose (alpha_ipk := mapF INR (A_d_k d k.-1 ipk)).
-fold alpha_ipk.
-rewrite sub_vertex_0; try easy.
-rewrite sub_vertex_eq_aux; auto with zarith.
-rewrite comb_lin_plus_r -scal_sum_l comb_lin_ones_r
-plus_assoc scal_assoc -scal_distr_r -plus_assoc
--minus_sym.
-unfold mult; simpl.
- rewrite -{2}(Rmult_1_r (sum (scal (/ INR k.-1) alpha_ipk))).
-rewrite -mult_minus_distr_l.
-rewrite (INR_inv_eq k); auto with zarith.
-assert (H1 : (sum (scal (/ INR k.-1)%R alpha_ipk) *
-     (1 - (INR k.-1 / INR k)%R - 1)%G)%K = 
-  (- (sum (scal (/ INR k)%R alpha_ipk))%G)).
-rewrite -!scal_sum_distr_l.
-unfold scal; simpl.
-unfold mult; simpl.
-field_simplify.
-2,3 : apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith.
-replace (1%K - INR k.-1 / INR k - 1%K)%G with
-  (- INR k.-1 / INR k)%G.
-field_simplify.
-field_simplify. 
-easy.
-1,3 : apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith.
-1,2 : split.
-1,2,3,4 : apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith. 
-unfold one; simpl.
-rewrite (P_INR k); auto with zarith.  
-unfold minus.
-unfold opp; simpl.
-unfold plus; simpl.
-field.
-apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith. 
-rewrite H1 -minus_eq comb_lin_scal_r
-comb_lin_scal_l scal_assoc.
-assert (H2 : ((INR k.-1 / INR k)%R * (/ INR k.-1)%R)%K =
-  ( / INR k)).
-unfold mult; simpl.
-field.
-split.
-1,2 : apply not_0_INR, not_eq_sym, Nat.lt_neq; 
-  auto with zarith.
-rewrite H2 -comb_lin_ones_r.
-unfold node_cur_aux, alpha_ipk.
-repeat f_equal.
-apply A_d_k_previous_layer; easy.
-rewrite comb_lin_scal_l.
-repeat f_equal.
-apply A_d_k_previous_layer; easy.
-Qed.
-
-End sub_vertex_Prop_aux.
-
-
-Section f_0_Def.
-
-Variable d1 : nat.
-
-(** "Livre Vincent Definition 1654 - p51." *)
-Definition Phi_aux (*'R^d1 -> 'R^d1.+1 *)(vtx_cur : 'R^{d1.+2,d1.+1}) := 
-  fun x_ref : 'R^d1 => 
-    comb_lin (fun i : 'I_d1.+1 => LagP1_d_ref d1 i x_ref) (liftF_S vtx_cur).
-
-Variable k : nat.
-
-(** "Livre Vincent Lemma 1674 - p58." *)
-Definition f_0 (ipk : 'I_(pbinom d1 k).+1) := 
-  Slice_op (k - sum ( A_d_k d1 k ipk))%coq_nat (A_d_k d1 k ipk).
-
-Lemma f_0_sum_eq : forall ipk, sum (f_0 ipk) = k.
-Proof.
-intros ipk; unfold f_0.
-apply Slice_op_sum.
-apply /leP.
-apply leq_subr.
-(* *)
-rewrite -!SSR_minus subKn; try easy.
-apply /leP.
-apply A_d_k_sum.
-Qed.
-
-End f_0_Def.
-
-
-Section Phi_facts.
-
-(* The dimension is d = d1.+1 *)
-Variable d1 : nat.
-
-Variable vtx_cur : 'R^{d1.+2,d1.+1}.
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-
-(** "Livre Vincent Lemma 1660 - p53." *)
-Definition Phi : (*'R^d1*) fct_ModuleSpace -> (*'R^d1.+1*) fct_ModuleSpace := 
-  fun (x_ref : 'R^d1) => (vtx_cur ord_1 + 
-    comb_lin x_ref (liftF_S (liftF_S vtx_cur) - 
-        constF d1 (vtx_cur ord_1))%G)%M. 
-
-(** "Livre Vincent Lemma 1660 - p53." *)
-Lemma Phi_is_affine_mapping : is_affine_mapping Phi (*'R^d1 -> 'R^d1.+1*).
-Proof.
-apply is_affine_mapping_ext with 
-  ((fun x_ref : 'R^d1 => comb_lin x_ref
-   (liftF_S (liftF_S vtx_cur) - constF d1 (vtx_cur ord_1))%G) +  (fun=> vtx_cur ord_1))%M.
-(* *)
-intros x; rewrite plus_comm; easy.
-(* *)
-apply is_linear_affine_mapping_ms.
-apply comb_lin_is_linear_mapping_l.
-Qed.
-
-Lemma Phi_fct_lm_eq : forall (x_ref : 'R^d1),
-  fct_lm Phi 0%M x_ref = 
-    comb_lin x_ref (liftF_S (liftF_S vtx_cur) - 
-        constF d1 (vtx_cur ord_1))%G.
-Proof.
-intros x_ref.
-unfold Phi.
-pose (c2 := vtx_cur ord_1); fold c2.
-pose (lf := fun x_ref : fct_ModuleSpace => comb_lin x_ref  (liftF_S (liftF_S vtx_cur) - constF d1 c2)%G : fct_ModuleSpace).
-rewrite (fct_lm_ext _ (lf + (fun=> c2))%M).
-rewrite fct_lm_ms_cst_reg.
-rewrite fct_lm_ms_lin; try easy.
-apply comb_lin_is_linear_mapping_l.
-intros x.
-unfold lf.
-rewrite plus_comm; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1660 - p53." *)
-Lemma Phi_eq : Phi_aux d1 vtx_cur = Phi.
-Proof.
-unfold Phi_aux, Phi.
-apply fun_ext; intros x.
-rewrite comb_lin_ind_l.
-rewrite LagP1_d_ref_0; try easy.
-rewrite liftF_S_0.
-rewrite (comb_lin_eq_l _ x _).
-rewrite scal_minus_l scal_one.
-rewrite comb_lin_minus_r.
-unfold comb_lin at 3.
-unfold scalF, map2F.
-rewrite -scal_sum_distr_r.
-rewrite plus_comm 2!plus_assoc; f_equal.
-rewrite plus_comm; easy.
-(* *)
-apply LagP1_d_ref_neq0_liftF_S_aux.
-Qed.
-
-(** "Livre Vincent Lemma 1660 - p53." *)
-Lemma Phi_eq2 : forall (x_ref : 'R^d1),
-  Phi x_ref = (scal (1%R - sum x_ref)%G (vtx_cur ord_1) +
-     comb_lin x_ref (liftF_S (liftF_S vtx_cur)))%M.
-Proof.
-intros x_ref; unfold Phi.
-rewrite scal_distr_r scal_one comb_lin_minus_r -scal_sum_l
- scal_opp_l.
-unfold minus at 1; simpl. 
-rewrite -plus_assoc; symmetry; f_equal.
-rewrite plus_comm; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1674 - p58." *)
-Lemma image_of_nodes_face_hyp : 
-  forall k (ipk : 'I_(pbinom d1 k).+1), (0 < k)%coq_nat ->
-    Phi (node_ref d1 k ipk) = 
-      node_cur d1.+1 k vtx_cur 
-         (A_d_k_inv d1.+1 k (f_0 d1 k ipk)).
-        (*FIXME (A_d_k_inv d1.+1 k (castF (Nat.succ_pred_pos d1.+1 
-          (Nat.lt_0_succ d1)) (f_0 d1 k ipk))).*)
-Proof.
-  (* TODO: this proof is very fragile, add more structure and finishers *)
-intros k ipk Hk.
-rewrite node_cur_eq; try easy.
-unfold node_cur_aux, node_ref, f_0.
-rewrite A_d_k_inv_correct_r.
-simpl.
-rewrite comb_lin_ones_r -scal_sum_distr_l.
-replace (sum (mapF _ _)) with (INR k).
-rewrite comb_lin_scal_l.
-unfold scal; simpl.
-unfold fct_scal; simpl.
-unfold mult; simpl.
-rewrite Rinv_l.
-rewrite minus_eq_zero.
-unfold plus; simpl.
-unfold fct_plus; simpl.
-unfold scal, zero; simpl.
-unfold mult; simpl.
-unfold plus; simpl.
-apply extF; intros i.
-unfold Slice_op.
-rewrite Rmult_0_l Rplus_0_l mapF_castF castF_id mapF_concatF.
-rewrite (comb_lin_splitF_r (mapF INR (singleF (k - sum (A_d_k d1 k ipk))%coq_nat))
-      (mapF INR (A_d_k d1 k ipk))).
-rewrite comb_lin_1 mapF_singleF singleF_0 Phi_eq2; try easy.
-rewrite Rmult_plus_distr_l fct_plus_eq.
-unfold plus, Rdiv; simpl.
-f_equal.
-rewrite -mult_sum_distr_r mult_comm_R fct_scal_eq.
-assert (H : forall (a b : R), 
-  a <> 0%R ->
-  (1%R - ((/ a)%R * b)%K)%G = (/a * (a - b)%G)%R).
-intros a b Ha.
-unfold mult, minus, plus, opp; simpl.
-field_simplify; easy.
-rewrite H.
-rewrite -scal_assoc.
-unfold scal at 1; simpl.
-rewrite sum_INR minus_INR.
-unfold mult; simpl; f_equal.
-rewrite fct_scal_eq; f_equal.
-rewrite -liftF_S_0.
-unfold firstF; f_equal.
-unfold first_ord, lshift.
-apply ord_inj; easy.
-apply A_d_k_sum.
-apply not_0_INR, nesym, Arith_prebase.lt_0_neq_stt; easy.
-(* *)
-rewrite -lastF_S1p.
-unfold castF_S1p.
-rewrite castF_id.
-rewrite 2!fct_comb_lin_r_eq.
-unfold mapF, mapiF, Rdiv. 
-rewrite (comb_lin_eq_l (fun i0 : 'I_d1 =>
-   (INR (A_d_k d1 k ipk i0) * / INR k)%R) 
-  (fun i0 : 'I_d1 => scal (/ INR k)%R
-   (INR (A_d_k d1 k ipk i0))%R) _).
-rewrite comb_lin_scal_l.
-unfold scal; simpl.
-unfold mult; simpl; f_equal.
-apply extF; intros j.
-unfold scal; simpl.
-rewrite Rmult_comm.
-unfold mult; simpl; easy.
-apply not_0_INR, nesym, Arith_prebase.lt_0_neq_stt; easy.
-(* *)
-unfold Slice_op.
-rewrite castF_id.
-rewrite (mapF_concatF INR
-      (singleF (k - sum (A_d_k d1 k ipk))%coq_nat)
-        (A_d_k d1 k ipk)).
-rewrite (sum_concatF (mapF INR (singleF (k - sum (A_d_k d1 k ipk))%coq_nat))
-     (mapF INR (A_d_k d1 k ipk))).
-rewrite sum_1 mapF_singleF singleF_0 sum_INR.
-unfold plus; simpl.
-rewrite -plus_INR; f_equal.
-rewrite Nat.sub_add; try easy.
-apply A_d_k_sum.
-unfold Slice_op.
-rewrite castF_id.
-rewrite (sum_concatF (singleF (k - sum (A_d_k d1.+1.-1 k ipk))%coq_nat) (A_d_k d1.+1.-1 k ipk)).
-rewrite sum_singleF; simpl.
-unfold subn, subn_rec, plus; simpl.
-rewrite Nat.sub_add; try easy.
-apply A_d_k_sum. 
-Qed.
-
-End Phi_facts.
-
-
-Local Open Scope Monoid_scope.
-Local Open Scope Group_scope.
-Local Open Scope Ring_scope.
-
-
-Section Poly_Lagrange_1_d_cur.
-
-Context {d : nat}.
-
-(* Local Definition nvtx :=  S d. *)
-
-Variable vtx_cur : '('R^d)^d.+1.
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-
-Definition K_geom_cur := convex_envelop vtx_cur.
-
-(* TODO : deplacer ici les props de Tgeom + cur to ref + ref to cur + sigma cur. ajouter d'autres proprietes pour ref  *)
-(** "From Aide-memoire EF Alexandre Ern : p. 57-58" *)
-Definition T_geom  : 'R^d -> 'R^d := fun x_ref =>
-  comb_lin (fun i : 'I_d.+1 => LagP1_d_ref d i x_ref) vtx_cur.
-
-Definition T_geom_inv : 'R^d -> 'R^d := fun x_cur =>
-  epsilon inhabited_ms (fun x_ref => T_geom x_ref = x_cur).
-
-Lemma T_geom_is_affine_mapping :
-  is_affine_mapping (T_geom : (*'R^d*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace).
-Proof.
-pose (L := fun x : (*'R^d*) fct_ModuleSpace => T_geom x - T_geom 0 : (*'R^d*) fct_ModuleSpace).
-apply is_affine_mapping_ext with
-  (fun x => plus (L x) (T_geom zero)).
-intros x; apply fun_ext; intros y.
-unfold L.
-rewrite fct_plus_eq fct_minus_eq.
-unfold minus, plus, opp; simpl; ring.
-apply is_linear_affine_mapping_ms.
-unfold L, T_geom.
-unfold minus.
-apply is_linear_mapping_ext with 
-  (fun x => comb_lin (minus
-    (fun i => LagP1_d_ref d i x)
-    (fun i => LagP1_d_ref d i zero)) vtx_cur).
-intros x.
-unfold minus.
-rewrite comb_lin_plus_l.
-rewrite comb_lin_opp_l; easy.
-(* *)
-apply comb_lin_linear_mapping_compat_l.
-intros i.
-apply: is_affine_linear_mapping_ms.
-apply LagP1_d_ref_is_affine_mapping.
-Qed.
-
-Lemma T_geom_transports_vtx: forall i : 'I_d.+1, 
-  T_geom (vtx_simplex_ref d i) = vtx_cur i.
-Proof.
-intros i; unfold T_geom.
-erewrite comb_lin_scalF_compat.
-apply comb_lin_kronecker_in_l.
-f_equal; apply extF; intro.
-rewrite LagP1_d_ref_kron.
-apply kronecker_sym.
-Qed.
-
-Lemma T_geom_transports_nodes : forall k (ipk : 'I_(pbinom d k).+1),  
-  (0 < k)%coq_nat ->
-  T_geom (node_ref_aux d k ipk) = node_cur_aux d k vtx_cur ipk.
-Proof.
-intros k ipk Hk; unfold T_geom.
-rewrite -node_cur_aux_comb_lin; try easy.
-rewrite -node_ref_eq; easy.
-Qed.
-
-Lemma T_geom_transports_convex_baryc : forall L : 'R^d.+1,
-  sum L = 1 -> T_geom (comb_lin L (vtx_simplex_ref d)) = comb_lin L vtx_cur.
-Proof.
-intros L H.
-unfold T_geom.
-apply comb_lin_ext_l; intros i.
-erewrite <- LagP1_d_ref_comb_lin; try easy.
-Qed.
-
-Lemma T_geom_transports_conv_nodes : forall (k : nat) L, 
-  (0 < k)%coq_nat -> sum L = 1%K ->
-    T_geom (comb_lin L (node_ref_aux d k)) =
-       comb_lin L (node_cur_aux d k vtx_cur).
-Proof.
-(* TODO : la preuve est plus courte *)
-intros k L H1 H2.
-unfold T_geom.
-rewrite -node_ref_eq; try easy.
-unfold node_ref.
-rewrite {1}comb_lin_ind_l.
-unfold node_cur_aux.
-(* *)
-rewrite LagP1_d_ref_0; try easy.
-rewrite LagP1_d_ref_neq0_liftF_S_aux.
-rewrite comb_lin_plus_r.
-f_equal.
-(* *)
-rewrite scal_minus_l scal_one.
-rewrite (comb_lin_eq_r L (fun x : 'I_(pbinom d k).+1 =>
-   scal _ _)
-   (fun x : 'I_(pbinom d k).+1 =>
-   (vtx_cur ord0) - scal (sum (scal (/ INR k)%R (mapF INR (A_d_k d k x)))) (vtx_cur ord0))).
-2 : {apply fun_ext; intros ipk.
-rewrite scal_minus_l scal_one.
-f_equal.
-f_equal.
-rewrite comb_lin_ones_r; easy. }
-rewrite comb_lin_minus_r.
-f_equal.
-unfold comb_lin, scalF, map2F.
-rewrite -scal_sum_distr_r.
-rewrite H2 scal_one; easy.
-unfold mapF, mapiF.
-rewrite (comb_lin_eq_r L (fun ipk : 'I_(pbinom d k).+1 =>
-   scal _ _) 
-  (fun ipk : 'I_(pbinom d k).+1 =>
-   scal (sum 
-  (fun i : 'I_d => (INR (A_d_k d k ipk i) / INR k)%R))
-     (vtx_cur ord0))).
-2 : { apply fun_ext; intros ipk.
-f_equal.
-f_equal.
-apply fun_ext; intros i.
-unfold Rdiv.
-unfold scal; simpl.
-unfold fct_scal; simpl.
-unfold scal; simpl.
-unfold mapF, mapiF.
-auto with real. }
-rewrite comb_lin_scal_sum; easy.
-(* *)
-apply trans_eq with 
-  (comb_lin L
-  (fun ipk : 'I_(pbinom d k).+1 =>
-   comb_lin
-     (scal (/ INR k)%R (mapF INR (A_d_k d k ipk)))
-     (liftF_S vtx_cur))); try easy.
-
-rewrite (comb_lin_eq_r L (fun ipk : 'I_(pbinom d k).+1 =>
-   comb_lin _ _) 
-    (fun ipk : 'I_(pbinom d k).+1 =>
-   comb_lin (fun i => 
-     ((INR (A_d_k d k ipk i) / INR k)%R))
-     (liftF_S vtx_cur))).
-2 : {apply fun_ext; intros ipk.
-f_equal.
-apply fun_ext; intros i.
-unfold Rdiv.
-unfold scal; simpl.
-unfold fct_scal; simpl.
-unfold scal; simpl.
-unfold mapF, mapiF.
-auto with real. }
-apply comb_lin2.
-Qed.
-
-Lemma T_geom_surj : forall x_cur,
-  exists x_ref, T_geom x_ref = x_cur. 
-Proof.
-intros x_cur.
-generalize (affine_independent_generator _ has_dim_Rn Hvtx); intros H.
-destruct (H x_cur) as (L,(H2,H3)).
-unfold T_geom, T_geom.
-destruct (LagP1_d_ref_surj_vect d L) as [x Hx]; try easy.
-exists x; rewrite Hx; easy.
-Qed.
-
-Lemma T_geom_surj_aux : forall x_cur, K_geom_cur x_cur ->
-  exists x_ref, T_geom x_ref = x_cur.
-Proof.
-intros x_cur [L HL1 HL2].
-unfold T_geom, T_geom.
-(* *)
-destruct (LagP1_d_ref_surj_vect d L) as [x Hx]; try easy.
-exists x; rewrite Hx; easy.
-Qed.
-
-Lemma T_geom_inj : forall (x_ref y_ref: 'R^d),
-    T_geom y_ref = T_geom x_ref -> y_ref = x_ref.
-Proof.
-intros x y H1.
-apply affine_independent_comb_lin in H1; try easy.
-apply LagP1_d_ref_inj.
-apply (fun_ext_rev H1).
-rewrite 2!LagP1_d_ref_sum_1; easy.
-Qed.
-
-Lemma T_geom_comp : forall x_cur : 'R^d,
-  (*K_geom_cur x_cur ->*) x_cur = T_geom (T_geom_inv x_cur).
-Proof.
-intros x_cur.
-unfold T_geom_inv, T_geom_inv, epsilon; destruct (classical_indefinite_description _); simpl.
-symmetry.
-apply e.
-apply T_geom_surj; easy.
-Qed.
-  
-Lemma T_geom_inv_comp : forall x_ref : 'R^d,
-    x_ref = T_geom_inv (T_geom x_ref).
-Proof.
-intros x_ref.
-unfold T_geom_inv, epsilon; destruct (classical_indefinite_description _) as [x Hx]; simpl.
-symmetry.
-apply T_geom_inj; try easy.
-apply Hx.
-exists x_ref; easy.
-Qed.
-
-Lemma T_geom_inv_transports_vtx : forall i : 'I_d.+1,
-  T_geom_inv (vtx_cur i) = vtx_simplex_ref d i.
-Proof.
-intros i.
-rewrite (T_geom_inv_comp (vtx_simplex_ref d i)); try easy.
-rewrite T_geom_transports_vtx; try easy.
-Qed.
-
-Lemma T_geom_inv_transports_convex_baryc : forall L : 'R^d.+1,
-    sum L = 1 ->
-      T_geom_inv (comb_lin L vtx_cur) = comb_lin L (vtx_simplex_ref d).
-Proof.
-intros L HL1.
-rewrite <- T_geom_transports_convex_baryc; try easy.
-rewrite <- T_geom_inv_comp; try easy.
-Qed.
-
-Lemma T_geom_inv_transports_conv_nodes : forall (k : nat) L, 
-  (0 < k)%coq_nat -> sum L = 1%K ->
-    T_geom_inv (comb_lin L (node_cur_aux d k vtx_cur)) =
-       comb_lin L (node_ref_aux d k).
-Proof.
-intros k L H1 H2.
-rewrite -T_geom_transports_conv_nodes; try easy.
-rewrite <- T_geom_inv_comp; try easy.
-Qed.
-
-Lemma node_ref_aux_comb_lin : forall (k : nat) (ipk : 'I_(pbinom d k).+1),
-  (0 < k)%coq_nat ->
-  node_ref_aux d k ipk = 
-    comb_lin ((LagP1_d_ref d)^~ (node_ref_aux d k ipk)) (vtx_simplex_ref d).
-Proof.
-intros k ipk Hk.
-unfold node_ref_aux at 1.
-rewrite -{1}node_cur_aux_comb_lin.
-rewrite node_ref_eq; try easy.
-Qed.
-
-Lemma T_geom_inv_transports_nodes : forall k (ipk : 'I_(pbinom d k).+1), 
-  (0 < k)%coq_nat ->
-  T_geom_inv (node_cur_aux d k vtx_cur ipk) = node_ref_aux d k  ipk.
-Proof.
-intros k ipk Hk. 
-rewrite -node_cur_aux_comb_lin; try easy.
-rewrite T_geom_inv_transports_convex_baryc.
-2 : apply LagP1_d_ref_sum_1.
-rewrite node_ref_aux_comb_lin; try easy.
-rewrite node_ref_eq; try easy.
-Qed.
-
-Local Definition K_geom_ref : 'R^d -> Prop := convex_envelop (vtx_simplex_ref d).
-
-Lemma K_geom_cur_correct : forall x_ref : 'R^d,
-  K_geom_ref x_ref -> K_geom_cur (T_geom x_ref).
-Proof.
-intros x_ref H.
-destruct H as [L HL1 HL2].
-rewrite T_geom_transports_convex_baryc; try easy.
-Qed.
-
-Lemma K_geom_ref_correct : forall x_cur : 'R^d,
-  K_geom_cur x_cur -> K_geom_ref (T_geom_inv x_cur).
-Proof.
-intros x_cur H.
-destruct H as [L HL1 HL2].
-rewrite T_geom_inv_transports_convex_baryc; try easy.
-Qed.
-
-Lemma T_geom_inv_non_neg :
-  forall (i : 'I_d) (x : 'R^d), 
-  K_geom_cur x -> 0 <= T_geom_inv x i.
-Proof.
-intros i x Hx.
-apply K_geom_ref_correct in Hx.
-unfold K_geom_ref in Hx.
-destruct Hx as [L HL1 HL2].
-rewrite fct_comb_lin_r_eq.
-apply comb_lin_nonneg ; try easy.
-intros j.
-unfold vtx_simplex_ref.
-destruct (ord_eq_dec j ord0) as [H | H]; auto with real.
-destruct (Nat.eq_dec (j - 1)%coq_nat i) as [Hij | Hij].
-rewrite kronecker_is_1; auto with real.
-rewrite kronecker_is_0; auto with real.
-Qed.
-
-(* TODO : peut etre mettre ces deux avant correct *)
-Lemma K_geom_cur_image : 
-  image T_geom K_geom_ref = K_geom_cur.
-Proof.
-rewrite image_eq.
-unfold image_ex.
-apply fun_ext; intros x_cur.
-apply prop_ext.
-split.
-(* *)
-intros [x_ref [Hx1 Hx2]].
-rewrite Hx2.
-apply K_geom_cur_correct; easy.
-(* *)
-intros H.
-exists (T_geom_inv x_cur).
-split.
-apply K_geom_ref_correct; easy.
-rewrite <- T_geom_comp; easy. 
-Qed.
-
-Lemma K_geom_ref_image :
-  image T_geom_inv K_geom_cur = K_geom_ref.
-Proof.
-rewrite image_eq.
-unfold image_ex.
-apply fun_ext; intros x_ref.
-apply prop_ext.
-split.
-(* *)
-intros [x_cur [Hx1 Hx2]].
-rewrite Hx2.
-apply K_geom_ref_correct; easy.
-(* *)
-intros H.
-exists (T_geom x_ref).
-split.
-apply K_geom_cur_correct; easy.
-apply T_geom_inv_comp; easy. 
-Qed.
-
-Lemma T_geom_bijS_spec :
-  bijS_spec K_geom_cur K_geom_ref T_geom_inv T_geom.
-Proof.
-split.
-intros _ [x_cur H]; apply K_geom_ref_correct; easy.
-(* *)
-split.
-intros _ [x_ref H]; apply K_geom_cur_correct; easy.
-(* *)
-split.
-intros x_cur H. rewrite <- T_geom_comp; easy.
-(* *)
-intros x_ref H; rewrite <- T_geom_inv_comp; easy.
-Qed.
-
-Lemma T_geom_bijective : bijective T_geom.
-Proof.
-assert (H1 : cancel T_geom T_geom_inv).
-intros x_ref; rewrite <- T_geom_inv_comp; easy.
-assert (H2 : cancel T_geom_inv T_geom).
-intros x_cur; rewrite <- T_geom_comp; easy.
-apply (Bijective H1 H2).
-Qed.
-
-Lemma T_geom_inv_bijS_spec :
-  bijS_spec K_geom_ref K_geom_cur T_geom T_geom_inv.
-Proof.
-split.
-intros _ [x_ref H]; apply K_geom_cur_correct; easy.
-(* *)
-split.
-intros _ [x_cur H]; apply K_geom_ref_correct; easy.
-(* *)
-split.
-intros x_ref H; rewrite <- T_geom_inv_comp; easy.
-(* *)
-intros x_cur H; rewrite <- T_geom_comp; easy.
-Qed.
-
-Lemma T_geom_inv_bijS :
-  bijS K_geom_cur K_geom_ref T_geom_inv.
-Proof.
-apply bijS_ex.
-exists T_geom.
-apply T_geom_bijS_spec.
-Qed.
-
-Lemma T_geom_inv_eq : 
-  T_geom_inv = f_inv T_geom_bijective.
-Proof.
-apply f_inv_uniq_r; unfold cancel; intros x.
-rewrite -T_geom_comp; easy.
-Qed.
-
-Lemma T_geom_inv_is_affine_mapping:
-  is_affine_mapping (T_geom_inv : (*'R_ModuleSpace^d*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace).
-Proof.
-rewrite T_geom_inv_eq.
-apply: is_affine_mapping_bij_compat.
-apply T_geom_is_affine_mapping.
-Qed.
-
-(** "Livre Vincent Definition 1622 - p37." *)
-Definition LagP1_d_cur i x_cur := LagP1_d_ref d i (T_geom_inv x_cur).
-
-Lemma LagP1_d_cur_0 : forall i,
-  i = ord0 -> LagP1_d_cur i = 
-    (fun x : 'R^d => (1 - sum (T_geom_inv x))%R).
-Proof.
-intros i Hi.
-unfold LagP1_d_cur.
-apply fun_ext; intros x.
-rewrite Hi.
-rewrite LagP1_d_ref_0; easy.
-Qed.
-
-Lemma LagP1_d_cur_neq0 : forall i (H : i <> ord0), 
-  LagP1_d_cur i = (fun x : 'R^d => (T_geom_inv x) (lower_S H)).
-Proof.
-intros i H.
-unfold LagP1_d_cur.
-apply fun_ext; intros x.
-rewrite LagP1_d_ref_neq0; easy.
-Qed.
-
-Lemma LagP1_d_cur_is_non_neg : forall (i : 'I_d.+1) (x : 'R^d),       
-    convex_envelop vtx_cur x -> 0 <= LagP1_d_cur i x.
-Proof.
-intros i x [L HL1 HL2].
-unfold LagP1_d_cur.
-apply LagP1_d_ref_is_non_neg.
-rewrite T_geom_inv_transports_convex_baryc; try easy.
-Qed.
-
-Lemma LagP1_d_cur_lt_1 : forall (i : 'I_d.+1) (x : 'R^d), 
-    convex_envelop vtx_cur x -> LagP1_d_cur i x <= 1.
-Proof.
-intros i x [L HL1 HL2].
-unfold LagP1_d_cur.
-apply LagP1_d_ref_lt_1.
-rewrite T_geom_inv_transports_convex_baryc; try easy.
-Qed.
-
-(** "Livre Vincent Lemma 1624 - p37." *)
-Lemma LagP1_d_cur_kron : forall i j,
-  LagP1_d_cur j (vtx_cur i) = kronecker i j.
-Proof.
-intros i j.
-unfold LagP1_d_cur.
-rewrite T_geom_inv_transports_vtx.
-apply LagP1_d_ref_kron.
-Qed.
-
-(** "Livre Vincent Lemma 1624 - p37." *)
-Lemma LagP1_d_cur_kron_nodes : forall i j,
-    LagP1_d_cur j (node_cur_aux d 1 vtx_cur i) = kronecker i j.
-Proof.
-intros i j.
-rewrite <- (cast_ordKV (eq_sym (pbinomS_1_r d)) i) at 1.
-rewrite <- vtx_node_P1_d_cur.
-apply LagP1_d_cur_kron; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1624 - p37." *)
-Lemma LagP1_d_cur_sum_1 : forall x,
-  sum (fun i => LagP1_d_cur i x) = 1.
-Proof.
-intros x.
-unfold LagP1_d_cur.
-apply LagP1_d_ref_sum_1.
-Qed.
-
-(** "Livre Vincent Lemma 1624 - p37." *)
-Lemma LagP1_d_cur_is_free : is_free LagP1_d_cur.
-Proof.
-unfold LagP1_d_cur.
-intros L HL.
-apply LagP1_d_ref_is_free.
-apply fun_ext; intros x.
-rewrite fct_comb_lin_r_eq.
-rewrite (T_geom_inv_comp x).
-apply trans_eq with ((comb_lin L
-       (fun (i : 'I_d.+1) (x_cur : 'R^d) =>
-        LagP1_d_ref d i (T_geom_inv x_cur))) (T_geom x)).
-rewrite fct_comb_lin_r_eq; easy.
-rewrite HL.
-easy. 
-Qed.
-
-End Poly_Lagrange_1_d_cur.
-
-
-Section Phi_d_Facts_1.
-
-Variable d : nat.
-
-Variable vtx_cur : 'R^{d.+1,d}.
-
-Hypothesis Hvtx: affine_independent vtx_cur.
-
-(** "Livre Vincent Lemma 1661 - p54." *)
-Definition Phi_d_0 : (*'R^d*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace := 
-   T_geom (transpF vtx_cur ord_max ord0).
-
-(** "Livre Vincent Lemma 1661 - p54." *)
-Lemma Phi_d_0_bijective : bijective Phi_d_0.
-Proof.
-apply T_geom_bijective.
-apply affine_independent_transpF_equiv; easy.
-Qed.
-
-Definition Phi_d_0_inv :  (*'R^d*) fct_ModuleSpace -> (*'R^d*) fct_ModuleSpace :=
-   f_inv (Phi_d_0_bijective).
-
-Lemma Phi_d_0_comp : forall x_cur : 'R^d, 
-  x_cur = Phi_d_0 (Phi_d_0_inv x_cur).
-Proof.
-intros x_cur; apply esym, f_inv_can_r.
-Qed.
-
-Lemma Phi_d_0_inv_comp : forall x_ref : 'R^d, 
-  x_ref = Phi_d_0_inv (Phi_d_0 x_ref).
-Proof.
-intros x_ref; apply esym, f_inv_can_l.
-Qed.
-
-End Phi_d_Facts_1.
-
-
-Section Phi_d_Facts_2.
-
-Lemma T_geom_Phi_eq : forall x vtx_cur (Hvtx: affine_independent vtx_cur),
-  T_geom vtx_cur x = Phi_d_0 0 vtx_cur x.
-Proof.
-intros.
-unfold Phi_d_0.
-f_equal.
-unfold transpF, permutF.
-apply fun_ext; intros i.
-f_equal.
-rewrite transp_ord_correct_l1.
-apply ord_max_ge_equiv, Nat.nlt_ge.
-easy.
-destruct i as [i Hi].
-apply ord0_lt_equiv.
-simpl.
-apply /ltP; easy.
-Qed.
-
-Lemma T_geom_inv_Phi_eq : forall vtx_cur (Hvtx: affine_independent vtx_cur),
-  T_geom_inv vtx_cur = Phi_d_0_inv 0 vtx_cur Hvtx.
-Proof.
-intros.
-unfold Phi_d_0_inv.
-rewrite T_geom_inv_eq.
-apply f_inv_ext.
-intros x.
-apply T_geom_Phi_eq; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1661 - p54." *)
-Lemma LagP1_d_ref_Phi_d_0_inv : forall d i x
-  vtx_cur (Hvtx: affine_independent vtx_cur), 
-  LagP1_d_cur vtx_cur i x = 
-    transpF (LagP1_d_ref d) ord0 ord_max i (Phi_d_0_inv d vtx_cur Hvtx x).
-Proof.
-intros d i x vtx_cur Hvtx; unfold LagP1_d_cur.
-generalize i; apply fun_ext_equiv.
-assert (H : sum
-  ((transpF (LagP1_d_ref d) ord0 ord_max)^~ (Phi_d_0_inv d vtx_cur Hvtx x)) = 1%K).
-rewrite -sum_fun_compat sum_transpF sum_fun_compat.
-apply LagP1_d_ref_sum_1; easy.
-apply (barycenter_coord_uniq _ _ vtx_cur); try easy.
-apply affine_independent_equiv; easy.
-apply LagP1_d_ref_sum_1.
-(* *)
-rewrite barycenter_ms_eq.
-2: apply LagP1_d_ref_sum_1.
-apply trans_eq with (T_geom vtx_cur (T_geom_inv vtx_cur x)); try easy.
-rewrite -T_geom_comp; try easy.
-rewrite barycenter_ms_eq; try easy.
-apply trans_eq with
-  (Phi_d_0 d vtx_cur (Phi_d_0_inv d vtx_cur Hvtx x)).
-apply Phi_d_0_comp.
-(* Waiting for lemma fct_comb_lin_l_eq... *)
-unfold Phi_d_0, T_geom; rewrite -comb_lin_transpF_l; f_equal.
-unfold transpF, permutF; apply extF; intros j; f_equal.
-rewrite transp_ord_sym; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1661 - p54." *)
-Lemma LagP1_d_cur_Phi_d_0 : forall d i x vtx_cur 
-  (Hvtx: affine_independent vtx_cur), 
-  transpF (LagP1_d_ref d) ord0 ord_max i x =
-    LagP1_d_cur vtx_cur i (Phi_d_0 d vtx_cur x).
-Proof.
-intros d i x vtx_cur Hvtx.
-rewrite LagP1_d_ref_Phi_d_0_inv.
-f_equal; apply Phi_d_0_inv_comp.
-Qed.
-
-End Phi_d_Facts_2.
-
-
-From FEM Require Import MonoidMult.
-Local Open Scope R_scope.
-
-
-Section Poly_Lagrange_k_1.
-
-Variable k : nat.
-
-Hypothesis k_pos : (0 < k)%coq_nat.
-
-(*19/10/23 on a ajoute skipF pour avoir j <> i, les ord0 servent
-  a avoir la seule composante dans R^1 *)
-(* "LagPk_1 i = Prod_{j<>i} (x - node j) / Prod_{j<>i} (node i - node j)." *)
-(** "Livre Vincent Definition 1549 - p20." *)
-(* Definition LagPk_1_cur_aux vtx_cur (x : 'R^1) : R :=
-  prod_R (constF _ (x ord0) - (fun j => node_cur_aux 1 k vtx_cur j ord0))%G. *)
-Definition LagPk_1_cur_aux vtx_cur (i : 'I_(pbinom 1 k).+1) (x : 'R^1) : R :=
-  prod_R (constF _ (x ord0) - (fun j => skipF (node_cur_aux 1 k vtx_cur) i j ord0))%G.
-
-Definition LagPk_1_cur vtx_cur : '('R^1 -> R)^((pbinom 1 k).+1) :=
-  fun i x => LagPk_1_cur_aux vtx_cur i x / LagPk_1_cur_aux vtx_cur i (node_cur_aux 1 k vtx_cur i).
-
-Definition LagPk_1_ref : '('R^1 -> R)^((pbinom 1 k).+1) :=
-  LagPk_1_cur (vtx_simplex_ref 1).
-
-(*
-(* TODO ? *)
-Variable vtx_cur : 'R^{2,1}.
-
-Hypothesis Hvtx : affine_independent vtx_cur.
-*)
-
-Lemma vtx_cur_neq : forall (vtx_cur : 'R^{2,1}),
-  affine_independent vtx_cur ->
-  vtx_cur ord_1 ord0 <> vtx_cur ord0 ord0.
-Proof.
-intros vtx_cur.
-move=> /is_free_1_equiv.
-rewrite fct_minus_eq constF_correct liftF_S_0.
-intros H.
-contradict H.
-rewrite minus_zero_equiv.
-apply extF; intros i.
-rewrite ord1; easy.
-Qed.
-
-Lemma node_cur_neq : forall (vtx_cur : 'R^{2,1}) i j,
-  affine_independent vtx_cur ->
-  node_cur_aux 1 k vtx_cur i ord0 <>
-    skipF (node_cur_aux 1 k vtx_cur) i j ord0.
-Proof.
-intros vtx_cur i j Hvtx.
-generalize (node_cur_aux_inj _ _ k_pos vtx_cur Hvtx i (skip_ord i j)).
-move => /contra_equiv H.
-specialize (H (nesym (skip_ord_correct_m _ _))).
-contradict H.
-apply extF; intros e.
-rewrite ord1; easy.
-Qed.
-
-Lemma node_cur_neq_aux : forall (vtx_cur : 'R^{2,1}) (i j: 'I_(pbinom 1 k).+1),
-  affine_independent vtx_cur ->
-  (constF (pbinom 1 k) (node_cur_aux 1 k vtx_cur j ord0) -
- (skipF (node_cur_aux 1 k vtx_cur) j)^~ ord0)%G <> zero.
-Proof.
-intros.
-apply nextF.
-assert (H1 : pbinom 1 k = (pbinom 1 k).-1.+1).
-rewrite pbinom_1_l; apply eq_sym, Nat.succ_pred, not_eq_sym, Nat.lt_neq; easy.
-exists (cast_ord (eq_sym H1) ord0).
-rewrite zeroF.
-rewrite fct_minus_eq.
-rewrite constF_correct.
-unfold minus; simpl.
-unfold plus; simpl.
-unfold opp; simpl.
-unfold zero; simpl.
-apply Rminus_eq_contra.
-apply node_cur_neq; try easy.
-Qed.
-
-(** "Livre Vincent Definition 1559 - p22." *)
-Lemma T_geom_k_1 : forall (vtx_cur : 'R^{2,1}) x_ref,
-  affine_independent vtx_cur ->
-    T_geom vtx_cur x_ref = 
-  (scal (x_ref ord0) (vtx_cur ord_1 - vtx_cur ord0)%G + vtx_cur ord0)%M.
-Proof.
-intros vtx_cur x_ref Hvtx; unfold T_geom.
-rewrite comb_lin_ind_l.
-rewrite LagP1_d_ref_0; try easy.
-rewrite LagP1_d_ref_neq0_liftF_S_aux.
-rewrite comb_lin_1 sum_1 liftF_S_0.
-rewrite scal_minus_l scal_one.
-rewrite scal_minus_r.
-rewrite plus_comm.
-rewrite plus_assoc.
-symmetry.
-rewrite plus_comm.
-rewrite plus_assoc.
-f_equal.
-rewrite plus_comm; easy.
-Qed.
-
-Lemma T_geom_inv_k_1 : forall (vtx_cur : 'R^{2,1}) (x_cur : 'R^1),
-  affine_independent vtx_cur ->
-    T_geom_inv vtx_cur x_cur = 
-  scal (/ (vtx_cur ord_max ord0 - vtx_cur ord0 ord0)%G) (x_cur - vtx_cur ord0)%G.
-Proof.
-intros vtx_cur x_cur Hvtx.
-apply (T_geom_inj vtx_cur Hvtx).
-rewrite -T_geom_comp; try easy.
-rewrite T_geom_k_1; try easy.
-rewrite fct_scal_eq fct_minus_eq -ord2_1_max 
-scal_comm_R.
-unfold scal; simpl.
-unfold fct_scal; simpl.
-unfold scal, plus; simpl.
-unfold fct_plus; simpl.
-apply fun_ext; intros i.
-rewrite fct_minus_eq ord1.
-unfold plus, minus, opp, mult, plus; simpl;
-field.
-apply Rminus_eq_contra, vtx_cur_neq; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1567 - p23." *)
-Lemma LagPk_1_cur_eq : forall vtx_cur : 'R^{2,1},
-  affine_independent vtx_cur ->
- LagPk_1_cur vtx_cur = fun i x => LagPk_1_ref i (T_geom_inv vtx_cur x).
-Proof.
-intros vtx_cur Hvtx.
-apply fun_ext; intros i.
-unfold LagPk_1_ref.
-apply fun_ext; intros x.
-unfold LagPk_1_cur, LagPk_1_cur_aux.
-rewrite !prod_R_div; f_equal.
-apply fun_ext; intros j.
-rewrite !fct_minus_eq.
-rewrite !constF_correct.
-rewrite {1}(T_geom_comp vtx_cur Hvtx x).
-pose (x_ref :=  T_geom_inv vtx_cur x).
-fold x_ref.
-rewrite {1}(T_geom_comp vtx_cur Hvtx (node_cur_aux 1 k vtx_cur i)). 
-rewrite (T_geom_comp vtx_cur Hvtx 
-  (skipF (node_cur_aux 1 k vtx_cur) i j)).
-rewrite !T_geom_inv_transports_nodes; try easy.
-rewrite !T_geom_k_1; try easy.
-fold (node_ref_aux 1 k).
-rewrite !fct_plus_eq !fct_scal_eq !fct_minus_eq.
-rewrite -!minus_plus_r_eq.
-rewrite -!scal_minus_distr_r.
-unfold scal, minus, plus, mult, opp; simpl.
-unfold mult; simpl.
-unfold opp; simpl. 
-unfold skipF, node_ref_aux. 
-field.
-split.
-apply Rminus_eq_contra.
-apply node_cur_neq, (vtx_simplex_ref_affine_ind _ _ k_pos).
-apply Rminus_eq_contra, vtx_cur_neq; easy.
-(* *)
-apply inF_not; intros i0.
-apply nesym.
-apply Rminus_eq_contra.
-apply node_cur_neq.
-apply (vtx_simplex_ref_affine_ind 1 k k_pos).
-(* *)
-apply inF_not; intros i0.
-apply nesym.
-apply Rminus_eq_contra.
-apply node_cur_neq; easy.
-Qed.
-
-(** "Livre Vincent Lemma 1547 - p19." *)
-Lemma LagPk_1_cur_kron_nodes : forall i (vtx_cur : 'R^{2,1}),
-  affine_independent vtx_cur ->
-  (LagPk_1_cur vtx_cur)^~ (node_cur_aux 1 k vtx_cur i) = kronecker i.
-Proof.
-(* FIXME : pourquoi ce n'est pas applicable partout ? *)
-intros i vtx_cur Hvtx. 
-apply extF; intros j.
-unfold LagPk_1_cur, LagPk_1_cur_aux.
-destruct (ord_eq_dec i j) as [Hj | Hj].
-(* i = j *)
-rewrite prod_R_div.
-rewrite Hj kronecker_is_1; try easy.
-rewrite prod_R_one_compat; try easy.
-apply extF; intros l.
-rewrite zeroF; unfold zero; simpl.
-apply Rinv_r.
-rewrite fct_minus_eq.
-apply Rminus_eq_contra.
-apply node_cur_neq; try easy.
-apply inF_not; intros i0.
-apply nesym.
-apply Rminus_eq_contra.
-apply node_cur_neq; easy.
-(* i <> j *)
-rewrite prod_R_div.
-rewrite kronecker_is_0.
-rewrite prod_R_zero; try easy.
-unfold inF.
-exists (insert_ord Hj).
-apply eq_sym.
-unfold Rdiv.
-assert (H : (constF (pbinom 1 k) (node_cur_aux 1 k vtx_cur i ord0) -
- (skipF (node_cur_aux 1 k vtx_cur) j)^~ ord0)%G (insert_ord Hj) = 0).
-apply Rminus_diag_eq.
-unfold constF, skipF.
-f_equal.
-rewrite skip_insert_ord; easy.
-rewrite H; lra.
-(* *)
-contradict Hj.
-apply ord_inj; easy.
-(* *)
-apply inF_not; intros i0.
-apply nesym.
-apply Rminus_eq_contra.
-apply node_cur_neq; easy.
-Qed.
-
-Lemma LagPk_1_cur_kron_nodes_aux : forall i j (vtx_cur : 'R^{2,1}),
-  affine_independent vtx_cur ->
-  LagPk_1_cur vtx_cur j (node_cur_aux 1 k vtx_cur i) = 
-    kronecker i j.
-Proof.
-intros i j vtx_cur Hvtx. 
-generalize LagPk_1_cur_kron_nodes.
-intros H.
-specialize (H i vtx_cur Hvtx).
-rewrite fun_ext_equiv in H; easy. 
-Qed.
-
-Lemma LagPk_1_cur_is_free : forall (vtx_cur : 'R^{2,1}),
-  affine_independent vtx_cur ->
-    is_free (LagPk_1_cur vtx_cur).
-Proof.
-move => vtx_cur Hvtx L /fun_ext_equiv HL.
-rewrite (comb_lin_kronecker_basis L).
-apply extF; intros i.
-specialize (HL (node_cur_aux 1 k vtx_cur i)).
-rewrite zeroF.
-rewrite fct_zero_eq in HL.
-rewrite fct_comb_lin_r_eq in HL.
-rewrite LagPk_1_cur_kron_nodes in HL; try easy.
-rewrite -HL.
-rewrite fct_comb_lin_r_eq.
-f_equal.
-apply fun_ext; intros l.
-apply kronecker_sym.
-Qed.
-
-Lemma LagPk_1_ref_kron_nodes : forall i j,
-  LagPk_1_ref j (node_ref_aux 1 k i) = kronecker i j.
-Proof.
-intros i j.
-unfold LagPk_1_ref, node_ref_aux.
-apply LagPk_1_cur_kron_nodes_aux.
-apply (vtx_simplex_ref_affine_ind _ _ k_pos).
-Qed.
-
-Lemma LagPk_1_ref_is_free : is_free LagPk_1_ref.
-Proof.
-unfold LagPk_1_ref.
-apply LagPk_1_cur_is_free.
-apply (vtx_simplex_ref_affine_ind _ k); easy.
-Qed.
-
-End Poly_Lagrange_k_1.
-
-
-Section Poly_Lagrange_1_1.
-
-Lemma LagPk_1_cur0 : forall (i : 'I_(pbinom 1 1).+1) (x : 'R^1), 
-  (*cast_ord (pbinomS_1_r 1)*) i = ord0 ->
-    LagPk_1_cur 1 (vtx_simplex_ref 1) i x = 1 - sum x.
-Proof.
-intros i x Hi.
-rewrite Hi sum_1. 
-unfold LagPk_1_cur, LagPk_1_cur_aux.
-rewrite prod_R_div.
-2 : {apply inF_not; intros j.
-apply nesym.
-apply Rminus_eq_contra.
-apply node_cur_neq; auto. 
-apply (vtx_simplex_ref_affine_ind _ _ Nat.lt_0_1). }
-fold (node_ref_aux 1 1).
-rewrite -node_ref_eq; auto; unfold node_ref.
-rewrite prod_R_singleF_alt.
-rewrite castF_id.
-rewrite !fct_minus_eq !constF_correct.
-replace (skipF (fun (ipk : 'I_(pbinom 1 1).+1) (i0 : 'I_1) => 
-  INR (A_d_k 1 1 ipk i0) / INR 1)
-   ord0 ord0 ord0) with 1.
-rewrite A_1_k_eq; simpl.
-unfold minus, opp, plus, one; simpl; field.
-unfold skipF; rewrite Rdiv_1; easy.
-Qed.
-
-Lemma LagPk_1_cur1 : forall (i : 'I_(pbinom 1 1).+1) (x : 'R^1) 
-  (Hi : cast_ord (pbinomS_1_r 1) i <> ord0),
-    LagPk_1_cur 1 (vtx_simplex_ref 1) i x = x (lower_S Hi).
-Proof.
-intros i x Hi.
-assert (i = ord_max).
-destruct (ord2_dec i) as [Hi1 | Hi1]; try easy.
-contradict Hi; rewrite Hi1; apply ord_inj; easy.
-unfold LagPk_1_cur, LagPk_1_cur_aux.
-rewrite prod_R_div.
-(* *)
-2 : {apply inF_not; intros j.
-apply nesym.
-apply Rminus_eq_contra.
-apply node_cur_neq; auto. 
-apply (vtx_simplex_ref_affine_ind _ _ Nat.lt_0_1). }
-fold (node_ref_aux 1 1).
-rewrite -node_ref_eq; auto; unfold node_ref.
-rewrite prod_R_singleF_alt.
-rewrite castF_id.
-rewrite !fct_minus_eq !constF_correct.
-replace (skipF
-   (fun (ipk : 'I_(pbinom 1 1).+1) (i0 : 'I_1) =>
-    INR (A_d_k 1 1 ipk i0) / INR 1) i ord0 ord0) with 0.
-rewrite !minus_zero_r Rdiv_1 A_1_k_eq constF_correct.
-replace (INR i) with 1.
-rewrite Rdiv_1; f_equal.
-apply ord_inj; unfold ord0, lower_S; simpl.
-rewrite H; simpl; auto with arith.
-rewrite H; simpl.
-replace 1 with (INR 1); try easy; f_equal.
-(* *)
-unfold skipF; rewrite Rdiv_1 A_1_k_eq constF_correct H; easy.
-Qed.
-
-Lemma LagP1_1_ref_eq : 
-  LagPk_1_ref 1 = 
-    castF (eq_sym (pbinomS_1_r 1)) (LagP1_d_ref 1).
-Proof.
-unfold LagPk_1_ref.
-unfold castF; rewrite eq_sym_involutive.
-apply extF; intros i.
-apply fun_ext; intros x; simpl.
-destruct (ord_eq_dec i ord0) as [H | H].
-rewrite LagP1_d_ref_0.
-apply LagPk_1_cur0; easy. 
-rewrite H.
-apply ord_inj; easy.
-rewrite LagP1_d_ref_neq0.
-contradict H.
-apply (f_equal (@nat_of_ord 2)) in H.
-simpl in H.
-apply ord_inj; easy.
-intros H0; apply LagPk_1_cur1.
-Qed.
-
-End Poly_Lagrange_1_1.
-
-
-(* FIXME: COMMENTS TO BE REMOVED FOR PUBLICATION!
-Section Poly_Lagrange_Quad.
-
-(* For quad-like (Q1 in dim d), 
-   LagQ1 i x = \Pi_{j=1}^d (1 - x_j) or x_j  (num = 2^d)
-
-Geometries using P2/Q2 or higher are left aside... *)
-
-Variable d : nat.
-
-Definition phi : 'I_(2^d) -> '('I_2)^d. (*'('('I_2)^d)^(2 ^ d)*)
-Proof.
-intros i j.
-Admitted.
-
-Definition vtxQ1 : '('R^d)^(2^d).
-Proof.
-intros i j.
-Admitted.
-
-(*
-Definition vtxQ1 : '('R^d)^(2^d) :=
-  fun j i => match (Nat.eq_dec j 0) with
-    | left _ => 0
-    | right H => kronecker (Ordinal (ordS_lt_minus_1 j H)) i
-    end.
-*)
-
-Definition LagQ1 : '(FRd d)^(2^d) :=
-  fun j x => prod_R (fun i => LagP1_d_ref 1 (phi j i) (fun _ => x i)).
-
-Lemma LagQ1_kron : forall i j,
-  LagQ1 j (vtxQ1 i) = kronecker i j.
-Proof.
-intros i j.
-unfold LagQ1, LagP1_d_ref.
-destruct (Nat.eq_dec j 0) as [Hj | Hj];
-  destruct (Nat.eq_dec i 0) as [Hi | Hi].
-(* *)
-rewrite Hi Hj kronecker_is_1; try easy.
-admit.
-(* *)
-rewrite Hj kronecker_is_0; try easy.
-admit.
-(* *)
-rewrite Hi kronecker_is_0; try apply not_eq_sym; try easy.
-(* *)
-admit.
-Admitted.
-
-Lemma LagQ1_is_non_neg : forall (i : 'I_(2 ^ d)) (x : 'R^d), 
-  convex_envelop vtxQ1 x -> 0 <= LagQ1 i x.
-Proof.
-intros i x Hx; unfold LagQ1.
-
-Admitted.
-
-Lemma LagQ1_sum_1 : forall x,
-  comb_lin (fun i : 'I_(2 ^ d) => LagQ1 i x)(fun _ => 1) = 1.
-Proof.
-intros.
-unfold comb_lin.
-Admitted.
-
-Lemma LagQ1_comb_lin : forall L i,
-  LagQ1 i (comb_lin L vtxQ1) = L i.
-Proof.
-intros L i.
-Admitted.
-
-(* ce lemme a l'air vrai au moins pour LagP1_d *)
-Lemma LagQ1_surj : forall (L : R) (i : 'I_(2 ^ d)),
-  0 <= L <= 1 ->
-  exists x : 'R^d, LagQ1 i x = L.
-Proof.
-intros L i HL.
-Admitted.
-
-Lemma LagQ1_surj_vect : forall L,
-  (forall (i : 'I_(2 ^ d)), 0 <= L i) ->
-   comb_lin L (fun=> 1) = 1 ->
-  exists x : 'R^d, (fun i => LagQ1 i x) = L.
-Proof. 
-intros L HL1 HL2.
-Admitted.
-
-End Poly_Lagrange_Quad.
-
-
-Section LagPQ.
-
-(* TODO Faut le phi *)
-Lemma LagQ1_is_LagP1_d : forall (i : 'I_2) x,
-  LagQ1 1 i x = LagP1_d_ref 1 i x.
-Proof.
-intros i x.
-unfold LagQ1.
-Admitted.
-
-End LagPQ.
-*)